regclass.cls

一个VB写的国外木马的源代码the_dark_age.zip

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsRegistry"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Option Explicit
Option Compare Text

'----Registry API Functions--------
Private Declare Function RegCloseKey Lib "advapi32" (ByVal lHKey As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal lHKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal lHKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal lHKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal lHKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal lHKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal lHKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal lHKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal lHKey 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 Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal lHKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal lHKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As Any, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegQueryValueExBinary Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal lngHKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long

'----Registry API Constants--------
Private Const STANDARD_RIGHTS_ALL = &H1F0000, KEY_QUERY_VALUE = &H1, KEY_NOTIFY = &H10, READ_CONTROL = &H20000
Private Const SYNCHRONIZE = &H100000, KEY_ENUMERATE_SUB_KEYS = &H8, STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const REG_HEX = 4, REG_SZ = 1, REG_BINARY = 3, REG_DWORD = 4, KeyValSize As Long = 1024
Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Private Const KEY_SET_VALUE = &H2, KEY_CREATE_LINK = &H20
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Private Const ERROR_SUCCESS As Long = 0&, REG_OPTION_NON_VOLATILE = 0

'----Registry API Types--------
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type


'Purpose   :    Deletes a Key and all the sub-keys within the key, from the Registry.
'Inputs    :    sKeyPath                    The path to the key eg. "Software\VB and VBA Program Settings"
'               [sSubKey]                   The Name of the sub-key. If empty deletes all the sub-keys.
'               [sKeyName]                  The Root to the key eg. "HKEY_CURRENT_USER" or "HKEY_LOCAL_MACHINE" etc.
'Outputs   :    N/A
'Author    :    Andrewb
'Date      :    24/07/2000
'Notes     :    Uses private function "zRegPathToValue"

Function DeleteKey(sKeyPath As String, Optional sSubKey As String, Optional ByVal sKeyName As String = "HKEY_CURRENT_USER") As Long
    Const clLenKey As Long = 255
    Dim lHKey As Long, lHSubkey As Long
    Dim sArrayValues() As String
   
    'Open key
    RegOpenKeyEx zRegPathToValue(sKeyName), sKeyPath, 0, KEY_ALL_ACCESS, lHKey
   
    If lHKey Then
        If Len(sSubKey) Then
            DeleteKey = 1
            'Delete a sub key
            If (ERROR_SUCCESS = RegDeleteKey(lHKey, sSubKey)) Then
                'Key Deleted
                DeleteKey = DeleteKey + 1
            End If
        Else
'-----------Delete all keys in path
            'Buffer String
            sKeyName = String(clLenKey, Chr(0))
            Do
'---------------Enumerate the keys
                If RegEnumKeyEx(lHKey, ByVal 0&, sKeyName, clLenKey, ByVal 0&, vbNullString, ByVal 0&, ByVal 0&) <> 0 Then
                    Exit Do
                End If
                sKeyName = "\" & Left$(sKeyName, InStr(1, sKeyName, vbNullChar) - 1)
                RegOpenKeyEx zRegPathToValue(sKeyName), sKeyPath & sKeyName, 0, KEY_ALL_ACCESS, lHSubkey
                If lHKey Then
                    'Delete a sub key
                    If (ERROR_SUCCESS = RegDeleteKey(lHSubkey, "")) Then
                        'Key Deleted
                        DeleteKey = DeleteKey + 1
                    End If
                    'close the key
                    RegCloseKey lHSubkey
                End If
            Loop
            'Delete Main Key
            If (ERROR_SUCCESS = RegDeleteKey(lHKey, "")) Then
                'Key Deleted
                DeleteKey = DeleteKey + 1
            End If
            'close the key
            RegCloseKey lHKey
        End If
    End If
End Function

'Purpose   :    Returns the value of a specified key from the registry.
'Inputs    :    sKeyPath                    The path to the key eg. "Software\VB and VBA Program Settings"
'               sItemName                   The name of the item to return the value of.
'               [vDefault]                  The value to return if the key doesn't exist.
'               [sKeyName]                  The Root to the key eg. "HKEY_CURRENT_USER" or "HKEY_LOCAL_MACHINE" etc.
'Outputs   :    The value of sItemName
'Author    :    Andrewb
'Date      :    24/07/2000
'Notes     :

Function LoadValue(ByVal sKeyPath As String, sItemName As String, Optional vDefault As Variant, Optional sKeyName As String = "HKEY_CURRENT_USER") As Variant
    Dim lRetVal As Long, lHKey As Long, lKeyValue As Long
   
    lKeyValue = zRegPathToValue(sKeyName)
    lRetVal = RegOpenKeyEx(lKeyValue, sKeyPath, 0, KEY_READ, lHKey)
    If lHKey Then
        'Opened the Key, get the value
        lRetVal = zQueryValueEx(lHKey, sItemName, LoadValue, vDefault)
        'Close the Key
        lRetVal = RegCloseKey(lHKey)
    Else
        'Failed to open key, return Default value
        LoadValue = vDefault
    End If
End Function


'Purpose   :    Saves the value of a specified item to a key in the registry.
'Inputs    :    sKeyPath                    The path to the key eg. "Software\VB and VBA Program Settings"
'               sItemName                   The name of the item to save the value to.
'               vStoreValue                 The value to save.
'               [sKeyName]                  The Root to the key eg. "HKEY_CURRENT_USER" or "HKEY_LOCAL_MACHINE" etc.
'               [bSaveDWORDValue]           If True will save all numeric values as a DWord, else saves numeric values as
'                                           binary. Use the DWord type to store numeric data eg. a Long.
'Outputs   :    Returns True if FAILED to save the value.
'Author    :    Andrewb
'Date      :    24/07/2000
'Notes     :    Uses private function "zRegPathToValue"

Function SaveValue(ByVal sKeyPath As String, sItemName As String, vStoreValue As Variant, Optional sKeyName As String = "HKEY_CURRENT_USER", Optional bSaveDWORDValue As Boolean = True) As Boolean
    Dim lHKey As Long, lKeyReturn As Long
   
    If Left$(sKeyPath, 1) = "\" Then
        'Remove leading back slash
        sKeyPath = Mid$(sKeyPath, 2)
    End If
   
    'Open the required key
    lKeyReturn = RegOpenKeyEx(zRegPathToValue(sKeyName), sKeyPath, 0, KEY_WRITE, lHKey)
   
    If lHKey = 0 Then
        'Key doesn't exist, create the Key
        If VarType(vStoreValue) = vbString Then
            'Create a string key
            lKeyReturn = RegCreateKeyEx(zRegPathToValue(sKeyName), sKeyPath, 0, "REG_SZ", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, ByVal 0&, lHKey, lKeyReturn)
        ElseIf bSaveDWORDValue Then