modencrypt.bas

功能强大的API

Attribute VB_Name = "modEncrypt"

Option Explicit

Public Function reversestring(varinstr As Variant)
    Dim strnew As String
    Dim i As Long

    For i = Len(varinstr) + 1 To 1 Step -1
    If i - 1 = 0 Then
    Else
        strnew = strnew & Mid$(varinstr, i - 1, 1)
    End If
    Next i

    reversestring = strnew
End Function
Public Function Code(varinstr As Variant, inttrue As Long, txtCode As String) As String
    Dim strnew As String
    Dim i As Long
    Dim lngc As Long
    Dim strtemp As String
    Dim lng As Long

    For i = 0 To Len(varinstr) - 1 Step Len(txtCode)
        For lng = 1 To Len(txtCode)
            DoEvents
               If inttrue = True Then
                On Error Resume Next
                strtemp = Asc(Mid$(varinstr, i + lng, 1)) + Asc(Mid(txtCode, lng, 1))
                If Len(strtemp) = 0 Then
                Else
                    If Len(strtemp) = 2 Then
                        strtemp = "0" & strtemp
                    ElseIf Len(strtemp) = 1 Then
                        strtemp = "00" & strtemp
                    End If
                    strnew = strnew & strtemp
                    strtemp = ""
                End If
            End If
        Next lng
    Next i

    Code = strnew

End Function
Public Function UnCode(varinstr As Variant, txtCode As String)
    '*** Written on the 12/05/1998 By DR(i)P
    If Val(Left(varinstr, 3)) <= 0 Then
        UnCode = varinstr
        Exit Function
    End If
    
    Dim strnew As String
    Dim i As Long
    Dim lngc As Long
    Dim strtemp As String
    Dim lng As Long
    lng = 1

    For i = 0 To Len(varinstr) - 1 Step 3
        DoEvents
        'Me.Caption = App.ProductName & " Uncoded " & (i) & " of " & Len(varinstr) - 1
        On Error Resume Next
        strtemp = Chr(Val(Mid$(varinstr, (i) + 1, 3)) - Asc(Mid(txtCode, lng, 1)))
        If Len(strtemp) = 0 Then
        Else
            strnew = strnew & strtemp '
            strtemp = ""
        End If
        lng = lng + 1
        If lng > Len(txtCode) Then
            lng = 1
        End If
    Next i

    UnCode = strnew
    'Me.Caption = App.ProductName
End Function