Solved

Encrypt/decrypt Com object

Posted on 2001-07-11
10
386 Views
Last Modified: 2008-02-01
Does anyone know of a way to Encrypt and Decrypt short strings in a COM object?  I would like to encrypt password on their way to the DB and visa vera from the DB.  The higher the encryption the better.

Anyone?
0
Comment
Question by:khagen
  • 3
  • 2
  • 2
  • +3
10 Comments
 
LVL 6

Expert Comment

by:JonFish85
ID: 6275147
check this out maybe?

Option Explicit
Const CODE_NUMBER As Integer = 2

Private Sub Command1_Click()
Dim str As String, newStr As String

  str = "Experts-exchange"
  newStr = EncryptString(str)
  MsgBox newStr
  newStr = DecryptString(newStr)
  MsgBox newStr
End Sub

Public Function EncryptString(str As String) As String
Dim i As Long, Temp As String, x As Integer

  For i = 1 To Len(str)
    x = Asc(Mid(str, i, 1))
    Temp = Temp & Chr(x - CODE_NUMBER)
  Next i
  EncryptString = Temp
End Function

Public Function DecryptString(str As String) As String
Dim i As Long, Temp As String, x As Integer

  For i = 1 To Len(str)
    x = Asc(Mid(str, i, 1))
    Temp = Temp & Chr(x + CODE_NUMBER)
  Next i
  DecryptString = Temp
End Function

not extremely secure, but Ill keep checking around...
0
 
LVL 6

Expert Comment

by:JonFish85
ID: 6275150
you can change CODE_NUMBER to whatever number you want...
0
 
LVL 4

Expert Comment

by:VincentLawlor
ID: 6275197
What level of encryption do you want ?

I have sonething but it's in C++ wrapped as a COM object.

Vin.
0
 
LVL 3

Expert Comment

by:jrspano
ID: 6275255
use the crypto api or look for a blowfish or dec class on the web.  Use this to encrypt your strings.
0
 
LVL 6

Accepted Solution

by:
anthony_glenwright earned 55 total points
ID: 6275863
Heres some wrapper functions for CryptoAPI that provide DES encryption.  Sorry if it includes extra bits you dont need (i.e. declarations) - I've just posted it straight from live code...

Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" ( _
    phProv As Long, ByVal pszContainer As Long, ByVal pszProvider As String, _
    ByVal dwProvType As Long, ByVal dwFlags As Long) As Long

Private Declare Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As Long, _
    ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, phHash As Long) As Long

Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, _
    ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long

Private Declare Function CryptDeriveKey Lib "advapi32.dll" ( _
    ByVal hProv As Long, ByVal Algid As Long, ByVal hBaseData As Long, ByVal dwFlags As Long, _
    phKey As Long) As Long

Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long

Private Declare Function CryptDestroyKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private Declare Function CryptEncrypt Lib "advapi32.dll" (ByVal hKey As Long, _
    ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, _
    pdwDataLen As Long, ByVal dwBufLen As Long) As Long

Private Declare Function CryptDecrypt Lib "advapi32.dll" (ByVal hKey As Long, _
    ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, _
    pdwDataLen As Long) As Long

Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, _
    ByVal dwFlags As Long) As Long

' ================================================================================
'Constants
' ================================================================================
Private Const CRYPT_NEWKEYSET = &H8
Private Const CRYPT_MACHINE_KEYSET = &H20
Private Const CRYPT_VERIFYCONTEXT = &HF0000000
Private Const MS_DEF_PROV = "Microsoft Base Cryptographic Provider v1.0" & vbNullChar
Private Const PROV_RSA_FULL = 1
Private Const ALG_CLASS_DATA_ENCRYPT = 24576
Private Const ALG_CLASS_HASH = 32768
Private Const ALG_TYPE_ANY = 0
Private Const ALG_TYPE_BLOCK = 1536
Private Const ALG_TYPE_STREAM = 2048
Private Const ALG_SID_RC2 = 2
Private Const ALG_SID_RC4 = 1
Private Const ALG_SID_MD5 = 3
Private Const CALG_MD5 = ((ALG_CLASS_HASH Or ALG_TYPE_ANY) Or ALG_SID_MD5)
Private Const CALG_RC2 = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK) Or ALG_SID_RC2)
Private Const CALG_RC4 = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM) Or ALG_SID_RC4)
Private Const ENCRYPT_ALGORITHM = CALG_RC4
Private Const ENCRYPT_BLOCK_SIZE = 1
Private Const CRYPT_EXPORTABLE = 1

Private Const ERR_CRYPTOINVALIDINPUTBUFFER = 100
Private Const ERR_CRYPTOINITILIZEFAILED = 101



Public Function Encrypt(ByVal InputBuffer As String, _
    ByVal Password As String, ByRef OutputBuffer As String) As Boolean
'------------------------------------------------------------------------------
'
'   Procedure Name  :   Encrypt
'   Description     :   Encrypt a string
'
'   Parameters
'   ----------
'   InputBuffer         String to encrypt
'   Password            Key to use
'   OutputBuffer        Encrypted string
'
'------------------------------------------------------------------------------

  On Error GoTo Encrypt_Terminate

  Dim lngHCryptprov As Long
  Dim lngHHash As Long
  Dim lngHkey As Long
  Dim lngCryptLength As Long
  Dim lngCryptBufLen As Long
  Dim strCryptBuffer As String
  Dim strError As String
  Dim lngResult As Long

 
  Encrypt = False
  OutputBuffer = ""

  If Trim(InputBuffer = "") Then
    Err.Raise ERR_CRYPTOINVALIDINPUTBUFFER, "modCrypto.Encrypt PROC", "InputBuffer can not be empty."
   
  End If

  'Create the crypto handle
  If Not Initialize(lngHCryptprov, lngHHash, lngHkey, Password) Then
    Err.Raise ERR_CRYPTOINITILIZEFAILED, "modCrypto.Encrypt PROC", "Failed to initialize crypto environment."
   
  End If
   
  'Create a buffer for the CryptEncrypt function
  lngCryptLength = Len(InputBuffer)
  lngCryptBufLen = lngCryptLength * 2
  strCryptBuffer = String(lngCryptBufLen, vbNullChar)
  LSet strCryptBuffer = InputBuffer
   
  'Encrypt the text data
  If Not CBool(CryptEncrypt(lngHkey, 0, 1, 0, strCryptBuffer, lngCryptLength, lngCryptBufLen)) Then
    strError = "Error occurred during CryptEncrypt." & vbCrLf
    strError = strError & "Bytes required:" & CStr(lngCryptLength) & vbCrLf
    Err.Raise Err.LastDllError, "modCrypto.Encrypt PROC", strError
   
  End If
   
  OutputBuffer = Mid$(strCryptBuffer, 1, lngCryptLength)
  Encrypt = True
   
Encrypt_Terminate:
  'Destroy session key.
  If (lngHkey) Then
    lngResult = CryptDestroyKey(lngHkey)
  End If
   
  'Destroy hash object
  If lngHHash Then
    CryptDestroyHash (lngHHash)
  End If
   
  'Release Context provider handle
  If lngHCryptprov Then
    lngResult = CryptReleaseContext(lngHCryptprov, 0)
  End If
 
  ' raise error
  If Err.Number <> 0 Then
    Err.Raise Err.Number, Err.Source, Err.Description
  End If
 
     
End Function


Public Function Decrypt(ByVal InputBuffer As String, _
  ByVal Password As String, ByRef OutputBuffer As String) As Boolean
'------------------------------------------------------------------------------
'
'   Procedure Name  :   Decrypt
'   Description     :   Decrypt a string
'
'   Parameters
'   ----------
'   InputBuffer         String to decrypt
'   Password            Key to use
'   OutputBuffer        decrypted string
'
'------------------------------------------------------------------------------
   
  On Error GoTo Decrypt_Terminate
   
  Dim lngHCryptprov As Long
  Dim lngHHash As Long
  Dim lngHkey As Long
  Dim lngCryptLength As Long
  Dim lngCryptBufLen As Long
  Dim strCryptBuffer As String
  Dim strError As String
  Dim lngResult As Long
   
  Decrypt = False
  OutputBuffer = ""
   
  If Trim(InputBuffer = "") Then
    Err.Raise ERR_CRYPTOINVALIDINPUTBUFFER, "modCrypto.Decrypt PROC", "InputBuffer can not be empty."
   
  End If
       
   'Create the crypto handle
  If Not Initialize(lngHCryptprov, lngHHash, lngHkey, Password) Then
    Err.Raise ERR_CRYPTOINITILIZEFAILED, "modCrypto.Decrypt PROC", "Failed to initialize crypto environment."

  End If
     
  'Prepare strCryptBuffer for CryptDecrypt
  lngCryptBufLen = Len(InputBuffer) * 2
  strCryptBuffer = String(lngCryptBufLen, vbNullChar)
  LSet strCryptBuffer = InputBuffer
   
  'Decrypt data
  If Not CBool(CryptDecrypt(lngHkey, 0, 1, 0, strCryptBuffer, lngCryptBufLen)) Then
    strError = "Error occurred during CryptEncrypt." & vbCrLf
    strError = strError & "Bytes required:" & CStr(lngCryptLength) & vbCrLf
    Err.Raise Err.LastDllError, "modCrypto.Decrypt PROC", strError
 
  End If
   
  'Setup output buffer with just decrypted data
  OutputBuffer = Mid$(strCryptBuffer, 1, lngCryptBufLen / 2)
  Decrypt = True
   
Decrypt_Terminate:
   
  'Destroy session key.
  If (lngHkey) Then
    lngResult = CryptDestroyKey(lngHkey)
  End If
   
  'Destroy hash object
  If lngHHash Then
    CryptDestroyHash (lngHHash)
  End If
   
  'Release Context provider handle
  If lngHCryptprov Then
    lngResult = CryptReleaseContext(lngHCryptprov, 0)
  End If
   
  ' raise error
  If Err.Number <> 0 Then
    Err.Raise Err.Number, Err.Source, Err.Description
  End If

End Function

0
Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

 
LVL 1

Author Comment

by:khagen
ID: 6277825
I am looking for the highest level of encrytion possible without a third party tool.
0
 
LVL 6

Expert Comment

by:anthony_glenwright
ID: 6279500
CryptoAPI isn't exactly a 3rd party tool, it's part of the operating system...

The "highest level" of encryption you will get without a 3rd party tool is a pretty low level of encryption, like in JonFish's response.
0
 
LVL 1

Author Comment

by:khagen
ID: 6286170
Thanks anthony_glenwright.  I tried your code, and came across a glitch with the Initialize function.  What does this function do.  Is it returning values used in the rest of the code?  I'm just looking for a way around it, or may be including it.
0
 
LVL 6

Expert Comment

by:anthony_glenwright
ID: 6296935
Oops, my bad... heres the code

Private Function Initialize(ByRef lngHCryptprov As Long, ByRef lngHHash As Long, _
            ByRef lngHkey As Long, ByVal strPassword As String) As Boolean
'  Initialize CryptoAPI
'

  On Error GoTo Initialize_terminate
   
  Dim lngResult As Long
   
  Initialize = False
 
  If Not CBool(CryptAcquireContext(lngHCryptprov, 0&, MS_DEF_PROV, PROV_RSA_FULL, 0)) Then
       
    'If there is no default key container then create one using Flags field
    If Not CBool(CryptAcquireContext(lngHCryptprov, 0&, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_NEWKEYSET)) Then
      Err.Raise Err.LastDllError, "Initialize", "Error occurred during CryptAcquireContext."
    End If
  End If
   
  'Create a hash object
  If Not CBool(CryptCreateHash(lngHCryptprov, CALG_MD5, 0, 0, lngHHash)) Then
    Err.Raise Err.LastDllError, "Initialize", "Error occurred during CryptCreateHash."
  End If
   
  'Hash in the password text
  If Not CBool(CryptHashData(lngHHash, strPassword, Len(strPassword), 0)) Then
    Err.Raise Err.LastDllError, "Initialize", "Error occurred during CryptHashData."
  End If
       
  'Create a session key from the hash object
  If Not CBool(CryptDeriveKey(lngHCryptprov, ENCRYPT_ALGORITHM, lngHHash, 0, lngHkey)) Then
    Err.Raise Err.LastDllError, "Initialize", "Error occurred during CryptDeriveKey."
  End If
   
  Initialize = True

Initialize_terminate:
  ' raise error
  If Err.Number <> 0 Then
    Err.Raise Err.Number, Err.Source, Err.Description
  End If

End Function
0
 

Expert Comment

by:TonyLam
ID: 7699844
I got the wrong encryt and decryt output when I change the system regional default setting to something like Chinese(Taiwan) under the eng version win2k os.
0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
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 Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
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…

743 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

10 Experts available now in Live!

Get 1:1 Help Now