Solved

Encryption/Decryption Vb Urgent

Posted on 2004-09-23
7
263 Views
Last Modified: 2010-05-02
Hi

I would like to use a secure API call to encrypt and decrypt a password using Vb 6. Unfortunately, I do not want to use Crypto API.

Can anyone please provide an alternative API method to encrypt/decrypt a password?

Any speedy answers would be most appreciated

Many thanks

Jeremy
0
Comment
Question by:JezzaKashel
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
7 Comments
 
LVL 13

Expert Comment

by:imarshad
ID: 12141909
0
 
LVL 55

Expert Comment

by:Jaime Olivares
ID: 12145283
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:JezzaKashel
ID: 12149648
Thanks for the comments guys.

Ideally I would like to use a built in API call found in existing DLLs.

This is to run on a thin client environment, so unfortunately there are restrictions on the DLLs etc that can be installed.

If there is a built in alternative to Crypto API, then it would be ideal.

In additon, jamime_olivares, thanks for the post, but I cannot view your suggestion unless I subscribe. Please can you paste it into this question, if its suitable.

Many thanks

Jeremy
0
 
LVL 7

Expert Comment

by:J_Mak
ID: 12158026
Have you tried using advapi32.dll, which has CryptEncrypt and CryptDecrypt functions? It is a standard Windows DLL. I used it in my application. Hope that helps!
0
 
LVL 55

Accepted Solution

by:
Jaime Olivares earned 400 total points
ID: 12179398
Here is a code posted by PaulHews.

Accepted Answer from PaulHews
Date: 10/13/2001 06:07PM PET
Grade: A
 Accepted Answer  


Here is a module for simple encryption/decryption

Option Explicit
'''***********************************************************************************************
'''
'''  Simple  Encryption/Decryption
'''
'''  When you don't need strong encryption you should still use something more
'''  secure than text xor password.  The idea behind this is to combine the password with a long
'''  number to produce a unique random key that is xored against the plaintext.  This routine will
'''  be weak unless you:
'''
'''  A.  Choose a good password with a random selection of characters.
'''  B.  Make your password long enough.  (12+ characters is good for most uses, but longer is better.)
'''  C.  Use a good seed.  Call sMakeSeed from the debug window.
'''
'''  The routine is symmetrical, so that calling it with the plaintext will encrypt, calling
'''  with the encoded text will decrypt.
'''  Note that the seed is as important to your security as your password.  Keep both safe!
'''  Also note that if the password is stored with the file (using true option.) the
'''  level of security drops radically.  The attacks that are possible with the password
'''  encrypted into the file are much easier than those that are possible with the false
'''  (default) option.
'''
'''  This routine is still not strong encryption and you are using it at your own risk!
'''  Paul Hewson, July 2000.
'''
'''***********************************************************************************************
Private Const MaxLong = 2147483647
Private Const MinLong = -2147483648#
Private Const Head = "q=RS3#:o rB'%b0v{!B5YOtzm}C!AP"
Private mlngSeed As Long
Private mlngLast As Long

Private Const A As Long = 48271
Private Const M As Long = 2147483647
Private Const MAX As Long = 2147483645
Private Const Q As Long = (M / A)
Private Const R As Long = (M Mod A)
Private Const rT As Single = 1# / MAX

Public Declare Function GetTickCount& Lib "kernel32" ()

Public Sub sEncryptDecryptString(strToEncrypt As String, ByVal lngSeed As Long, ByVal strPassword As String)
    Dim bytPass() As Byte, bytBuffer() As Byte
    Dim i As Long, j As Integer, k As Integer
    Dim bytToEncrypt() As Byte

'    ByRef strToEncrypt, plaintext string.  Will receive the encrypted text
'    ByVal lngSeed, random number seed so that random numbers can be reproduced.
'    ByVal strPassword, the actual key string used to do the encryption.
   
   
    bytPass = StrConv(strPassword, vbFromUnicode)
    bytToEncrypt = StrConv(strToEncrypt, vbFromUnicode)
   
    Call sEncryptDecryptByte(bytToEncrypt, lngSeed, strPassword)
    strToEncrypt = StrConv(bytToEncrypt, vbUnicode)

End Sub

Public Sub sEncryptDecryptByte(ByRef bytToEncrypt() As Byte, ByVal lngSeed As Long, ByVal strPassword As String)
    Dim bytPass() As Byte, bytBuffer() As Byte
    Dim i As Long, j As Long, k As Long

'    ByRef bytToEncrypt, plaintext array will receive the encrypted bytes.
'    ByVal lngSeed, random number seed so that random numbers can be reproduced.
'    ByVal strPassword, the actual key string used to do the encryption.
     
    bytPass = StrConv(strPassword, vbFromUnicode)
     
     'Use seed to randomize
   
    sRandomize lngSeed
     
    j = LBound(bytToEncrypt)
    Do While j < UBound(bytToEncrypt)
        'Randomize the password bytes.
        For i = 0 To UBound(bytPass)
            bytPass(i) = bytPass(i) Xor CByte(fRandomLong(0, 255))
        Next
        'xor password against the plaintext.
        For i = 0 To UBound(bytPass)
            bytToEncrypt(j) = bytToEncrypt(j) Xor bytPass(i)
            j = j + 1
            If j > UBound(bytToEncrypt) Then Exit For
        Next
    Loop

End Sub


Public Sub sMakeSeed()
    sRandomize   'Randomize using timer.
    Debug.Print fRandomLong
End Sub

Public Sub sEncryptFile(strSrcFilename As String, strTrgFilename As String, lngSeed As Long, strPassword As String, Optional bPassWithFile As Boolean = False)
   
    Dim hFile As Integer
    Dim bSrc() As Byte
    Dim lngPassSeed As Long
    Dim strHead As String
   
    hFile = FreeFile
    Open strSrcFilename For Binary As #hFile
   
    ReDim bSrc(1 To LOF(hFile))
    Get #hFile, , bSrc
    Close #hFile
   
    'Encrypt file contents
    Call sEncryptDecryptByte(bSrc, lngSeed, strPassword)
    If bPassWithFile Then
        'Encrypt Head
        strHead = Left$(Head, Len(strPassword))
        Call sEncryptDecryptString(strHead, lngSeed, strPassword)
    End If
    'Write to disk
    hFile = FreeFile
    If Len(Dir(strTrgFilename)) > 0 Then
        Kill strTrgFilename
    End If
    Open strTrgFilename For Binary As #hFile
    If bPassWithFile Then
        Put #hFile, , strHead
    End If
    Put #hFile, , bSrc
   
    Close #hFile
   

End Sub

Public Sub sDecryptFile(strSrcFilename As String, strTrgFilename As String, lngSeed As Long, strPassword As String, Optional bPassWithFile As Boolean = False)
   
    Dim hFile As Integer
    Dim bSrc() As Byte
    Dim lngPassSeed As Long
    Dim strHeadEnc As String
   
    If Len(strPassword) < Len(Head) Then
        strHeadEnc = Space(Len(strPassword))
    Else
        strHeadEnc = Space(Len(Head))
    End If
   
   
    hFile = FreeFile
    Open strSrcFilename For Binary As #hFile
   
    If bPassWithFile Then
        'resize to file size - length of head.
        ReDim bSrc(1 To LOF(hFile) - Len(strHeadEnc))
        Get #hFile, , strHeadEnc
    Else
        'resize to full file size
        ReDim bSrc(1 To LOF(hFile))
       
    End If
   
   
    Get #hFile, , bSrc
    Close #hFile
   

    If bPassWithFile Then
    Call sEncryptDecryptString(strHeadEnc, lngSeed, strPassword)
    End If
   
    If strHeadEnc = Left$(Head, Len(strHeadEnc)) Or Not bPassWithFile Then
       
        'Decrypt file contents
        Call sEncryptDecryptByte(bSrc, lngSeed, strPassword)
        hFile = FreeFile
        If Len(Dir(strTrgFilename)) > 0 Then
            Kill strTrgFilename
        End If
       
        'Write the unencrypted file
        Open strTrgFilename For Binary As #hFile
        Put #hFile, , bSrc
        Close #hFile
       
    Else
            MsgBox "The password is incorrect."
    End If
   
End Sub

'Borrowed/Modified from VB Hardcore.
Private Function fRandomLong(Optional ByVal lngMin As Long = 0, Optional ByVal lngMax As Long = MAX) As Long
    Dim lngLo As Long, lngHi As Long, iT As Long

    lngHi = mlngLast / Q
    lngLo = mlngLast Mod Q
 
    iT = (A * lngLo) - (R * lngHi)
    If iT >= 0 Then
        mlngLast = iT
    Else
        mlngLast = iT + M
    End If
    ' Range is 1-2147483646; adjust range to 0-2147483645
    fRandomLong = mlngLast - 1
    If lngMin <> 0 Or lngMax <> MAX Then
        If lngMin < lngMax Then
            fRandomLong = lngMin + ((mlngLast - 1) Mod (lngMax - lngMin + 1))
        Else
            fRandomLong = lngMax + ((mlngLast - 1) Mod (lngMin - lngMax + 1))
        End If
    End If

End Function

Private Sub sRandomize(Optional ByVal lngSeed As Long = -1)

    Static lngLastSeed As Long
    Select Case lngSeed
    Case -1
        ' -1 reserved for reinitializing last sequence
        If lngLastSeed Then mlngLast = lngLastSeed Else mlngLast = Abs(GetTickCount)
        Exit Sub
    Case 0
        ' Algorithm won't handle 0 seed, so use it to represent system timer
        mlngLast = Abs(GetTickCount)
    Case Else
        mlngLast = Abs(lngSeed)
    End Select
    lngLastSeed = mlngLast
   
End Sub

 
Comment from PaulHews
Date: 10/13/2001 06:15PM PET
 Comment  


'Assuming you have selected copy from notepad.
'The following will encrypt/decryypt the contents of the clipboard.

Private Sub Command1_Click()
    Dim strText As String
    If Len(txtPassword) < 5 Then
        MsgBox "password must be more than 5 characters."
        Exit Sub
    End If
    If Clipboard.GetFormat(vbCFText) Then
        strText = Clipboard.GetText(vbCFText)
        Call sEncryptDecryptString(strText, 940969077, txtPassword)
        Clipboard.Clear
        Clipboard.SetText strText, vbCFText
    End If
End Sub
 
0

Featured Post

Get HTML5 Certified

Want to be a web developer? You'll need to know HTML. Prepare for HTML5 certification by enrolling in July's Course of the Month! It's free for Premium Members, Team Accounts, and Qualified Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
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…
Suggested Courses
Course of the Month5 days, 16 hours left to enroll

627 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