OptionExplicit Function encryptSTR(BVar As Variant, Genre AsInteger) AsString 'Genre=1:加密,Genre=2:解密
Dim BCode AsInteger'随机ASCII码 Dim i AsInteger Dim j AsInteger' Dim Varbyte AsString'循环中待计算每字串字节 Dim SubVarHZ AsString'汉字字节字符串对应区域码 Dim SubVarHZbyte AsString Dim TVar AsString'加密解密后的字串 Dim TVarByte AsString'加密解密后的字串每字节处理结果 Dim BVar2 As Variant
SelectCase Genre Case1
'字符串存在chr(128)说明字符已加密,不再重复加密避免汉字字节识别错误 If InStr(1, BVar, Chr(128)) > 0Then encryptSTR = BVar ExitFunction EndIf '随机码 BCode = Int((100 * Rnd) + 1) TVar = Chr(BCode) '开始计算 For i = Len(BVar) To1Step -1 Varbyte = Mid(BVar, i, 1) '当提取到汉字(非常规字串)单独循环 If Asc(Varbyte) > 256Or Asc(Varbyte) < -1Then '将汉字转换为4位数区位码 SubVarHZ = Hex(Asc(Varbyte)) '4位区位码单独计算 For j = 1To4 Varbyte = Mid(SubVarHZ, j, 1) TVarByte = Chr(Asc(Varbyte) - BCode - ((Asc(Varbyte) - BCode) < 1) * 127) TVar = TVar & TVarByte Next '加上识别符 TVar = TVar & Chr(128) Else TVarByte = Chr(Asc(Varbyte) - BCode - ((Asc(Varbyte) - BCode) < 1) * 127) TVar = TVar & TVarByte EndIf Next TVar = Chr(Int((100 * Rnd) + 1)) & TVar encryptSTR = TVar
Case2 BVar2 = Right(BVar, Len(BVar) - 1) BCode = Asc(BVar2) For i = Len(BVar2) To2Step -1 Varbyte = Mid(BVar2, i, 1) If Asc(Varbyte) > 128Or Asc(Varbyte) < 0Then encryptSTR = BVar ExitFunction EndIf '当取到中文代号时 If Asc(Varbyte) = 128Then SubVarHZ = "" For j = 4To1Step -1 SubVarHZbyte = Chr(Asc(Mid(BVar2, i - j, 1)) + BCode + (Asc(Mid(BVar2, i - j, 1)) + BCode > 127) * 127) SubVarHZ = SubVarHZ & SubVarHZbyte Next '区域码转换为字串 TVar = TVar & Chr(Val("&h" & SubVarHZ)) i = i - 4 Else TVarByte = Chr(BCode + Asc(Varbyte) + (Asc(Varbyte) + BCode > 127) * 127) TVar = TVar & TVarByte EndIf Next encryptSTR = TVar EndSelect EndFunction