VB 版 Authcode 加解密函数

Private Function Authcode(ByVal enstr As String, Optional ByVal operation As String = "DECODE", Optional ByVal keystr As String = "abcd", Optional ByVal expiry As Long = 0, Optional okeylng As Integer = 6) As String

    Dim ckeylng As Integer, key As String, keya As String, keyb As String, keyc As String
    Dim cryptkey() As Byte, keylng As Long, strv() As Byte, str2 As String, valid As String

    Dim box(255) As Long, rndkey(255) As Long, i As Long, J As Long, tmp As Long
    Dim wyh() As Byte, a As Long, tmplng As Long, rs As String, strlng As Long

    On Error GoTo fauthcode
    ckeylng = okeylng

    key = md5(keystr)
    keya = md5(Mid(key, 1, 16))
    keyb = md5(Mid(key, 17, 16))

    If ckeylng <> 0 And ckeylng < 33 Then
        If operation = "DECODE" Then
            keyc = Mid(enstr, 1, ckeylng)
        Else
            keyc = Mid(md5(GetTimes() & Timer() & (Rnd * 100000)), 1, ckeylng)
        End If
    Else
        keyc = ""
    End If

    cryptkey = StrConv(keya + md5(keya & keyc), vbFromUnicode)
    keylng = UBound(cryptkey) + 1

    If operation = "DECODE" Then
        'str2 = DecodeBase64String(Mid(enstr, ckeylng + 1, Len(enstr) - ckeylng))
        strv = DecodeBase64Byte(Mid(enstr, ckeylng + 1, Len(enstr) - ckeylng))
    Else
        If (expiry <= 0) Then
            valid = "0000000000"
        Else
            valid = expiry + GetTimes()
        End If
        str2 = valid + Mid(md5(enstr + keyb), 1, 16) + enstr
        strv = StrConv(str2, vbFromUnicode)
    End If
    'strv = StrConv(str2, vbFromUnicode)
    strlng = UBound(strv)

    For i = 0 To 255
        box(i) = i
    Next
    For i = 0 To 255
        rndkey(i) = cryptkey(i Mod keylng)
    Next
    J = 0
    For i = 0 To 255
        J = (J + box(i) + rndkey(i)) Mod 256
        tmp = box(i)
        box(i) = box(J)
        box(J) = tmp
    Next

    ReDim wyh(strlng)
    a = 0
    J = 0
    For i = 0 To strlng
        a = (a + 1) Mod 256
        J = (J + box(a)) Mod 256
        tmp = box(a)
        box(a) = box(J)
        box(J) = tmp
        tmplng = (box(a) + box(J)) Mod 256
        wyh(i) = strv(i) Xor box(tmplng)

    Next

    If operation = "DECODE" Then
        str2 = StrConv(wyh, vbUnicode)
        If Mid(str2, 1, 10) = "0000000000" Or CLng(Mid(str2, 1, 10)) - GetTimes() > 0 Then
            If Mid(str2, 11, 16) = Mid(md5(Mid(str2, 27, Len(str2) - 26) + keyb), 1, 16) Then
                rs = Mid(str2, 27, Len(str2) - 26)
            Else
                rs = ""
            End If
        Else
            rs = ""
        End If
        Authcode = rs
    Else
        Authcode = keyc & EncodeBase64Byte(wyh)
    End If
    Exit Function
fauthcode:
    Authcode = ""
End Function
赞(0) 打赏
取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

    暂无评论...