Encrypt dan Decrypt Data

What to Encrypt and Decrypt data using VB6.  Somebody can help me?  Thanks Very much!
tonyckxAsked:
Who is Participating?
 
mcriderConnect With a Mentor Commented:
Here is code that will encrypt and decrypt strings.... All you have to do is read the unencrypted file into a string and pass the string to the Crypt function.  It will pass back an encrypted string that you can then save to a new file...

To decrypt a file, just do the same process again... Only this time, read the encrypted file into a string and pass it...


Cheers!®©


THE CODE:


Add This code to a module:

'-------------------------------------------------------------------------------
Public Function Crypt(Source As String, CryptKey As String) As String
    Dim lSource As String
    Dim iVal As Long
    Dim jVal As Long
    Dim lSwitch As Boolean
     
    lSwitch = True
    lSource = Source
    jVal = 0
    For iVal = 1 To Len(lSource)
        jVal = jVal + 1
        If jVal = Len(CryptKey) Then jVal = 1
        lSwitch = SwapBoolean(lSwitch)
        If lSwitch = True Then
            Mid$(lSource, iVal, 1) = Chr$(Asc(Mid$(lSource, iVal, 1)) Xor Asc(Mid$(CryptKey, jVal, 1)) + 1)
        Else
            Mid$(lSource, iVal, 1) = Chr$(Asc(Mid$(lSource, iVal, 1)) Xor Asc(Mid$(CryptKey, jVal, 1)) - 1)
        End If
    Next iVal
    Crypt = lSource
End Function
Public Function SwapBoolean(Source As Boolean) As Boolean
    If Source = True Then
        SwapBoolean = False
    Else
        SwapBoolean = True
    End If
End Function
'-------------------------------------------------------------------------------



Then you can do:


dim cString1 as string
dim cString2 as string
Cstring1=Crypt("String to encrypt","Password")


and Cstring1 will contain an encrypted string.

To unencrypt, do:

Cstring2=Crypt(Cstring1,"Password")

and Cstring2 will now have the unencrypted string.


By the way, in the above example, you can replace the password "Password" with anything you want.  This is your encryption mask, and it can be as long as you want... Just use the same string to encrypt that you use to decrypt, otherwise, the decrypt will fail and you get garbage (which is exactly what you want to have happen ;-)


Cheers!®©

0
 
paulstampCommented:
Thats a very open question... do you mean encrypting individual strings, or files? Need more info.

If you're looking for a custom control to encrypt data try www.componentsource.com.
0
 
holgraveCommented:
A basic encryption/decryption routine can be found at www.softcircuits.com.
0
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

 
mdouganCommented:
This function will render a string unreadable/readable, but it's not much of an encryption algorithm.  It simply shifts the ASCII code by a constant amount (in this case 23 positions).  You can change this number to something different if you wish.  

Anyone who knows anything about cryptology could break this in a few minutes, but for the vast majority of people browsing around in a database, they're not going to be able to figure it out.

Function EncryptPassword(dPassword As String, encrypt As Integer) As String
'*************************************************************************************************************************
'   Encrypts or Decrypts a string if "encrypt" = True or False respectively
'   Example call:
'       SQL = SQL + "AND PASSWORD = '" & EncryptPassword(txtPassword.Text, True) & "'"
'   Result of call: "AND PASSWORD = '@^$34#$$*'"
'*************************************************************************************************************************
Dim sErrors As String
Dim lError As Variant

Dim sChar               As String
Dim iChar               As Integer
Dim iPos                As Integer
Dim iLen                As Integer
Dim strPassword         As String

    On Error GoTo EncryptPasswordErr
   
    strPassword = ""

    iLen = Len(dPassword)
    For iPos = 1 To iLen

        sChar = Mid(dPassword, iPos, 1)
        iChar = Asc(sChar)
        If encrypt Then
            iChar = iChar - 23
        Else
            iChar = iChar + 23
        End If
        sChar = Chr(iChar)
        strPassword = strPassword + sChar

    Next iPos

    EncryptPassword = strPassword

EncryptPasswordExit:
    Exit Function
EncryptPasswordErr:
    Screen.MousePointer = DEFAULT
    sErrors = "EncryptPassword " & Err.Description
    For Each lError In Errors
        sErrors = sErrors & vbCrLf & lError.Description
    Next
    MsgBox sErrors, vbCritical, Err & ""
    Resume EncryptPasswordExit
   
End Function

0
 
tonyckxAuthor Commented:
This question has a deletion request Pending
0
 
holgraveCommented:
This question no longer is pending deletion
0
 
holgraveCommented:
WHY?
It seems if you have had some pretty good answers.

holgrave.
0
All Courses

From novice to tech pro — start learning today.