encryption

[Filter300]

can someone tell me an easy way to encrypt text??

[Dimins]

try this

'keyTxt is the encryption key
'if you set directionTxt to "1" it will decrypt ... if it's set to 
'anything else, it will encrypt ... (I know it's odd using a 
'String as the direction variable, but I used this in an ASP page
'and was passing in the direction via QueryString 
iSeed=0
For i=1 To Len(keyTxt)
    iSeed=iSeed + Asc(Mid(keyTxt, i, 1))
Next
Randomize(iSeed)
decrypt=""
		
For i=1 To Len(messageTxt)
    if (directionTxt ="1") then
        decrypt = decrypt & Chr((Asc(Mid(messageTxt, i, 1)) + (Int(Rnd() * 10))))
    else
        decrypt = decrypt & Chr((Asc(Mid(messageTxt, i, 1)) - (Int(Rnd() * 10))))
    End If
Next

hope this helps ...

[Filter300]

thanks for the help

[Dimins]

and for some reason that doesn't work for me. I ran into this problem earlier and I thought I had solved the problem, btu I guess not. When you encrypt the string and then decrypt it without closing the form, you get the incorrect decryption ... if you encrypt the string, copy it, close the app, open the app, paste the encrypted string and decrypt it , it works! ... I thought it was a problem with the Randomize (iSeed) part, but I can't mail the problem down ... if anyone can see my problem, please help

'add this into a form with 3 Textboxes and a Command Button
'Text1 is the message to encypt/decrypt
'Text2 is the "1" or anything else (tells whetehrt o encrypt or not)
'Text3 is the result
Private Sub Command1_Click()
    Dim iSeed As Integer
    Dim keyTxt, messageTxt, decrypt, directionTxt As String
    keyText = "dog"
    messageTxt = Text1.Text
    directionTxt = Text2.Text
    iSeed = 0
    Randomize (iSeed)
    For i = 1 To Len(keyTxt)
        iSeed = iSeed + Asc(Mid(keyTxt, i, 1))
    Next
    decrypt = ""
    For i = 1 To Len(messageTxt)
        If (directionTxt = "1") Then
            decrypt = decrypt & Chr((Asc(Mid(messageTxt, i, 1)) + (Int(Rnd() * 10))))
        Else
            decrypt = decrypt & Chr((Asc(Mid(messageTxt, i, 1)) - (Int(Rnd() * 10))))
        End If
    Next
    Text3.Text = decrypt
End Sub

[Filter300]

i tried this thing out... and i cant get it to work... it seems to encrypt it ok.. but it wont decrypt it....

[Filter300]

i read your post again.. and it does work if i kill the app and paste in the encrypted text...

anyone have a guess on what i can do to get around this?

[Dimins]

sorry about the first post ... I did use that code in a DLL call ... it works for that because I a sense, the DLL ends after each call to it. I'll take another look at it and see if I can fix it ...

[Dimins]

fixed it ...

Dim iSeed As Integer
    Dim keyTxt, messageTxt, decrypt, directionTxt As String
    keyText = "dog"
    messageTxt = Text1.Text
    directionTxt = Text2.Text
    iSeed = 0
    Rnd (-1)
    Randomize (iSeed)
    For i = 1 To Len(keyTxt)
        iSeed = iSeed + Asc(Mid(keyTxt, i, 1))
    Next
    decrypt = ""
    For i = 1 To Len(messageTxt)
        If (directionTxt = "1") Then
            decrypt = decrypt & Chr((Asc(Mid(messageTxt, i, 1)) + (Int(Rnd() * 10))))
        Else
            decrypt = decrypt & Chr((Asc(Mid(messageTxt, i, 1)) - (Int(Rnd() * 10))))
        End If
    Next
    Text3.Text = decrypt

found the following in an article

Note: To repeat sequences of random numbers, call Rnd with a negative argument immediately before using Randomize with a numeric argument. Using Randomize with the same value for number does not repeat the previous sequence.

let me know if that works

[Filter300]

thanks! it works great

[oh1mie]

Try this one. Same function encypting and opening strings.

Public SecretKey      as string
Public SecretKeyValue as long
 
Public Function fcnSecret(YourString As String) As String
    
    SecretKey = "YourPassWord"
    SecretKeyValue = 1212 'YourValue
 
    Dim n1 As Long, n2 As Long, n3 As Long, i As Integer
    
    For i = 1 To Len(SecretKey)
        n1 = n1 + Asc(Mid(SecretKey, i, 1))
        n1 = (n1 * 367 + 331) Mod &HFFF
        n2 = ((n2 + n1) * 743 + 599) Mod &HFFF
        n3 = ((n3 + n2) * 563 + 787) Mod &HFFF
    Next
    
    fcnSecret = fcnKrypting(YourString, SecretKeyValue, n1, n2, n3)
 
End Function
Private Function fcnKrypting(YourString As String, SecretKeyValue As Long, Optional a1 As Long, Optional a As Long, Optional b As Long) As String
    
    Static r As Long
    Static m As Long
    Static n As Long
    Dim i    As Long
    Dim c    As Long
    Dim d    As Long
    
    On Error Resume Next
    
    If SecretKeyValue < 2 Then SecretKeyValue = 2
    
    If IsMissing(a1) = False Then r = a1
    If IsMissing(a) Then
        If m = 0 Then m = 69
    Else
        m = (a * 4 + 1) Mod SecretKeyValue
    End If
    If IsMissing(b) Then
        If n = 0 Then n = 47
    Else
        n = (b * 2 + 1) Mod SecretKeyValue
    End If
    
    For i = 1 To Len(YourString)
        c = Asc(Mid(YourString, i, 1))
        Select Case c
        Case 48 To 57
            d = c - 48
        Case 63 To 90
            d = c - 53
        Case 97 To 250
            d = c - 59
        Case Else
            d = -1
        End Select
        If d >= 0 Then
            r = (r * m + n) Mod SecretKeyValue
            d = (r And 63) Xor d
            Select Case d
            Case 0 To 9
                c = d + 48
            Case 10 To 37
                c = d + 53
            Case 38 To 191
                c = d + 59
            End Select
            Mid(YourString, i, 1) = Chr(c)
        End If
    Next
    
     fcnKrypting = YourString
 
End Function

oh1mie/Vic

[HAVocINCARNATE29]

static r As Long

could someone explain what static does and when you should use it as opposed to dim or pulic or const?


thanks

[MarkT]

Static is used a the procedure level. It will retain its value after the procedure has finished. It acts like dimming a variable at modular level.
I prefer to keep the scope of a variable as narrow as possible, so I use static when I need to retain a value between calls to a procedure.

Give this a try, it may clears somethings up.

Option Explicit
Dim x As Integer
 
Private Sub Form_Load()
   Timer1.Interval = 1000
   Timer1.Enabled = True
End Sub
 
Private Sub Timer1_Timer()
   Dim y As Integer
   Static z As Integer
   
   x = x + 1
   y = y + 1
   z = z + 1
   
   If x > 4 Or _
      y > 4 Or _
      z > 4 Then
      
      MsgBox "X = " & x & vbCrLf _
            & "Y = " & y & vbCrLf _
            & "Z + " & z
      Timer1.Enabled = False
   End If
End Sub

[nishantp]

Heres some more...this is some pretty cheap symetrical Xor encryption. So call the same function with the same key on the cipher and you'll get the text back.

Function Enc(iText As String, Key As String) As String
'Very Simple Encryption
'Symetrical, Xor encryption. Simply text xor key. nothing fancy
    Dim StrOut As String
    Dim i As Long
    Dim StrLen As Long
    Dim KeyLen As Long
 
    StrLen = Len(iText)
    KeyLen = Len(Key)
 
    For i = 1 To StrLen
        StrOut = StrOut & Chr(Asc(Mid(iText, i, 1)) Xor Asc(Mid(Key, i Mod KeyLen + 1, 1)))
    Next
    Enc = StrOut
End Function