comprehensive registry access code.txt

VB的木马和病毒指南

    Const Cookies = "Cookies"
    Const Desktop = "Desktop"
    Const Favourites = "Favourites"
    Const Fonts = "Fonts"
    Const History = "History"
    Const LocalAppData = "Local AppData"
    Const NetHood = "NetHood"
    Const MyDocuments = "Personal"
    Const PrintHood = "PrintHood"
    Const StartPrograms = "Programs"
    Const Recent = "Recent"
    Const SendTo = "SendTo"
    Const StartMenu = "Start Menu"
    Const StartUp = "Startup"
    Const Templates = "Templates"
    
    
    Dim strResult As String
    Dim errResult As Long
    
    Select Case enmDirectory
        'registry entry names
        Case ApplicationDataDir
            strResult = ReadRegString(HKEY_USERS, SHELL_FOLDERS_SUBKEY, ApplicationData)
        
        Case TempInetFilesDir  'temperory internet files
            strResult = ReadRegString(HKEY_USERS, SHELL_FOLDERS_SUBKEY, TempInetFiles)
        
        Case CookiesDir
            strResult = ReadRegString(HKEY_USERS, SHELL_FOLDERS_SUBKEY, Cookies)
        
        Case DesktopDir
            strResult = ReadRegString(HKEY_USERS, SHELL_FOLDERS_SUBKEY, Desktop)
        
        Case FavouritesDir
            strResult = ReadRegString(HKEY_USERS, SHELL_FOLDERS_SUBKEY, Favourites)
        
        Case FontsDir
            strResult = ReadRegString(HKEY_USERS, SHELL_FOLDERS_SUBKEY, Fonts)
        
        Case HistoryDir
            strResult = ReadRegString(HKEY_USERS, SHELL_FOLDERS_SUBKEY, History)
        
        Case LocalAppDataDir
            strResult = ReadRegString(HKEY_USERS, SHELL_FOLDERS_SUBKEY, LocalAppData)
        
        Case NetHoodDir
            strResult = ReadRegString(HKEY_USERS, SHELL_FOLDERS_SUBKEY, NetHood)
        
        Case MyDocumentsDir
            strResult = ReadRegString(HKEY_USERS, SHELL_FOLDERS_SUBKEY, MyDocuments)
        
        Case PrintHoodDir
            strResult = ReadRegString(HKEY_USERS, SHELL_FOLDERS_SUBKEY, PrintHood)
        
        Case StartProgramsDir
            strResult = ReadRegString(HKEY_USERS, SHELL_FOLDERS_SUBKEY, StartPrograms)
        
        Case RecentDir
            strResult = ReadRegString(HKEY_USERS, SHELL_FOLDERS_SUBKEY, Recent)
        
        Case SendToDir
            strResult = ReadRegString(HKEY_USERS, SHELL_FOLDERS_SUBKEY, SendTo)
        
        Case StartMenuDir
            strResult = ReadRegString(HKEY_USERS, SHELL_FOLDERS_SUBKEY, StartMenu)
        
        Case StartupDir
            strResult = ReadRegString(HKEY_USERS, SHELL_FOLDERS_SUBKEY, StartUp)
        
        Case TemplatesDir
            strResult = ReadRegString(HKEY_USERS, SHELL_FOLDERS_SUBKEY, Templates)
        
        
        'these next items are not stored in the registry
        Case SystemDir
            strResult = Space(255)
            errResult = GetSystemDirectory(strResult, 255)
            
            'remove the null character
            strResult = Left(strResult, InStr(1, strResult, Chr(0)) - 1)
            
        Case WindowsDir
            strResult = Space(255)
            errResult = GetWindowsDirectory(strResult, 255)
            
            'remove the null character
            strResult = Left(strResult, InStr(1, strResult, Chr(0)) - 1)
            
        Case TempDir 'temperory folder is always in the Windows directory
            strResult = Space(255)
            errResult = GetTempDirectory(255, strResult)
            
            'remove the null character and add the name of the temperory folder
            strResult = Left(strResult, InStr(1, strResult, Chr(0)) - 1)
            
    End Select
    
    'return strResult
    GetWinDirectories = strResult
End Function

Public Function GetRegisteredOwner() As String
    'This function will returned the registered
    'strOwner for the local machine.
    
    Const OwnerKeyLoc = "RegisteredOwner"
    
    Dim strOwner As String
    
    'get the registered gstrOwner
    If IsWinNT Then
        strOwner = ReadRegString(HKEY_LOCAL_MACHINE, _
                                 WIN_NT_INFO_SUBKEY, _
                                 OwnerKeyLoc)
    Else
        strOwner = ReadRegString(HKEY_LOCAL_MACHINE, _
                                 WIN_INFO_SUBKEY, _
                                 OwnerKeyLoc)
    End If
    
    'return lngResult
    GetRegisteredOwner = strOwner
End Function

Public Function ReadRegString(ByVal enmHive As RegistryHives, _
                              ByVal strSubKey As String, _
                              Optional ByVal strEntry As String) _
                              As String
    'This function will check a registery string entry and
    'return the result.
    
    Dim strText As String
    Dim lngResult As Long
    Dim hOpenKey As Long
    Dim lngBufferSize As Long
    
    'open the registry key
    hOpenKey = GetSubKeyHandle(enmHive, strSubKey)
    
    'check for error
    If hOpenKey = 0 Then
        'return error message
        ReadRegString = "Error : Cannot Open Key"
        Exit Function
    End If
    
    'setup the string to hold the return value
    strText = Space(255)
    lngBufferSize = Len(strText)
    
    'query the information in the key
    lngResult = RegQueryValueEx(hOpenKey, _
                                strEntry, _
                                0, _
                                REG_SZ, _
                                ByVal strText, _
                                lngBufferSize)
    
    'close access to the key
    lngResult = RegCloseKey(hOpenKey)
    
    'check for no values returned
    If Left(strText, 1) = " " Then
        'return error message
        ReadRegString = "Error : Cannot Retrieve String"
        Exit Function
    Else
        'remove the null character
        strText = Left(strText, InStr(1, strText, Chr(0)) - 1)
    End If
    
    'function successful, return owners name
    ReadRegString = strText
End Function

Public Function ReadRegLong(ByVal enmHive As RegistryHives, _
                            ByVal strSubKey As String, _
                            ByVal strEntry As String) _
                            As Long
    'This function will check a registery string
    'entry and return the lngResult.
    
    Dim lngValue As Long
    Dim lngResult As Long
    Dim hOpenKey As Long
    Dim lngBufferSize As Long
    
    'open the registry key
    hOpenKey = GetSubKeyHandle(enmHive, strSubKey)
    
    'check for error
    If hOpenKey = 0 Then
        'return error message
        ReadRegLong = "Error : Cannot Open Key"
        Exit Function
    End If
    
    lngBufferSize = 4
    
    'query the information in the key
    lngResult = RegQueryValueEx(hOpenKey, _
                                strEntry, _
                                ByVal 0&, _
                                REG_BINARY, _
                                lngValue, _
                                lngBufferSize)
    
    'close access to the key
    lngResult = RegCloseKey(hOpenKey)
    
    'function successful, return owners name
    ReadRegLong = lngValue
End Function

Private Function GetSubKeyHandle(ByVal enmHive As RegistryHives, _
                                 ByVal strSubKey As String, _
                                 Optional ByVal enmAccess As RegistryKeyAccess = KEY_READ) _
                                 As Long
    'This function returns a handle to the specified registry key
    
    Dim lngResult As Long
    Dim hKey As Long
    
    'open the registry key
    lngResult = RegOpenKeyEx(enmHive, strSubKey, 0, enmAccess, hKey)
    
    If lngResult <> ERROR_SUCCESS Then
        'could not create key
        hKey = 0
    End If
        
    'return value
    GetSubKeyHandle = hKey
End Function

Public Function GetSpace(enmSpaceType As MemType, _
                         Optional ByVal strDrive As String = "C:\") _
                         As Long
    'This function returns the amount of specified memory, either in total
    'or available depending on what was passed.
    'Keep in mind that the information returned is volitile - if you call
    'the function twice, there is no guarentee that the values returned
    'will be the same.
    'Note also, that physical memory is ram memory and memory usage is
    'the amount of ram used.
    
    Const CpuSubKey = "PerfStats\StatData"
    Const CpuName = "KERNEL\CPUUsage"
    
    Dim enmMemStruc As MEMORYSTATUS
    Dim lngResult As Long
    Dim SecPerCluster As Long
    Dim lngBytPerSector As Long
    Dim lngFreeClusters As Long
    Dim lngTotalClusters As Long
    
    'Before calling GlobalMemoryStatus, we have to tell it the length
    'of the structure we are passing it - this is required by the procedure.
    enmMemStruc.dwLength = Len(enmMemStruc)
    Call GlobalMemoryStatus(enmMemStruc)
    
    'get the disk space. The function must be passed the root directory of
    'a drive like "C:\" or "D:\" and must end with a Null character (chr(0) )
    If Len(strDrive) >= 3 Then
        lngResult = GetDiskFreeSpace((Left(strDrive, 3) & Chr(0)), _
                                     SecPerCluster, _
                                     lngBytPerSector, _
                                     lngFreeClusters, _
                                     lngTotalClusters)
    End If
    
    'save the selected lngResult
    Select Case enmSpaceType
    
    Case CPUUsage 'cpu usage
        lngResult = ReadRegLong(HKEY_DYN_DATA, CpuSubKey, CpuName)
    
    Case MemoryUsage 'ram usage
        lngResult = enmMemStruc.dwMemoryLoad
    
    Case TotalPhysical 'total ram
        lngResult = enmMemStruc.dwTotalPhys
    
    Case AvailablePhysical 'available ram
        lngResult = enmMemStruc.dwAvailPhys
    
    Case TotalPageFile 'total page file
        lngResult = enmMemStruc.dwTotalPageFile
    
    Case AvailablePageFile 'available page file
        lngResult = enmMemStruc.dwAvailPageFile
    
    Case TotalVirtual 'total virtual (swap file)
        lngResult = enmMemStruc.dwTotalVirtual
    
    Case AvailableVirtual 'available virtual
        lngResult = enmMemStruc.dwAvailVirtual
    
    Case TotalDisk 'hard drive space
        lngResult = lngTotalClusters * (lngBytPerSector * SecPerCluster)
    
    Case AvailableDisk 'available hard drive space
        lngResult = lngFreeClusters * (lngBytPerSector * SecPerCluster)
    
    Case Else
        'return -1 as an error code
        lngResult = -1
    End Select
    
    GetSpace = lngResult
End Function

Public Function GetCountry() As String
    'This will return the country from
    'the computers' regional settings
    
    Const CountryKey = "sCountry"       'the registry entry that holds the country name
    Const DEFAULT_COUNTRY = "Ireland"   'the default country to return if unable to retrieve from the registry
    
    Dim strCountry As String    'holds the value of the registry entry
    
    strCountry = ReadRegString(HKEY_USERS, _
                               COUNTRY_SUBKEY, _
                               CountryKey)
    
    'if it could not get the country, then default to
    'the programmers country
    If UCase(Left(strCountry, 5)) = "ERROR" Then
        strCountry = DEFAULT_COUNTRY
    End If
    
    'return the country
    GetCountry = strCountry
End Function

Public Function ShellFile(ByVal strFilePath As String, _
                          Optional enmFocus As VbAppWinStyle = vbNormalFocus)
    'This will open any file with the appropiate program
    'as long as it is registered in the registry and
    'if the function is successful, it will return the
    'applications ID.
    
    Dim strExtention As String      'holds the file extention
    Dim lngDotPos As Long           'the position of the last . character found in the string
    Dim lngAppId As Long            'the process id for the started application
    Dim strWindowsDir As String     'the location of the windows directory
    Dim strSubKeyLoc As String      'the location of the registry sub key to open the file type
    Dim strOpenWith As String       'the program to open the file with
    Dim strMulti() As String        'the individual files if more than one is passed (multiple parameters)
    Dim intCounter As Integer       'used to cycle through the file list
    
    'get the windows directory
    strWindowsDir = GetWinDirectories(WindowsDir)
    
    'strip qutoation marks from the file path
    strFilePath = Replace(strFilePath, """", "")
    
    'see if the file is a directory, if so open in
    'explorer
    If HasFileAttrib(strFilePath, vbDirectory) Then
        'open the directory
        lngAppId = Shell(AddFile(strWindowsDir, _
                                 "Explorer.exe /n,/e," _
                                 & strFilePath), _
                         enmFocus)
        
        ShellFile = lngAppId
        Exit Function
    End If
    
    'get the file extention if any exists (after the last
    'position of the backslash)
    lngDotPos = InStrRev(strFilePath, ".")
    If (lngDotPos > 0) Then
        If (InStr(lngDotPos, strFilePath, "\") = 0) Then
            'file extention exists
            strExtention = Right(strFilePath, _
                                 Len(strFilePath) - _
                                 lngDotPos + 1)
        End If
    End If
    
    'if the extention marks any executable file, then
    'simple run it
    Select Case LCase(strExtention)
    Case ".exe", ".com", ".bat", ""
    
        'make sure the file exists
        If (Dir(strFilePath) <> "") And (Trim(strFilePath) <> "") Then
            lngAppId = Shell(strFilePath, enmFocus)
            
            'return a pointer to the application instance