Hi All,

Recently I had changed my PC.
One of my decrypt modules doesn't work. The output I retrieved from debugging was dummy text. I herewith post the decrypt source here can anyone tell me what is the problem? Shall I need to install any thing in my PC to make the decryption workable?



Option Explicit
Public cKeyString As String

Private msKeyString As String
Private msText As String

Public Function cDecipherInfo(ptInfo) As String
'==========================================================================
'Description : Decryption Algorithms
' Call example:
' Dim a As New cipher
' MsgBox a.decipherInfo
'Pass : The encrypted string - ptInfo
'Return : Decrypted string
'==========================================================================
On Error GoTo DecipherInfoError
msText = ptInfo
KeyString = cKeyString
Shrink
DoXor
cDecipherInfo = msText

Exit Function

DecipherInfoError:
MsgBox "Error Decrypting Password!", , "Security Control System", "", 10
cDecipherInfo = ""

End Function

Public Function cCipherInfo(ByVal ptInfo As String) As String
'==========================================================================
'Description : Encryption Algorithms
' call example:
' Dim a As New cipher
' a.cCipherInfo ("123")
'Pass : string use for receipt encryption - ptInfo
'Return : sting in encrypted format
'==========================================================================
On Error GoTo CipherInfoError

Dim cipherString, tsetting As String

KeyString = cKeyString
msText = ptInfo
DoXor
Stretch
tsetting = msText

cCipherInfo = tsetting

Exit Function

CipherInfoError:
MsgBox "Error Encrypting Password!", , "Security Control System", "", 10
cCipherInfo = False

End Function

Public Sub Stretch()
'==========================================================================
'Description : Convert any string to a printable
' , displayable string
'Pass : null
'Return : null
'==========================================================================
Dim nC As Integer
Dim lI As Long
Dim lJ As Long
Dim nK As Integer
Dim lA As Long
Dim sB As String

lA = Len(msText)
sB = Space(lA + (lA + 2) \ 3)
For lI = 1 To lA
nC = Asc(Mid(msText, lI, 1))
lJ = lJ + 1
Mid(sB, lJ, 1) = Chr((nC And 63) + 59)
Select Case lI Mod 3
Case 1
nK = nK Or ((nC \ 64) * 16)
Case 2
nK = nK Or ((nC \ 64) * 4)
Case 0
nK = nK Or (nC \ 64)
lJ = lJ + 1
Mid(sB, lJ, 1) = Chr(nK + 59)
nK = 0
End Select
Next lI
If lA Mod 3 Then
lJ = lJ + 1
Mid(sB, lJ, 1) = Chr(nK + 59)
End If
msText = sB
End Sub


Public Sub Shrink()
'==========================================================================
'Description : Inverse of the Stretch method;
' result can contain any of the 256-byte values
'Pass : null
'Return : null
'==========================================================================

Dim nC As Integer
Dim nD As Integer
Dim nE As Integer
Dim lA As Long
Dim lB As Long
Dim lI As Long
Dim lJ As Long
Dim lK As Long
Dim sB As String

lA = Len(msText)
lB = lA - 1 - (lA - 1) \ 4
sB = Space(lB)
For lI = 1 To lB
lJ = lJ + 1
nC = Asc(Mid(msText, lJ, 1)) - 59
Select Case lI Mod 3
Case 1
lK = lK + 4
If lK > lA Then lK = lA
nE = Asc(Mid(msText, lK, 1)) - 59
nD = ((nE \ 16) And 3) * 64
Case 2
nD = ((nE \ 4) And 3) * 64
Case 0
nD = (nE And 3) * 64
lJ = lJ + 1
End Select
Mid(sB, lI, 1) = Chr(nC Or nD)
Next lI
msText = sB
End Sub


Public Property Let KeyString(sKeyString As String)
'==========================================================================
'Description : 'A string (key) used in encryption and decryption
'Pass : sKeyString string value stored in this property
'Return : null
'==========================================================================

msKeyString = sKeyString
Initialize

End Property


Public Sub Initialize()
'==========================================================================
'Description : 'Initializes random numbers using the key string
'Pass : null
'Return : null
'==========================================================================

Dim nI As Integer
Randomize Rnd(-1)
For nI = 1 To Len(msKeyString)
Randomize Rnd(-Rnd * Asc(Mid(msKeyString, nI, 1)))
Next nI

End Sub


Public Sub DoXor()
'==========================================================================
'Description : 'Exclusive-or method to encrypt or decrypt
'Pass : null
'Return : null
'==========================================================================

Dim nC As Integer
Dim nB As Integer
Dim lI As Long

For lI = 1 To Len(msText)
nC = Asc(Mid(msText, lI, 1))
nB = Int(Rnd * 256)
Mid(msText, lI, 1) = Chr(nC Xor nB)
Next lI

End Sub


Thanks in advance :-)