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