VB修改系統資料庫

 把下面的内容存成.bas（子產品）檔案，以後隻要把這個檔案加入你的工程就可以

直接用這些函數了

' -----------------

' ADVAPI32

' -----------------

' function prototypes, constants, and type definitions

' for Windows 32-bit Registry API

Public Const HKEY_CLASSES_ROOT = &H80000000

Public Const HKEY_CURRENT_USER = &H80000001

Public Const HKEY_LOCAL_MACHINE = &H80000002

Public Const HKEY_USERS = &H80000003

Public Const HKEY_PERFORMANCE_DATA = &H80000004

Public Const ERROR_SUCCESS = 0&

' Registry API prototypes

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) A

s Long

Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA"

 (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As 

Long

Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA"

 (ByVal Hkey As Long, ByVal lpSubKey As String) As Long

Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteVal

ueA" (ByVal Hkey As Long, ByVal lpValueName As String) As Long

Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (By

Val Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryVal

ueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal lpReser

ved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueEx

A" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal Reserved As

 Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As L

ong

Public Const REG_SZ = 1                         ' Unicode nul terminat

ed string

Public Const REG_DWORD = 4                      ' 32-bit number

Public Sub SaveKey(Hkey As Long, strPath As String)

Dim keyhand&

r = RegCreateKey(Hkey, strPath, keyhand&)

r = RegCloseKey(keyhand&)

End Sub

Public Function GetString(Hkey As Long, strPath As String, strValue As

 String) As String

Dim keyhand As Long

Dim datatype As Long

Dim lResult As Long

Dim strBuf As String

Dim lDataBufSize As Long

Dim intZeroPos As Integer

r = RegOpenKey(Hkey, strPath, keyhand)

lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&,

 lDataBufSize)

If lValueType = REG_SZ Then

    strBuf = String(lDataBufSize, " ")

    lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf,

 lDataBufSize)

    If lResult = ERROR_SUCCESS Then

        intZeroPos = InStr(strBuf, Chr$(0))

        If intZeroPos > 0 Then

            GetString = Left$(strBuf, intZeroPos - 1)

        Else

            GetString = strBuf

        End If

    End If

End If

End Function

Public Sub SaveString(Hkey As Long, strPath As String, strValue As Str

ing, strdata As String)

Dim keyhand As Long

Dim r As Long

r = RegCreateKey(Hkey, strPath, keyhand)

r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(str

data))

r = RegCloseKey(keyhand)

End Sub

Function GetDword(ByVal Hkey As Long, ByVal strPath As String, ByVal s

trValueName As String) As Long

Dim lResult As Long

Dim lValueType As Long

Dim lBuf As Long

Dim lDataBufSize As Long

Dim r As Long

Dim keyhand As Long

r = RegOpenKey(Hkey, strPath, keyhand)

 ' Get length/data type

lDataBufSize = 4

lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf,

 lDataBufSize)

If lResult = ERROR_SUCCESS Then

    If lValueType = REG_DWORD Then

        GetDword = lBuf

    End If

'Else

'    Call errlog("GetDWORD-" & strPath, False)

End If

r = RegCloseKey(keyhand)

End Function

Function SaveDword(ByVal Hkey As Long, ByVal strPath As String, ByVal 

strValueName As String, ByVal lData As Long)

    Dim lResult As Long

    Dim keyhand As Long

    Dim r As Long

    r = RegCreateKey(Hkey, strPath, keyhand)

    lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lDat

a, 4)

    'If lResult <> error_success Then Call errlog("SetDWORD", False)

    r = RegCloseKey(keyhand)

End Function

Public Function DeleteKey(ByVal Hkey As Long, ByVal strKey As String)

Dim r As Long

r = RegDeleteKey(Hkey, strKey)

End Function

Public Function DeleteValue(ByVal Hkey As Long, ByVal strPath As Strin

g, ByVal strValue As String)

Dim keyhand As Long

r = RegOpenKey(Hkey, strPath, keyhand)

r = RegDeleteValue(keyhand, strValue)

r = RegCloseKey(keyhand)

End Function

--

Dim fishy As Friend