moudle1.bas

主要是一些文件操作的技巧

Attribute VB_Name = "Moudle1"
Option Explicit

Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" _
    Alias "SendMessageA" _
    (ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) _
    As Long

Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2

Public softwareCode As String

Function KeyGen(kNamev As Variant, kPass As String, kType As Integer) As String
On Error Resume Next
Dim cTable(512) As Integer   '字符集合
Dim nKeys(16) As Integer     'pArray(x) 异或 nkeys(x)
Dim s0(512) As Integer
Dim nArray(16) As Integer
Dim pArray(16) As Integer
Dim n As Integer             '循环计数器
Dim nPtr As Integer
Dim cPtr As Integer          '指示字符
Dim cFlip As Boolean
Dim sIni As Integer
Dim temp As Integer
Dim rtn As Integer
Dim gKey As String
Dim nLen As Integer          '名称的长度
Dim pLen As Integer          '密钥的长度
Dim kPtr As Integer          '密钥
Dim sPtr As Integer
Dim nOffset As Integer
Dim pOffset As Integer       '密码偏移量
Dim tOffset As Integer       '整体偏移量
Dim KeySize As Integer

Const nXor As Integer = 18
Const pXor As Integer = 25
Const cLw As Integer = 65
Const nLw As Integer = 48
Const sOffset As Integer = 0

Dim VarType As String
Dim kName As String
Dim AryCtl As Integer
Dim AryCtrl As Control

VarType = TypeName(kNamev)

Select Case VarType
    Case "String"
        kName = kNamev
    Case "TextBox"
        kName = kNamev.Text
    Case "Object"
        For Each AryCtrl In kNamev
            If AryCtrl.Text <> "" Then
                kName = kName & AryCtrl.Text & "|"
            End If
        Next
        kName = Left(kName, Len(kName) - 1)
    Case "String()"
        For AryCtl = LBound(kNamev) To UBound(kNamev)
            If kNamev(AryCtl) <> "" Then
                kName = kName & kNamev(AryCtl) & "|"
            End If
        Next
        kName = Left(kName, Len(kName) - 1)
        Case Else
            MsgBox VarType & " 是一个不支持的加密类型"
End Select

nLen = Len(kName)
pLen = Len(kPass)

nKeys(1) = 46
nKeys(2) = 89
nKeys(3) = 142
nKeys(4) = 63
nKeys(5) = 231
nKeys(6) = 32
nKeys(7) = 129
nKeys(8) = 51
nKeys(9) = 28
nKeys(10) = 97
nKeys(11) = 248
nKeys(12) = 41
nKeys(13) = 136
nKeys(14) = 53
nKeys(15) = 78
nKeys(16) = 164

sIni = 0

'设置一个黑匣子set s boxes
For n = 0 To 512
    s0(n) = n
Next n

For n = 0 To 512
    sIni = (sOffset + sIni + n) Mod 256
    temp = s0(n)
    s0(n) = s0(sIni)
    s0(sIni) = temp
Next n

If kType = 1 Then       '数字式运算
    
    nPtr = 0
    KeySize = 16
    gKey = String(16, " ")
    
    For n = 0 To 512
        cTable(s0(n)) = (nLw + (nPtr))
        nPtr = nPtr + 1
        If nPtr = 10 Then nPtr = 0
    Next n
    
    

ElseIf kType = 2 Then   '字符运算
    
    nPtr = 0
    cPtr = 0
    KeySize = 16
    gKey = String(16, " ")
    
    cFlip = False
    For n = 0 To 512
        If cFlip Then
            cTable(s0(n)) = (nLw + nPtr)
            nPtr = nPtr + 1
            If nPtr = 10 Then nPtr = 0
            cFlip = False
        Else
            cTable(s0(n)) = (cLw + cPtr)
            cPtr = cPtr + 1
            If cPtr = 26 Then cPtr = 0
            cFlip = True
        End If
    Next n
    
    
    
Else  '16进制运算

    KeySize = 8
    gKey = String(19, " ")
    
End If

kPtr = 1

For n = 1 To nLen '名称
  nArray(kPtr) = nArray(kPtr) + Asc(Mid(kName, n, 1)) Xor nXor
  nOffset = nOffset + nArray(kPtr)
  kPtr = kPtr + 1
    If kPtr = 9 Then kPtr = 1
Next n

For n = 1 To pLen '密码
  pArray(kPtr) = pArray(kPtr) + Asc(Mid(kPass, n, 1)) Xor pXor
  pOffset = pOffset + pArray(kPtr)
  kPtr = kPtr + 1
    If kPtr = 9 Then kPtr = 1
Next n

tOffset = (nOffset + pOffset) Mod 512

kPtr = 1
sPtr = 1
For n = 1 To KeySize
  pArray(n) = pArray(n) Xor nKeys(n)
  rtn = Abs(((nArray(n) Xor pArray(n)) Mod 512) - tOffset)
  
  If kType = 3 Then '16进制密钥
        If rtn < 16 Then
            Mid(gKey, kPtr, 2) = "0" & Hex(rtn)
        Else
            Mid(gKey, kPtr, 2) = Hex(rtn)
        End If
            If sPtr = 2 And kPtr < 18 Then
                kPtr = kPtr + 1
                Mid(gKey, kPtr + 1, 1) = "-"
            End If
        kPtr = kPtr + 2
        sPtr = sPtr + 1
        If sPtr = 3 Then sPtr = 1
  Else
    Mid(gKey, n, 1) = Chr(cTable(rtn))
  End If
Next

KeyGen = gKey

End Function