regclass.cls

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

            'Create a DWord key
            lKeyReturn = RegCreateKeyEx(zRegPathToValue(sKeyName), sKeyPath, 0, "REG_DWORD", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, ByVal 0&, lHKey, lKeyReturn)
        Else
            'Create a binary key
            lKeyReturn = RegCreateKeyEx(zRegPathToValue(sKeyName), sKeyPath, 0, "REG_BINARY", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, ByVal 0&, lHKey, lKeyReturn)
        End If
       
        If lKeyReturn <> 0 Then
            'Failed to create the key
            SaveValue = True
            Exit Function
        End If
    End If
   
    'Set the value of the existing key
    If VarType(vStoreValue) = vbString Then
        'Store a String Value
        lKeyReturn = RegSetValueExString(lHKey, sItemName, 0, REG_SZ, CStr(vStoreValue), Len(vStoreValue) + 1)
    Else
        'Store a Binary Value
        If bSaveDWORDValue Then
            'Use this for saving longs
            lKeyReturn = RegSetValueEx(lHKey, sItemName, 0, REG_DWORD, CLng(vStoreValue), 4)
        Else
            'Save binary data
            lKeyReturn = RegSetValueEx(lHKey, sItemName, 0, REG_BINARY, vStoreValue, Len(vStoreValue))
        End If
    End If
    If lKeyReturn <> ERROR_SUCCESS Then
        'Failed to set the key's value
        SaveValue = True
    End If
    'Close the Key
    lKeyReturn = RegCloseKey(lHKey)
End Function

'Purpose   :    Private function to convert the root name to a Hex value
'Inputs    :    sRegPath                The name of the root
'Outputs   :    The hex constant for the specified root.
'Author    :    Andrewb
'Date      :    24/07/2000
'Notes     :
Private Function zRegPathToValue(sRegPath As String) As Long
   
    Select Case UCase$(sRegPath)
   
    Case "HKEY_CURRENT_USER"
        zRegPathToValue = &H80000001
   
    Case "HKEY_LOCAL_MACHINE"
        zRegPathToValue = &H80000002
   
    Case "HKEY_CLASSES_ROOT"
        zRegPathToValue = &H80000000

    Case "HKEY_USERS"
        zRegPathToValue = &H80000003
   
    Case "HKEY_CURRENT_CONFIG"
        zRegPathToValue = &H80000005

    Case "HKEY_DYN_DATA"
        zRegPathToValue = &H80000006
    End Select

End Function

'Purpose     :  Reads a value from the registry
'Inputs      :  lHKey                       Handle to opened key
'               sItemName                   The name of the item to return the value of.
'               vDefault                    The default value to return if no value has been set.
'Outputs     :  vValue                      The value of the item in the registry
'               Returns error number if error occurs.
'Author      :  Andrew Baker
'Date        :  31/12/2000 13:17
'Notes       :
'Revisions   :

Private Function zQueryValueEx(ByVal lHKey As Long, ByVal sItemName As String, vValue As Variant, vDefault As Variant) As Long
    Dim lDataLen As Long, lRetVal As Long, lType As Long, lValue As Long, sValue As String
    Dim abytData() As Byte
    Const ERROR_NONE = 0
   
    On Error GoTo ErrExit

    'Determine the size and type of data to be read
    lRetVal = RegQueryValueExNULL(lHKey, sItemName, 0&, lType, 0&, lDataLen)
   
    If lRetVal = ERROR_NONE Then
        Select Case lType
       
        Case REG_SZ
            'For strings
            sValue = String$(lDataLen, 0)
            lRetVal = RegQueryValueExString(lHKey, sItemName, 0&, lType, sValue, lDataLen)
            If lRetVal = ERROR_NONE Then
                vValue = Left$(sValue, lDataLen - 1)
            Else
                vValue = vDefault
            End If
           
        Case REG_BINARY
            'For Binary Values
            ReDim abytData(lDataLen - 1) As Byte
            lRetVal = RegQueryValueExBinary(lHKey, sItemName, 0&, lType, VarPtr(abytData(0)), lDataLen)
            If lRetVal = ERROR_NONE Then
                vValue = abytData
            Else
                vValue = vDefault
            End If
       
        Case Else
            'For DWord Values
            lRetVal = RegQueryValueExLong(lHKey, sItemName, 0&, lType, lValue, lDataLen)
            If lRetVal = ERROR_NONE Then
                vValue = lValue
            Else
                vValue = vDefault
            End If
        End Select
    Else
        'Error Getting Value
        vValue = vDefault
    End If
    Exit Function
   
ErrExit:
    'Unhandled Error, return default value and error number
    vValue = vDefault
    zQueryValueEx = Err.Number
End Function


'Purpose     :  Creates and sets the value of a registry key.
'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.
'               [bCreateDWORD]
'Outputs     :  Returns True if FAILED to save the value.
'Author      :  Andrew Baker
'Date        :  23/08/2000 01:00
'Notes       :  If key already exists, uses the SaveValue function to set its value,
'               else attempts to create and set the key value.
'Revisions   :

Function CreateKey(sKeyPath As String, sItemName As String, vStoreValue As Variant, Optional sKeyName As String = "HKEY_CURRENT_USER", Optional bCreateDWORD As Boolean) As Boolean
    Dim lHKey As Long, lRet As Long, lKeyReturn As Long
   
    'Try to save the value without creating the key
    If SaveValue(sKeyPath, sItemName, vStoreValue, sKeyName, bCreateDWORD) = False Then
        'Failed to save value, try to create the Key
        If bCreateDWORD Then
            lRet = RegCreateKeyEx(zRegPathToValue(sKeyName), sKeyPath, 0, "REG_DWORD", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, ByVal 0&, lHKey, lKeyReturn)
        Else
            lRet = RegCreateKeyEx(zRegPathToValue(sKeyName), sKeyPath, 0, "REG_SZ", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, ByVal 0&, lHKey, lKeyReturn)
        End If
        CreateKey = (lRet <> ERROR_SUCCESS)
        'Close the Key
        lKeyReturn = RegCloseKey(lHKey)
    End If
End Function