Encrypt/decrypt Com object

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...

you can change CODE_NUMBER to whatever number you want...

What level of encryption do you want ?

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

Vin.

use the crypto api or look for a blowfish or dec class on the web.  Use this to encrypt your strings.

I am looking for the highest level of encrytion possible without a third party tool.

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.

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.

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

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.