Results 1 to 2 of 2

Thread: Question on past encryption topic

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Aug 1999
    Location
    Glasgow,Scotland
    Posts
    281

    Post


    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.

  2. #2
    Hyperactive Member
    Join Date
    Jun 1999
    Location
    Calgary Alberta
    Posts
    359

    Post

    my guess would be a single or double quote is confusing it. Makes it think that the quoted string is done and then it runs into another one, that type of thing. I 'm not entirely sure though. You may have to go through and grab all the double and single quotes and change them manually.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width