module1.bas

Windows安全黑客全部是注册表的修改

Attribute VB_Name = "Module1"
' These are  the declarations for
' registry access. Don't put this
' in you project, because I removed
' functions I didn't need. I also
' included the function to get the
' username.

Option Explicit
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const REG_SZ = 1                         ' Unicode nul terminated string
Public Const REG_DWORD = 4                      ' 32-bit number
Public Const ERROR_SUCCESS = 0&
Public Declare Function GetUserNameAPI Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long 'Get the username
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
'--------------------------------------------------
'--------------------------------------------------
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

Public Sub CreateKey(hKey As Long, strPath As String)

  Dim hCurKey As Long
  Dim lRegResult As Long

    lRegResult = RegCreateKey(hKey, strPath, hCurKey)

    If lRegResult <> ERROR_SUCCESS Then
        ' there is a problem
    End If

    lRegResult = RegCloseKey(hCurKey)

End Sub

Public Function GetSettingString(hKey As Long, strPath As String, strValue As String, Optional Default As String) As String

  Dim hCurKey As Long
  Dim lValueType As Long
  Dim strBuffer As String
  Dim lDataBufferSize As Long
  Dim intZeroPos As Integer
  Dim lRegResult As Long

    ' Set up default value
    If Not IsEmpty(Default) Then
        GetSettingString = Default
      Else
        GetSettingString = ""
    End If

    ' Open the key and get length of string
    lRegResult = RegOpenKey(hKey, strPath, hCurKey)
    lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, ByVal 0&, lDataBufferSize)

    If lRegResult = ERROR_SUCCESS Then

        If lValueType = REG_SZ Then
            ' initialise string buffer and retrieve string
            strBuffer = String$(lDataBufferSize, " ")
            lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&, ByVal strBuffer, lDataBufferSize)

            ' format string
            intZeroPos = InStr(strBuffer, Chr$(0))
            If intZeroPos > 0 Then
                GetSettingString = Left$(strBuffer, intZeroPos - 1)
              Else
                GetSettingString = strBuffer
            End If

        End If

      Else
        ' there is a problem
    End If

    lRegResult = RegCloseKey(hCurKey)

End Function

Public Sub SaveSettingString(hKey As Long, strPath As String, strValue As String, strData As String)

  Dim hCurKey As Long
  Dim lRegResult As Long

    lRegResult = RegCreateKey(hKey, strPath, hCurKey)

    lRegResult = RegSetValueEx(hCurKey, strValue, 0, REG_SZ, ByVal strData, Len(strData))

    If lRegResult <> ERROR_SUCCESS Then
        'there is a problem
    End If

    lRegResult = RegCloseKey(hCurKey)

End Sub

Public Function GetSettingLong(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String, Optional Default As Long) As Long

  Dim lRegResult As Long
  Dim lValueType As Long
  Dim lBuffer As Long
  Dim lDataBufferSize As Long
  Dim hCurKey As Long

    ' Set up default value
    If Not IsEmpty(Default) Then
        GetSettingLong = Default
      Else
        GetSettingLong = 0
    End If

    lRegResult = RegOpenKey(hKey, strPath, hCurKey)
    lDataBufferSize = 4       ' 4 bytes = 32 bits = long

    lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, lBuffer, lDataBufferSize)

    If lRegResult = ERROR_SUCCESS Then

        If lValueType = REG_DWORD Then
            GetSettingLong = lBuffer
        End If

      Else
        'there is a problem
    End If

    lRegResult = RegCloseKey(hCurKey)

End Function

Public Sub SaveSettingLong(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String, ByVal lData As Long)

  Dim hCurKey As Long
  Dim lRegResult As Long

    lRegResult = RegCreateKey(hKey, strPath, hCurKey)

    lRegResult = RegSetValueEx(hCurKey, strValue, 0&, REG_DWORD, lData, 4)

    If lRegResult <> ERROR_SUCCESS Then
        'there is a problem
    End If

    lRegResult = RegCloseKey(hCurKey)

End Sub