ianpaisley
Jan 27th, 2000, 08:32 PM
A while ago I found this encryption code, courtesy of A Young:
You will need, 2 CommandButtons, a Multiline Textbox and a CommonDialogbox..
code:
Private Sub Command1_Click()
'Open Encrypted File
Dim sText As String
Dim iFile As Integer
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
Text1 = DecryptText(Mid(sText, 13))
End If
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(Text1);
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
My problem is with saving files. It works okay a lot of the time except when I save html files of around 14k or more. I open a html file in my browser, go to view source, cut the source code and paste it in Text1.
Then when I click 'Save' I get the error 'Invalid procedure call or argument'.
Why is this? Is is because of a lot of characters such as >, <, #, " etc in the file? I've tried it with other text
files of 50K + and it saves fine - normal text files, without so many strange characters and symbols.
After the error, the following code in the EncryptText function appears yellow:
Mid$(sText, lPos, 1) = Chr(iChar + Val("&H" & Mid(sKey, iKey + 1, 1)))
Does anybody know the cause of, or solution to, my problem?
Any help much appreciated.
You will need, 2 CommandButtons, a Multiline Textbox and a CommonDialogbox..
code:
Private Sub Command1_Click()
'Open Encrypted File
Dim sText As String
Dim iFile As Integer
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
Text1 = DecryptText(Mid(sText, 13))
End If
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(Text1);
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
My problem is with saving files. It works okay a lot of the time except when I save html files of around 14k or more. I open a html file in my browser, go to view source, cut the source code and paste it in Text1.
Then when I click 'Save' I get the error 'Invalid procedure call or argument'.
Why is this? Is is because of a lot of characters such as >, <, #, " etc in the file? I've tried it with other text
files of 50K + and it saves fine - normal text files, without so many strange characters and symbols.
After the error, the following code in the EncryptText function appears yellow:
Mid$(sText, lPos, 1) = Chr(iChar + Val("&H" & Mid(sKey, iKey + 1, 1)))
Does anybody know the cause of, or solution to, my problem?
Any help much appreciated.