|
-
Jun 1st, 2010, 08:30 PM
#1
Thread Starter
Hyperactive Member
[RESOLVED] Cannot decrypt the text after changing to new PC
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 :-)
Where there is no hope, there can be no endeavor.
There are two ways of rising in the world, either by your own industry or by the folly of others.
-
Jun 1st, 2010, 09:09 PM
#2
Re: Cannot decrypt the text after changing to new PC
Well you are using Chr() and Asc() instead of ChrW$() and AscW(). This means you're playing "Trust the Force, Luke" in terms of locale settings.
Does the new computer use a different locale?
Also, why would you want to use the Variant functions Chr(), Mid(), etc. instead of the String-typed ones?
-
Jun 1st, 2010, 09:11 PM
#3
Re: Cannot decrypt the text after changing to new PC
I'm not sure what you mean by "doesn't work". You get an error? (Which, what line)
-
Jun 2nd, 2010, 01:04 AM
#4
Thread Starter
Hyperactive Member
Re: Cannot decrypt the text after changing to new PC
Thanks dilettante,
The problem is from the locale settings. I have changed the language to English(US) then problem resolved.
Very Thanks to you.
Thanks baja_yu,
The problem resolved, there is no error message prompted only the text decrypted in unrecognized characters.
Where there is no hope, there can be no endeavor.
There are two ways of rising in the world, either by your own industry or by the folly of others.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|