VB6关于加密解密一例

Dim btyChrA() As Integer, btyChrB() As Integer

Friend Function MaxINT(iInt As Integer) As Integer
Dim i As Integer, i1 As Integer

For i1 = iInt To 2 Step -1
For i = 2 To iInt
If (i1 Mod i) = 0 Then Exit For
Next
If i = i1 Then MaxINT = i1: Exit For
Next

End Function

Private Function UnlockKey(RndKey() As Integer, strPassword As String, RSAKey() As Integer) As String

Dim chrUnlock As String, chrPWD As String
Dim IntMaxMod() As Integer, IntMinus() As Integer, BtyPwd() As Byte, BtyXor1() As Integer
Dim iPWDCount As Integer, i1 As Integer, i2 As Integer, i3 As Integer
Dim iRndCount As Integer, iRSACount As Integer
Static iLoop As Integer, iLoop2 As Integer

chrPWD = strPassword
iPWDCount = Len(chrPWD) - 1

ReDim BtyPwd(iPWDCount)
ReDim IntMaxMod(iPWDCount)
ReDim IntMinus(iPWDCount)

For i1 = 0 To iPWDCount
BtyPwd(i1) = AscW(Mid(chrPWD, i1 + 1, 1))
IntMaxMod(i1) = MaxINT(i1)
IntMinus(i1) = BtyPwd(i1) - IntMaxMod(i1)
Next

iRndCount = UBound(RndKey)

ReDim BtyXor1(255)
iLoop = 0
iLoop2 = 0

For i1 = 0 To 255
If iLoop > iPWDCount Then iLoop = 0
If iLoop2 > iRndCount Then iLoop2 = 0
BtyXor1(i1) = RndKey(iLoop2) Xor (BtyPwd(iLoop) + IntMaxMod(iLoop))
BtyXor1(i1) = BtyXor1(i1) Xor IntMaxMod(iLoop)
BtyXor1(i1) = BtyXor1(i1) Xor IntMinus(iLoop)
iLoop = iLoop + 1
iLoop2 = iLoop2 + 1
Next

iLoop = 0
iRSACount = UBound(RSAKey)
ReDim BtyPwd(iRSACount)

For i = 0 To 255
If iLoop > iRSACount Then iLoop = 0
BtyPwd(iLoop) = BtyXor1(i) Xor RSAKey(iLoop)
iLoop = iLoop + 1
Next

For i = 0 To iRSACount
UnlockKey = UnlockKey & ChrW(BtyPwd(i))
Next

End Function

Private Function LockKey(strUSKEY As String) As String

Dim chrUnlock As String, chrPWD As String
Dim IntMaxMod() As Integer, IntMinus() As Integer, BtyPwd() As Byte, BtyXor() As Integer, BtyXor1() As Integer
Dim iPWDCount As Integer, i1 As Integer, i2 As Integer, i3 As Integer
Dim iRndCount As Integer, iRnd1 As Integer, iRnd2 As Integer
Static iLoop As Integer, iLoop2 As Integer

chrPWD = strUSKEY
iPWDCount = Len(chrPWD) - 1

ReDim BtyPwd(iPWDCount)
ReDim IntMaxMod(iPWDCount)
ReDim IntMinus(iPWDCount)

For i1 = 0 To iPWDCount
    BtyPwd(i1) = AscW(Mid(chrPWD, i1 + 1, 1))
    IntMaxMod(i1) = MaxINT(i1)
    IntMinus(i1) = BtyPwd(i1) - IntMaxMod(i1)
Next

ReDim BtyXor(127)

VBA.Randomize
For i1 = 0 To 127
    BtyXor(i1) = Int(Rnd * 100 + 45)
Next

btyChrA = BtyXor

ReDim BtyXor1(255)
iLoop = 0
iLoop2 = 0
For i1 = 0 To 255

If iLoop > iPWDCount Then iLoop = 0
If iLoop2 > 127 Then iLoop2 = 0

BtyXor1(i1) = BtyXor(iLoop2) Xor (BtyPwd(iLoop) + IntMaxMod(iLoop))

BtyXor1(i1) = BtyXor1(i1) Xor IntMaxMod(iLoop)

BtyXor1(i1) = BtyXor1(i1) Xor IntMinus(iLoop)

iLoop = iLoop + 1
iLoop2 = iLoop2 + 1

Next
iLoop = 0
iLoop2 = 0

ReDim btyChrB(iPWDCount)

For i = 0 To 255
If iLoop > iPWDCount Then iLoop = 0
btyChrB(iLoop) = BtyXor1(i) Xor BtyPwd(iLoop)

iLoop = iLoop + 1
Next

For i = 0 To iPWDCount
LockKey = LockKey & ChrW(btyChrB(i))
Next
End Function

Private Sub Command1_Click()
Text1.Text = LockKey(txtRND.Text)
End Sub

Private Sub Command2_Click()
txtXOR.Text = UnlockKey(btyChrA(), txtRND.Text, btyChrB())
End Sub

Private Sub Form_Load()
Dim i&, strRND$
VBA.Randomize
For i = 1 To 12
strRND = strRND & ChrW(Rnd * 25 + 40)
Next
txtRND.Text = strRND
End Sub