求一个VB6的加密解密算法

[simon803]

三个变量 1221 3355 8899
加密成一串数字

解密后可以还原回去。

我希望是加密后顺序错乱的，解密后再还原顺序，

防止加密后的密文数字被人修改后解密得到的不是原始变量。

也就是说生成的密文如果被人随意修改会提示错误，类似密码那样。

[simon803]

可以提供下具体代码吗

[ningweidong]

你不可能知道密文有没有被修改。
你可以用AES加解密,你可以在网上找一下算法

[咸清]

vb的RSA64位加密算法网上不是很多吗？

[booksoon]

rsa~~~

[倒大霉的上帝]

调用：

Private Sub Command1_Click()
   MsgBox ZipBase64String("abc")
   MsgBox UnZipBase64String(ZipBase64String("abc"))
End Sub

加密解密模块代码：

Option Explicit

Private Const BASE64CHR As String = "AbclmndefghiBCD23+EFGH/45IJPQRSvwxTUV6789WXYZajkoK01LMNOpqrstuyz="
Private Const mCODE As String = "C79D82IJKNQRLABMSFGH1TU3Z04VW6XYO5EP"
Private mvarCodeString(0 To 34)
Private psBase64Chr(0 To 63) As String
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Any, ByVal cbCopy As Long)
Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (dest As Any, ByVal numBytes As Long)

Private Type SYSTEM_INFO
    wProcessorArchitecture As Integer
    wReserved As Integer
    dwPageSize As Long
    lpMinimumApplicationAddress As Long
    lpMaximumApplicationAddress As Long
    dwActiveProcessorMask As Long
    dwNumberOfProcessors As Long
    dwProcessorType As Long
    dwAllocationGranularity As Long
    wProcessorLevel As Integer
    wProcessorRevision As Integer
End Type

Private Declare Function apiGetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (lpRootPathName As String, lpVolumeNameBuffer As Any, ByVal nVolumeNameSize As Long, ByRef lpVolumeSerialNumber As Long, lpMaximumComponentLength As Any, lpFileSystemFlags As Any, lpFileSystemNameBuffer As Any, ByVal nFileSystemNameSize As Long) As Boolean
Private Declare Sub apiGetSystemInfo Lib "kernel32" Alias "GetSystemInfo" (lpSystemInfo As SYSTEM_INFO)


'转换字符串为BASE64字符串，转换3个8比特(0 to 255)的字符成为4个6比特(0 to 63),不足以=填充
Public Function ZipBase64String(str2Encode As String) As String
    Dim lCtr As Long
    Dim lPtr As Long
    Dim lLen As Long
    Dim sValue() As Byte
    Dim sEncoded As String
    Dim Bits8(1 To 3) As Byte
    Dim Bits6(1 To 4) As Byte
    Dim i As Integer
    
    Call PasswordInitialize
    
    '获得3个字符
    sValue = StrConv(str2Encode, vbFromUnicode)
    For lCtr = 1 To UBound(sValue) + 1 Step 3
    
    For i = 1 To 3
    If lCtr + i - 2 <= UBound(sValue) Then
    Bits8(i) = sValue(lCtr + i - 2)
    lLen = 3
    Else
    Bits8(i) = 0
    lLen = lLen - 1
    End If
    Next
    
    '转换字符串为数组，然后转换为4个6位(0-63)
    Bits6(1) = (Bits8(1) And &HFC) \ 4
    Bits6(2) = (Bits8(1) And &H3) * &H10 + (Bits8(2) And &HF0) \ &H10
    Bits6(3) = (Bits8(2) And &HF) * 4 + (Bits8(3) And &HC0) \ &H40
    Bits6(4) = Bits8(3) And &H3F
    
    '添加4个新字符
    For lPtr = 1 To lLen + 1
    sEncoded = sEncoded & psBase64Chr(Bits6(lPtr))
    Next
    Next
    
    '不足4位，以=填充
    Select Case lLen + 1
    Case 2: sEncoded = sEncoded & "=="
    Case 3: sEncoded = sEncoded & "="
    Case 4:
    End Select
    ZipBase64String = sEncoded
End Function


'解压BASE64字符串
Public Function UnZipBase64String(str2Decode As String) As String
    Dim lPtr As Long
    Dim iValue As Integer
    Dim iLen As Integer
    Dim iCtr As Integer
    Dim Bits(1 To 4) As Byte
    Dim strDecode As String
    Dim str As String
    Dim Output() As Byte
    Dim iIndex As Long
    Dim lFrom As Long
    Dim lTo As Long
    
    Call PasswordInitialize
    
    '除去回车
    str = Replace(str2Decode, vbCrLf, "")
    
    '每4个字符一组（4个字符表示3个字）
    For lPtr = 1 To Len(str) Step 4
    iLen = 4
    For iCtr = 0 To 3
    
    '找字符在BASE64字符串中的位置
    iValue = InStr(1, BASE64CHR, Mid$(str, lPtr + iCtr, 1), vbBinaryCompare)
    Select Case iValue 'A~Za~z0~9+/
    Case 1 To 64:
    Bits(iCtr + 1) = iValue - 1
    Case 65 '=
    iLen = iCtr
    Exit For
    
    '没有发现
    Case 0: Exit Function
    End Select
    Next
    
    '转换4个6比特数成为3个8比特数
    Bits(1) = Bits(1) * &H4 + (Bits(2) And &H30) \ &H10
    Bits(2) = (Bits(2) And &HF) * &H10 + (Bits(3) And &H3C) \ &H4
    Bits(3) = (Bits(3) And &H3) * &H40 + Bits(4)
    
    '计算数组的起始位置
    lFrom = lTo
    lTo = lTo + (iLen - 1) - 1
    
    '重新定义输出数组
    ReDim Preserve Output(0 To lTo)
    
    For iIndex = lFrom To lTo
    Output(iIndex) = Bits(iIndex - lFrom + 1)
    Next
    lTo = lTo + 1
    
    Next
    
    UnZipBase64String = StrConv(Output, vbUnicode)
End Function
'初始化
Public Sub PasswordInitialize()
    Dim iPtr As Integer
    '初始化 BASE64数组
    For iPtr = 0 To 63
    psBase64Chr(iPtr) = Mid$(BASE64CHR, iPtr + 1, 1)
    Next
End Sub

'初始化
Public Sub CodePasswordInitialize()
    Dim intI As Integer
    For intI = 0 To 34
        mvarCodeString(intI) = Mid(mCODE, intI + 1, 1)
    Next
End Sub

[嗷嗷叫的老马]

哈哈,我也想说BASE64来着....

[几罗星人]

其实你要加密,也不难,这三个数1221 3355 8899,你可以按照特定的规则进行计算,如:
1221+3355*1221-8899^3+1-1221^2+3355*8899=33852617
然后因为你知道特定的算法,就可以像解方程一样将原来的数算出来,其实这只是个示例,希望给你提供个思路.

[zwj1988522]

[Quote=引用 2 楼 jiashie 的回复:]
加校验，
除非别人知道校验码的生成规则，否则修改后会提示出错的（当然，校验码的生成算法有缺陷如碰撞等，也可能即使修改后碰巧校验码和以前一样）
[/Quote]

可以使用CRC校驗，加個checkSUM值。。

[无·法]

加密这个方法不是固定的，可以自己定义个简单的规则，然后纯字符串处理即可。

[东方之珠]

自己做一个简单的字符串加密、解密就可以了。已知的加密、解密方法大家都知道。

[神马被哪个妞占用了呢]

变量不是很多的话，可预加密后拿密文去比较，没有符合的表示密文被修改。
要求不是很高的话，随便处理下就行了，比如MD5以后只取其中数字

[神马被哪个妞占用了呢]

变量不多，还原就可要可不要了。既然是要比较，还不如拿加密后的数据去比较

[赵4老师]

说白了就是这么个过程：
因为
md5("1221 3355 8899"+"口令")="9044a9da1f5bb1ca017238cf91d7fa75"
所以你代码里面预先保存两个变量
str1="1221 3355 8899"
md5str="9044a9da1f5bb1ca017238cf91d7fa75"
要求被校验的用户输入password，
如果
md5("1221 3355 8899"+password)<>"9044a9da1f5bb1ca017238cf91d7fa75"
就说明该用户输入的password不是"口令"

[of123]

密文防篡改，其实都不一定需要校验算法。

好的加密算法是比特扩展的。也就是说，只要明文有一个比特变化，就会引起密文所有比特的变化。因此，你可以在明文中任何确定的位置，增加一个固定的“盐”。解密时，检查盐是否正确即可。

实际上，任何标准的分组算法都是可用的，例如 TDES, AES 等等。

[simon803]

要是可以提供具体的代码就好了
本人VB菜鸟。谢谢大家的意见！

[simon803]

本人有偿求源码。
有兴趣的朋友可以联系我QQ 254933176

[倒大霉的上帝]

[Quote=引用 17 楼 simon803 的回复:]
要是可以提供具体的代码就好了
本人VB菜鸟。谢谢大家的意见！
[/Quote]
13楼不是有源码了？

[东方之珠]

枕善居的VB6源码：Base64编码、解码类,支持中文下载地址：http://www.mndsoft.com/blog/VB6/0588.html

[simon803]

有人愿意接的吗
加我QQ谈

[simon803]

继续等人接