Solved

Encryption/Decryption Vb Urgent

Posted on 2004-09-23
7
253 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
7 Comments
 
LVL 10

Expert Comment

by:fds_fatboy
ID: 12140961
0
 
LVL 13

Expert Comment

by:imarshad
ID: 12141909
0
 
LVL 55

Expert Comment

by:Jaime Olivares
ID: 12145283
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 

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 7

Expert Comment

by:J_Mak
ID: 12176795
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

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

Suggested Solutions

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
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…

762 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

20 Experts available now in Live!

Get 1:1 Help Now