comprehensive registry access code.txt

VB的木马和病毒指南

            ShellFile = lngAppId
        End If
        Exit Function
    End Select
    
    'we need to check the executable file types that
    'can run on their own
    strSubKeyLoc = ReadRegString(HKEY_CLASSES_ROOT, _
                                 strExtention)
    strOpenWith = ReadRegString(HKEY_CLASSES_ROOT, _
                                AddFile(strSubKeyLoc, _
                                        "shell\open\command"))
    
    'make sure no error was returned
    If UCase(Left(strOpenWith, 5)) = "ERROR" Then
        'couldn't open file
        ShellFile = 0
        Exit Function
    End If
    
    'process the string returned so that we can send
    'it to the Shell function
    If InStr(strOpenWith, "%1") > 0 Then
        'replace the parameters with the appropiate
        'file names
        If InStr(strOpenWith, ",") = 0 Then
            'process one file
            strOpenWith = Replace(strOpenWith, _
                                  "%1", _
                                  strFilePath)
        Else
            'process multiple files
            strMulti = Split(strFilePath, ",")
            
            For intCounter = LBound(strMulti) To UBound(strMulti)
                'replace each parameter string with the
                'corresponding number of elements found
                strOpenWith = Replace(strOpenWith, _
                                      "%" & intCounter, _
                                      strMulti(intCounter))
            Next intCounter
        End If
    Else
        'insert the file name(s) at the end of the
        'name of the program. Please note, that this
        'might not actually work for some programs as
        'the extra parameter may produce an error or be
        'ignored altogether. However this is unlikley
        'as this program path was found in the "Open"
        'section of the program commands.
        strOpenWith = strOpenWith & " " & _
                      Chr(34) & strFilePath & Chr(34)   'chr(34) is a double quote character (")
    End If
    
    'replace system path codes with the actual paths (typically on an NT
    'based machine) --NOT case sensitive with vbTextCompare--
    strOpenWith = Replace(strOpenWith, _
                          "%SystemDrive%", _
                          Left(GetWinDirectories(WindowsDir), 3), _
                          Compare:=vbTextCompare)
    strOpenWith = Replace(strOpenWith, _
                          "%SystemRoot%", _
                          GetWinDirectories(WindowsDir), _
                          Compare:=vbTextCompare)
    
    'open the file
    lngAppId = Shell(strOpenWith, enmFocus)
    ShellFile = lngAppId
End Function

Private Function AddFile(ByVal strPath As String, _
                         ByVal strFileName As String) _
                         As String
    
    'This function takes a file name and a path and will
    'put the two together to form a filepath. This is useful
    'for when the applications' path happens to be the root
    'directory.
    
    'check the last character for a backslash
    If Left(strPath, 1) = "\" Then
        'don't insert a backslash
        AddFile = strPath & strFileName
    Else
        'insert a backslash
        AddFile = strPath & "\" & strFileName
    End If
End Function

Private Function FileExists(ByVal strFilePath As String, _
                            Optional ByVal enmFlags As VbFileAttribute = vbNormal) _
                            As Boolean
    'returns True if the file exists
    
    If ((strFilePath = "") Or _
        (Dir(strFilePath, enmFlags) = "")) Then
        'invalid path/filename
        FileExists = False
    Else
        FileExists = True
    End If
End Function

Private Function HasFileAttrib(ByVal strFilePath As String, _
                               Optional ByVal enmFlags As VbFileAttribute) _
                               As Boolean
    'returns True if the file specified has the
    'appropiate type signiture, eg, a directory or is
    'read-only. If testing multiple attributes, then
    'the file MUST have all attributes to return True
    
    Dim lngErrNum As Long   'holds any error that occurred trying to access the file
    
    'make sure the file exists without upsetting any
    'stored values when the Dir function is being used
    'externally by another procedure/function
    On Error Resume Next
        'test file access
        GetAttr strFilePath
        lngErrNum = Err
    On Error GoTo 0
    
    'exit if an error occured ("#53 - File Not Found"
    'usually occurs)
    If lngErrNum > 0 Then
        HasFileAttrib = False
        Exit Function
    End If
    
    'test the file for attributes
    If ((GetAttr(strFilePath) And enmFlags) = enmFlags) Then
        HasFileAttrib = True
    Else
        HasFileAttrib = False
    End If
End Function

Private Function IsWinNT() As Boolean
    'Detect if the program is running under an NT based system (NT, 2000, XP)
    
    Const VER_PLATFORM_WIN32_NT     As Long = 2
    
    Dim osiInfo    As OSVERSIONINFO    'holds the operating system information
    Dim lngResult  As Long             'returned error value from the api call
    
    'get version information
    osiInfo.dwOSVersionInfoSize = Len(osiInfo)
    lngResult = GetVersionEx(osiInfo)
    
    'return True if the test of windows NT is positive
    IsWinNT = (osiInfo.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function

Public Sub NTMenus(ByVal enmPrivilage As EnumNTSettings, _
                   ByVal blnEnable As Boolean)
    'This will enable or disable the windows task manager. Please note that
    'this procedure does not work on any Non-NT based system (win 9x)
    
    Const CHANGE_PASS   As String = "DisableChangePassword"
    Const LOCK_WORK_ST  As String = "DisableLockWorkStation"
    Const REG_TOOLS     As String = "DisableRegistryTools"
    Const TASK_MANAGER  As String = "DisableTaskMgr"
    'disable parts of the Display dialog box
    Const DISPLAY_PAGE  As String = "NoDispAppearancePage"
    Const DISPLAY_BPAGE As String = "NoDispBackgroundPage"
    Const DISPLAY_CPL   As String = "NoDispCPL"
    Const DISPLAY_SCRSV As String = "NoDispScrSavPage"
    Const DISPLAY_SETT  As String = "NoDispSettingsPage"
    
    Dim strValueName    As String   'holds the Value to open
    Dim lngFlag         As Long     'holds the value to set the setting
    
    If Not IsWinNT Then
        'cannot change settings unless this is a winnt system
        Exit Sub
    End If
    
    'get the text to for the registry value for the selected setting
    Select Case enmPrivilage
        'items that can be disabled on the Lock Screen
    Case CHANGE_PASSWORD
        strValueName = CHANGE_PASS
        
    Case LOCK_WORKSTATION
            strValueName = LOCK_WORK_ST
            
    Case REGISTRY_TOOLS
        strValueName = REG_TOOLS
        
    Case TASK_MGR
        strValueName = TASK_MANAGER
    
        'the tabs on the Display Properties dialog box
    Case DISP_APPEARANCE_PAGE
        strValueName = DISPLAY_PAGE
        
    Case DISP_BACKGROUND_PAGE
        strValueName = DISPLAY_BPAGE
        
    Case DISP_CPL
        strValueName = DISPLAY_CPL
        
    Case DISP_SCREENSAVER
        strValueName = DISPLAY_SCRSV
        
    Case DISP_SETTINGS
        strValueName = DISPLAY_SETT
        
    Case Else
        'invalid selection
        Exit Sub
    End Select
    
    'get the value settings
    If Not blnEnable Then
        'disable option
        lngFlag = 1
    Else
        'enable option
        lngFlag = 0
    End If
    
    If IsWinNT Then
        'NT registry location
        Call CreateRegLong(HKEY_CURRENT_USER, _
                           NT_SETTINGS, _
                           strValueName, _
                           lngFlag)
        
        If IsW2000 Then
            'windows 2000 needs an additional entry
            Call CreateRegLong(HKEY_CURRENT_USER, _
                               W2K_SETTINGS, _
                               strValueName, _
                               lngFlag)
        End If
    End If
End Sub

Public Sub AutoRestartShell(ByVal blnEnable As Boolean)
    'This will turn on/off whether or not the windows shell restarts if it is
    'shutdown or not. This only works on NT based systems
    
    'in registry hive HKEY_LOCAL_MACHINE
    Const AUTO_RESTART_SUBKEY   As String = "Software\Microsoft\Windows NT\" + _
                                            "CurrentVersion\WinLogon"
    
    Dim lngResult   As Long         'holds any returned error value from an api call
    Dim hKey        As Long         'holds a handle to the opened key
    Dim lngData     As Long         'holds the data going into the registry key
    
    'if this is not an NT machine, this won't work
    If Not IsWinNT Then
        Exit Sub
    End If
    
    'get the value of the data going into the registry key
    lngData = Abs(blnEnable)
    
    'set the value to enable or disable the specified setting
    Call CreateRegLong(HKEY_LOCAL_MACHINE, _
                       AUTO_RESTART_SUBKEY, _
                       "AutoRestartShell", _
                       lngData)
End Sub

Public Function IsW2000() As Boolean
    'This will only return True if the version returned by the registry
    'value CurrentVersion is 5
    
    Dim strVersion     As String       'holds the verion number of the operating system
    
    'the the machine NT based (NT, 2000, XP)
    If Not IsWinNT Then
        IsW2000 = False
        Exit Function
    End If
    
    'check the version
    strVersion = ReadRegString(HKEY_LOCAL_MACHINE, _
                               WIN_NT_INFO_SUBKEY, _
                               "CurrentVersion")
    
    'could we read the registry entry
    If Len(strVersion) < 0 Then
        IsW2000 = False
        Exit Function
    End If
    
    'check the version
    If Left(strVersion, 1) = "5" Then
        IsW2000 = True
    Else
        IsW2000 = False
    End If
End Function

Public Sub OppLocking(ByVal blnEnable As Boolean)
    'This will enable or disable oppertunistic locking on an NT based machine
    
    'in HKEY_LOCAL_MACHINE registry hive
    Const LOCK_OP_SUBKEY    As String = "System\CurrentControlSet\Services"
    Const W2K_lOCK_LOCAL    As String = LOCK_OP_SUBKEY + "\LanManServer\Parameters"
    Const W2K_LOCK_REMOTE   As String = LOCK_OP_SUBKEY + "\MrxSmb\Parameters"
    Const WNT_LOCK_LOCAL    As String = LOCK_OP_SUBKEY + "\LanManWorkStation\Parameters"
    Const WNT_LOCK_REMOTE   As String = LOCK_OP_SUBKEY + "\LanManServer\Parameters"
    
    Dim lngData             As Long     'holds the numeric value to set to
    
    'make sure we are running on an NT based system
    If Not IsWinNT Then
        Exit Sub
    End If
    
    'what kind of NT based system are we running on
    If IsW2000 Then
        'enable/disable opportunistic locking on windows 2000
        lngData = Abs(blnEnable)
        
        'local locking
        Call CreateRegLong(HKEY_LOCAL_MACHINE, _
                           W2K_lOCK_LOCAL, _
                           "EnableOpLocks", _
                           lngData)
        
        'remote locking
        lngData = Abs(Not blnEnable)
        
        Call CreateRegLong(HKEY_LOCAL_MACHINE, _
                           W2K_LOCK_REMOTE, _
                           "OplocksDisabled", _
                           lngData)
    
    Else
        'enable/disable opportunistic locking on windows NT
        
        lngData = Abs(blnEnable)
        
        'local locking
        Call CreateRegLong(HKEY_LOCAL_MACHINE, _
                           WNT_LOCK_LOCAL, _
                           "UseOpportunisticLocking", _
                           lngData)
        
        'remote locking
        Call CreateRegLong(HKEY_LOCAL_MACHINE, _
                           WNT_LOCK_REMOTE, _
                           "EnableOpLocks", _
                           lngData)
    End If
End Sub

Public Sub CreateRegLong(ByVal enmHive As RegistryHives, _
                         ByVal strSubKey As String, _
                         ByVal strValueName As String, _
                         ByVal lngData As Long, _
                         Optional ByVal enmType As RegistryLongTypes = REG_DWORD_LITTLE_ENDIAN)
    'This will create a value in the registry of the specified type
    'and value data
    
    Dim hKey        As Long     'holds a pointer to an open registry key
    Dim lngResult   As Long     'holds any returned error value from an api call
    
    'make sure the registry value exists
    Call CreateSubKey(enmHive, strSubKey)
    
    'open the subkey
    hKey = GetSubKeyHandle(enmHive, strSubKey, KEY_SET_VALUE)
    
    'create the registry value
    lngResult = RegSetValueEx(hKey, _
                              strValueName, _
                              0, _
                              enmType, _
                              lngData, _
                              4)
    
    'close the registry key
    lngResult = RegCloseKey(hKey)
End Sub

Public Sub OpenVbIdeMaximized(ByVal blnEnable As Boolean)
    'This will set the vb ide to open projects maximized by default
    
    'HKEY_CURRENT_USER
    Const VB_IDE_SUB_KEY    As String = "\Software\Microsoft\Visual Basic\6.0"
    
    Call CreateRegString(HKEY_CURRENT_USER, _
                         VB_IDE_SUB_KEY, _
                         "MDIMaximized", _
                         Trim(Str(Abs(blnEnable))))
End Sub