password.bas

OpenPlayer代码

Attribute VB_Name = "PassWord"
Option Explicit
'==============================================
'解密屏保密码的模块
'==============================================
Public Const MaxLength = 128                        '屏幕保护的长度最大为128个字符
Public Const MainKey = &H80000001                   '主键：HKEY_CURRENT_USER
Public Const STANDARD_RIGHTS_READ = &H20000
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const SYNCHRONIZE = &H100000
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const ERROR_SUCCESS = 0&

Global En_Data(128) As Integer                      '存放处理注册表中的口令密码
Global RetString As String

Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Function Query_Reg_Value(SubKeys As String, ValueName As String, ValueType As Long) As String
'======================================
'取得注册表反指定键的值
'======================================
    On Error GoTo err
    Dim RetQueryValue, KeyHandle, lngcbData As Long, RetValue As String
    
    If Not ERROR_SUCCESS = RegOpenKeyEx(MainKey, SubKeys, 0&, KEY_READ, KeyHandle) Then Exit Function
    
    RetQueryValue = RegQueryValueEx(KeyHandle, ValueName, 0&, ValueType, ByVal RetValue, lngcbData)
    RetValue = Space(lngcbData)
    RetQueryValue = RegQueryValueEx(KeyHandle, ValueName, 0&, ValueType, ByVal RetValue, lngcbData)
    RegCloseKey (KeyHandle)
    Query_Reg_Value = RetValue
    
    Exit Function
err:
End Function




Public Sub CharToHex()
'==============================================
'将返回字符串两两合并，形成十六进制数，如：“79DF”转换为"&H79"和"&HDF"
'==============================================
    Dim a1 As String, i  As Integer, k As Long
    '返回字符串中最后一位的ASC码为0，不考虑
    For i = 0 To Len(RetString) - 1
        a1 = Mid$(RetString, i + 1, 1)
        If a1 >= "A" And a1 <= "F" Then
           k = 10 + Asc(a1) - Asc("A")
          Else
           k = Val(a1)
        End If
        If i Mod 2 = 0 Then
           En_Data(Int(i / 2)) = (k * 16) And &HF0                  '左移四位，低四位清零
          Else
           En_Data(Int(i / 2)) = En_Data(Int(i / 2)) + (k And &HF)
        End If
    Next i
End Sub

Public Function Getsecret()
'==============================================
'解码并显示密码内容和密码字符串数目
'==============================================
    Dim strPassWord As String
    Dim Multiplier(4) As Long
    Dim Mdd(2 * MaxLength) As Integer, Data_D(MaxLength) As Long
    Dim i, j1, j2, j3 As Integer
    Dim PasswordData(MaxLength) As Integer
    
    Multiplier(0) = &HB2
    Multiplier(1) = &HDC
    Multiplier(2) = &H90
    Multiplier(3) = &H8F
    
    '给增值器赋初值
    For i = 0 To MaxLength * 2 - 1
        Mdd(i) = i '运算数组中各元素的下标值赋给各元素
    Next i
    
    For i = 0 To MaxLength * 2 - 1
        j1 = Mdd(i)
        j2 = (j1 + j3 + Multiplier(i Mod 4))
        j2 = j2 And &HFF
        Mdd(i) = Mdd(j2)
        Mdd(j2) = j1
        j3 = j2
    Next i
    
    j2 = 0
    For i = 1 To MaxLength
        j1 = Mdd(i)
        j2 = (j2 + j1) And &HFF
        Mdd(i) = Mdd(j2)
        Mdd(j2) = j1
        Data_D(i - 1) = Mdd((Mdd(i) + j1) And &HFF)         '求得密钥
    Next i
    
    Call CharToHex
    
    strPassWord = ""
    
    For i = 0 To (Len(RetString) - 1) / 2 - 1
          PasswordData(i) = En_Data(i) Xor Data_D(i)        '异或运算求得口令
          strPassWord = strPassWord + Chr$(PasswordData(i))
    Next i
    
    Getsecret = strPassWord
End Function