Encrypt dan Decrypt Data

Posted on 2000-02-27
Last Modified: 2010-05-02
What to Encrypt and Decrypt data using VB6.  Somebody can help me?  Thanks Very much!
Question by:tonyckx

Expert Comment

Comment Utility
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

Expert Comment

Comment Utility
A basic encryption/decryption routine can be found at
LVL 18

Expert Comment

Comment Utility
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
            iChar = iChar + 23
        End If
        sChar = Chr(iChar)
        strPassword = strPassword + sChar

    Next iPos

    EncryptPassword = strPassword

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

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline


Author Comment

Comment Utility
This question has a deletion request Pending

Expert Comment

Comment Utility
This question no longer is pending deletion

Expert Comment

Comment Utility
It seems if you have had some pretty good answers.

LVL 14

Accepted Solution

mcrider earned 100 total points
Comment Utility
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...



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)
            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
        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:


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 ;-)



Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Introduction In a recent article ( for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

6 Experts available now in Live!

Get 1:1 Help Now