mdlregister.bas

来自「雨点进销存软件,绝对可以用,大家可以拿来使用」· BAS 代码 · 共 66 行

Attribute VB_Name = "MdlRegister"
'####################################################################
'API函数
'系统注册表
'获取机器名
'####################################################################
'API函数声明
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Public Declare Function RegConnectRegistry Lib "advapi32.dll" Alias "RegConnectRegistryA" (ByVal lpMachineName As String, ByVal hKey As Long, phkResult 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 RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long

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 RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

Public Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue 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, lp_Type As Long, lpData As Any, lpcbData As Long) As Long         ' Note that if you declare the lpData parameter as String, you must pass it By Value.

Public Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData 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         ' Note that if you declare the lpData parameter as String, you must pass it By Value.

Public Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
'API函数声明
'####################################################################
'--------------------------------------------------------------------
' 得到计算机名
Public Function GetComPuter() As String
On Error GoTo Err
Dim lngResult As Long
Dim lpBuffer$
Dim StrGetWin As String
lpBuffer = Space$(2048)
lngResult = GetComputerName(lpBuffer, Len(lpBuffer))
StrGetWin = Left(Trim(lpBuffer), Len(Trim(lpBuffer)) - lngResult)
GetComPuter = StrGetWin
Exit Function
Err:
'    MsgErr "系统初始化", "1005", "获取机器名出错", True, LXGLY, Err.Description
End Function

Public Function GetSysPath() As String
On Error GoTo ErrHandle
Dim lngResult As Long
Dim lpBuffer$
Dim StrGetWin As String
lpBuffer = Space$(2048)
lngResult = GetWindowsDirectory(lpBuffer, Len(lpBuffer))
StrGetWin = Left(Trim(lpBuffer), Len(Trim(lpBuffer)) - 1)
GetSysPath = StrGetWin
Exit Function
ErrHandle:
'   MsgBox "系统错误" + Chr(10) + "错误描述：" + Err.Description
End Function