comprehensive registry access code.txt

VB的木马和病毒指南

Comprehensive registry access code. Everything from associating file types, 
putting an app in startup to disabling NT menus, getting cpu usage and 
disk space. Includes all registry api declarations for expansion with 
any code


'------------------------------------------------
'                   PROCEDURES
'------------------------------------------------
Public Sub CreateFileAssociation(ByVal strFileType As String, _
                                 ByVal strTypeDescription As String, _
                                 Optional ByVal strExeName As String, _
                                 Optional ByVal strExePath As String, _
                                 Optional ByVal strIconPath As String)
    'This procedure will create a new association for a file. For anyone
    'who is unfamiliar with this, this means that if you were to double-
    'click on a file with the specified extention, the specified application
    'would start. eg, if you were to double click on a .txt file, notepad
    'would start and open the file.
    'Please note that if you wish to associate an icon, the icon has to be
    'a .ico file - no other file types are accepted. If you wish to use an
    'icon that is only in your exe (if your distributing you app for
    'example), then you need to save the icon as a file. This can be done
    'by using;
    '
    'Call SavePicture(MyControl.Picture, App.Path & "\MyIcon.ico")
    '
    'Although, please note that the picture must have originally been an
    'icon before you tried to save it as one.
    
    
    Dim lngResult As Long
    Dim strFullPath As String
    Dim strAppKey As String
    
    'exit procedure if the file type feild is blank
    If (strFileType = "") Then
        Exit Sub
    Else
        'if the first character is a dot, then remove it
        If Left(strFileType, 1) = "." Then
            strFileType = Right(strFileType, Len(strFileType) - 1)
        End If
        
        'check to see that the file type is only three characters long
        If Len(strFileType) > 3 Then
            strFileType = Left(strFileType, 3)
        End If
    
        'the type description should be no longer than 25 characters
        '(this is not necessary, but it keeps things neat in the registry)
        If Len(strTypeDescription) > 25 Then
            strTypeDescription = Left(strTypeDescription, 25)
        End If
    End If
    
    'set the default paths and exe name is they were not specified
    If strExeName = "" Then
        strExeName = App.EXEName
    End If
    
    If strExePath = "" Then
        strExePath = App.Path
    End If
    
    'make sure that the exename ends in ".exe"
    If LCase(Right(strExeName, 4)) <> ".exe" Then
        strExeName = strExeName & ".exe"
    End If
    
    'get the full path name of the exe
    If Right(strExePath, 1) = "\" Then
        'if the path already contains a trailing backslash (eg "d:\") then
        'don't add one when creating the path
        strFullPath = strExePath & strExeName
    Else
        'insert a backslash to seperate the name from the path
        strFullPath = strExePath & "\" & strExeName
    End If
    
    'check to make sure that the file exists
    If Dir(strFullPath) = "" Then
        'there is no file
        Exit Sub
    End If
    
    'if no icon was specified, then use the icon for the exe
    If (strIconPath = "") Or (Dir(strIconPath) = "") Then
        strIconPath = strFullPath
    End If
    
    'create the file type extention in the registry
    Call CreateSubKey(HKEY_CLASSES_ROOT, "." & strFileType)
    
    'create the registry entry in the above sub key that holds the
    'sub key with the file path
    'eg, "MyApp.Description", "Vb6.Module", "Word.Document"
    'Note that a blank entry lable name means a default value for that key,
    'if any spaces are in the type description, they are replaced with
    'a "." character.
    strAppKey = Replace(Left(strExeName, Len(strExeName) - 4) & "." & strTypeDescription, " ", ".")
    Call CreateRegString(HKEY_CLASSES_ROOT, _
                         "." & strFileType, _
                         "", _
                         strAppKey)
    
    'create the key that will hold the applications path and type information.
    'additional commands can be put into the "Shell\Open\Command" sub key.
    'This means that when you right click on the file type, a popup menu
    'appears with the Open option. Other options can be inserted into this
    'menu by creating sub keys in the Shell key like; "Print\Command",
    '"Edit\Command", "Assemble\Command", "Split\Command" etc. where
    'the Command sub key contains a [default] entry with a command line
    'parameter to an executable file like "C:\Windows\Notepad.exe /p %1"
    Call CreateSubKey(HKEY_CLASSES_ROOT, _
                      strAppKey & "\Shell\Open\Command")
    
    'create the text that describes the file type
    Call CreateRegString(HKEY_CLASSES_ROOT, _
                         strAppKey, _
                         "", _
                         strTypeDescription)
    
    'create the command line parameter to open the file type with the
    'application specified
    Call CreateRegString(HKEY_CLASSES_ROOT, _
                         strAppKey & "\Shell\Open\Command", _
                         "", _
                         strFullPath & " ""%1""")
    
    'create the icon sub key
    Call CreateSubKey(HKEY_CLASSES_ROOT, _
                      strAppKey & "\DefaultIcon")
    
    'create the entry that points to the icon.
    If LCase(Right(strIconPath, 3)) = "exe" Then
        'get icon from .exe
        Call CreateRegString(HKEY_CLASSES_ROOT, _
                             strAppKey & "\DefaultIcon", _
                             "", _
                             strIconPath & ",1")
    Else
        'get icon from .ico file
        Call CreateRegString(HKEY_CLASSES_ROOT, _
                             strAppKey & "\DefaultIcon", _
                             "", _
                             strIconPath & ",0")
    End If
    
End Sub

Public Sub DeleteFileAssociation(ByVal strFileType As String)
    'This procedure will remove a file association. It is recommended that
    'you only remove an association that your application created, as once
    'the association is gone, it cannot be recreated without knowing the
    'file type, application involved and the icon assiciated with the file type.
    'See CreateFileAssociation for further information.
    
    Dim strSubKeyAssociation As String
    
    'validate the parameter
    
    'make sure that the parameter contains something
    If strFileType = "" Then
        Exit Sub
    End If
    
    'make sure that the first character is a dot (.)
    If Left(strFileType, 1) <> "." Then
        'insert dot
        strFileType = "." & strFileType
    End If
    
    'now we check the registry
    
    strSubKeyAssociation = ReadRegString(HKEY_CLASSES_ROOT, _
                                         strFileType, "")
    
    'if there was an error, then exit
    If LCase(Left(strSubKeyAssociation, 5)) = "error" Then
        Exit Sub
    End If
    
    'delete the commands and information about the selected file type
    Call DeleteSubKey(HKEY_CLASSES_ROOT, strSubKeyAssociation)
End Sub

Public Sub PutAppInStartup(ByVal strEntryLabel As String, _
                           Optional ByVal strFilePath As String, _
                           Optional ByVal blnStartup As StartLoginType = RunAfterLogin, _
                           Optional ByVal blnOverwrite As Boolean = False)
    'This will take an applications full path name and put it into the registry
    'to start the program either before or after the login screen in normally
    'loaded. If no app path is specified, then by default, it puts the current
    'project in to startup after the login screen. Existing enteries are not
    'overwritten. You could call this procedure like;
    '
    'Call PutAppInStartup("MyCoolApp", MyAppsFilePath, RunAfterLogin, False)
    '
    'or
    '
    'Call PutAppInStartup("MyCoolApp")
    '
    'See also RemoveAppFromStartup.
    
    
    Dim strSubKey As String
    Dim strCheck As String
    
    'check to see if a file path was specified
    If strFilePath = "" Then
        'specifiy the path from the current project
        
        'if the applications path is a root directory, then don't add a
        'backslash to the path
        If Right(App.Path, 1) = "\" Then
            strFilePath = App.Path & App.EXEName & ".exe"
        Else
            strFilePath = App.Path & "\" & App.EXEName & ".exe"
        End If
    End If
    
    'check to see if the file exists
    If (Dir(strFilePath) = "") Or (strEntryLabel = "") Then
        'can't find file. There is no point in making an entry for a file
        'that doesn't exist, so exit
        Exit Sub
    End If
    
    'create the sub key based on the options
    If blnStartup = RunAfterLogin Then
        'set the app to start after the login screen
        strSubKey = STARTUP_AL_SUBKEY
    Else
        'set the app to run before the login screen
        strSubKey = STARTUP_BL_SUBKEY
    End If
    
    'if the entry already exists and we don't want to overwrite, then exit
    strCheck = ReadRegString(HKEY_LOCAL_MACHINE, _
                             strSubKey, _
                             strEntryLabel)
    If (Not blnOverwrite) And (Left(strCheck, 5) <> "Error") Then
        Exit Sub
    End If
    
    'write to the registry
    Call CreateRegString(HKEY_LOCAL_MACHINE, _
                         strSubKey, _
                         strEntryLabel, _
                         strFilePath)
End Sub

Public Sub RemoveAppFromStartup(ByVal strEntryLabel As String, _
                                Optional ByVal blnStartup As StartLoginType = RunAfterLogin)
    'This procedure will remove an app from the startup be specifying
    'it's label and whether or not the app startsup before or after the
    'login screen. Also see the PutInStartup procedure.
    
    Dim strSubKey As String
    Dim strCheck As String
    
    'find the sub key depending on the startup gstrMethod
    If blnStartup = RunAfterLogin Then
        'startup after the login screen [default]
        strSubKey = STARTUP_AL_SUBKEY
    Else
        'startup before the login screen
        strSubKey = STARTUP_BL_SUBKEY
    End If
    
    'check to see if the entry exists
    strCheck = ReadRegString(HKEY_LOCAL_MACHINE, _
                             strSubKey, _
                             strEntryLabel)
    If Left(strCheck, 5) = "Error" Then
        'there was a problem accessing the key, so exit (eg, it might not exist)
        Exit Sub
    End If
    
    'delete the entry
    Call DeleteValue(HKEY_LOCAL_MACHINE, _
                     strSubKey, _
                     strEntryLabel)
End Sub

Public Sub CreateSubKey(ByVal enmHive As RegistryHives, _
                        ByVal strSubKey As String)
    'This procedure will create a sub key in the
    'specified header key.
    
    Dim lngResult As Long
    Dim hKey As Long
    
    'create the key
    lngResult = RegCreateKey(enmHive, _
                             strSubKey & Chr(0), _
                             hKey)
    
    'close the key
    lngResult = RegCloseKey(hKey)
End Sub

Public Sub DeleteSubKey(ByVal enmHive As RegistryHives, _
                        ByVal strSubKey As String)
    'This procedure will delete a key from the registry. Please note that
    'the procedure will not delete key values.
    
    Dim lngResult As Long
    Dim hKey As Long
    
    'open the key
    lngResult = RegOpenKeyEx(enmHive, _
                             strSubKey & Chr(0), _
                             0&, _
                             KEY_ALL_ACCESS, _
                             hKey)
    
    'delete the key
    lngResult = RegDeleteKey(enmHive, hKey)
    
    'close the key
    lngResult = RegCloseKey(hKey)
End Sub

Public Sub DeleteValue(ByVal enmHive As RegistryHives, _
                       ByVal strSubKey As String, _
                       Optional ByVal strEntryLabel As String)
    'This will remove any registry key or entry value
    
    Dim lngResult As Long
    Dim hKey As Long
    Dim strTotalSubKey As String
    
    'create the full registry subkey and entry label
    strTotalSubKey = strSubKey & Chr(0)
    
    'open the subkey/entry
    lngResult = RegOpenKeyEx(enmHive, _
                             strTotalSubKey, _
                             0&, _
                             KEY_ALL_ACCESS, _
                             hKey)
    
    'delete the key/entry from the registry
    lngResult = RegDeleteValue(hKey, strEntryLabel)
    
    'close the handle
    lngResult = RegCloseKey(hKey)
End Sub

Public Sub CreateRegString(ByVal enmHive As RegistryHives, _
                           ByVal strSubKey As String, _
                           ByVal strEntryLabel As String, _
                           ByVal strText As String)
    'This will put some text into the specified key and entry label. This
    'data can be retrieved with the ReadRegString function
    
    Dim lngResult As Long
    Dim hKey As Long
    Dim strTotalSubKey As String
    
    'create a complete sub key and entry path to send to the api call
    strTotalSubKey = strSubKey & Chr(0)
    
    'now create the sub key entry if it does not exist
    lngResult = RegCreateKey(enmHive, strTotalSubKey, hKey)
    
    'if no handle was returned, then exit
    If hKey = 0 Then
        Exit Sub
    End If
    
    'write the text into the key with the specified entry name
    lngResult = RegSetValueEx(hKey, _
                              strEntryLabel, _
                              0&, _
                              REG_SZ, _
                              ByVal strText, _
                              Len(strText))
    
    'close the opened key and exit
    lngResult = RegCloseKey(hKey)
End Sub

Public Function GetWinDirectories(ByVal enmDirectory As ShellFoldersType) _
                                  As String
    'This function will return the specfied system directory like the desktop
    'directory, windows directory, temp folder, system directory etc.
    
    'registry entry names
    Const ApplicationData = "AppData"
    Const TempInetFiles = "Cache" 'temperory internet files