ianpaisley
Dec 7th, 1999, 06:04 AM
Hi there,
I'm looking for a way to encrypt my html files so that they can only be opened by the Web browser control on my form. I found this code (pasted by Aaron Young, I think - thank you Aaron!) on how to encrypt text files. It works for text files. I replaced 'Text1', as the code originally was, with WebBrowser1' - the name of my browser control, but it doesn't work.
Does anybody know how I can resolve my problem - encrypt my html files? I don't want people
to be able to open them in any browser - just mine.
Thanks for any help!
Private Sub Command1_Click()
'Open Encrypted File
Dim sText As String
Dim iFile As Integer
On Error GoTo Cancelled
With CommonDialog1
.CancelError = True
.Filter = "AY Encrypted|*.aye"
.ShowOpen
iFile = FreeFile
Open .FileName For Input As iFile
sText = Input(LOF(iFile), iFile)
Close iFile
End With
If Left(sText, 12) <> "AY Encrypted" Then
MsgBox "Not an AY Encrypted File Format"
Else
WebBrowser1 = DecryptText(Mid(sText, 13))
End If
Cancelled:
End Sub
Private Sub Command2_Click()
'Save Encrypted File
On Error GoTo Cancelled
With CommonDialog1
.CancelError = True
.Filter = "AY Encrypted|*.aye"
.ShowSave
iFile = FreeFile
Open .FileName For Output As iFile
Print #iFile, EncryptText(WebBrowser1);
Close iFile
End With
MsgBox "Saved"
Cancelled:
End Sub
Function EncryptText(ByVal sText As String) As String
Dim sKey As String
Dim iKey As Integer
Dim lPos As Long
Dim iChar As Integer
Randomize Timer
sKey = Right("000" & Hex(Int(Rnd(1) * 4095)), 3)
For lPos = 1 To Len(sText)
iChar = Asc(Mid$(sText, lPos, 1))
Mid$(sText, lPos, 1) = Chr(iChar + Val("&H" & Mid(sKey, iKey + 1, 1)))
iKey = (iKey + 1) Mod 3
Next
EncryptText = "AY Encrypted" & sText & Right(Space(20) & (Val("&H" & sKey) + Len(sText)), 20)
End Function
Function DecryptText(ByVal sText As String) As String
Dim sKey As String
Dim iKey As Integer
Dim lPos As Long
Dim iChar As Integer
sKey = Right("000" & Hex(Val(Right(sText, 20)) - (Len(sText) - 20)), 3)
For lPos = 1 To Len(sText) - 20
iChar = Asc(Mid$(sText, lPos, 1))
Mid$(sText, lPos, 1) = Chr(iChar - Val("&H" & Mid(sKey, iKey + 1, 1)))
iKey = (iKey + 1) Mod 3
Next
DecryptText = Left(sText, Len(sText) - 20)
End Function
I'm looking for a way to encrypt my html files so that they can only be opened by the Web browser control on my form. I found this code (pasted by Aaron Young, I think - thank you Aaron!) on how to encrypt text files. It works for text files. I replaced 'Text1', as the code originally was, with WebBrowser1' - the name of my browser control, but it doesn't work.
Does anybody know how I can resolve my problem - encrypt my html files? I don't want people
to be able to open them in any browser - just mine.
Thanks for any help!
Private Sub Command1_Click()
'Open Encrypted File
Dim sText As String
Dim iFile As Integer
On Error GoTo Cancelled
With CommonDialog1
.CancelError = True
.Filter = "AY Encrypted|*.aye"
.ShowOpen
iFile = FreeFile
Open .FileName For Input As iFile
sText = Input(LOF(iFile), iFile)
Close iFile
End With
If Left(sText, 12) <> "AY Encrypted" Then
MsgBox "Not an AY Encrypted File Format"
Else
WebBrowser1 = DecryptText(Mid(sText, 13))
End If
Cancelled:
End Sub
Private Sub Command2_Click()
'Save Encrypted File
On Error GoTo Cancelled
With CommonDialog1
.CancelError = True
.Filter = "AY Encrypted|*.aye"
.ShowSave
iFile = FreeFile
Open .FileName For Output As iFile
Print #iFile, EncryptText(WebBrowser1);
Close iFile
End With
MsgBox "Saved"
Cancelled:
End Sub
Function EncryptText(ByVal sText As String) As String
Dim sKey As String
Dim iKey As Integer
Dim lPos As Long
Dim iChar As Integer
Randomize Timer
sKey = Right("000" & Hex(Int(Rnd(1) * 4095)), 3)
For lPos = 1 To Len(sText)
iChar = Asc(Mid$(sText, lPos, 1))
Mid$(sText, lPos, 1) = Chr(iChar + Val("&H" & Mid(sKey, iKey + 1, 1)))
iKey = (iKey + 1) Mod 3
Next
EncryptText = "AY Encrypted" & sText & Right(Space(20) & (Val("&H" & sKey) + Len(sText)), 20)
End Function
Function DecryptText(ByVal sText As String) As String
Dim sKey As String
Dim iKey As Integer
Dim lPos As Long
Dim iChar As Integer
sKey = Right("000" & Hex(Val(Right(sText, 20)) - (Len(sText) - 20)), 3)
For lPos = 1 To Len(sText) - 20
iChar = Asc(Mid$(sText, lPos, 1))
Mid$(sText, lPos, 1) = Chr(iChar - Val("&H" & Mid(sKey, iKey + 1, 1)))
iKey = (iKey + 1) Mod 3
Next
DecryptText = Left(sText, Len(sText) - 20)
End Function