mconfigdatasource.bas

公司订单管理系统,这对于方便公司管理床单

Attribute VB_Name = "mConfigDataSource"
Option Explicit

Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private 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
Private 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
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const HKEY_CURRENT_CONFIG = &H80000005
Private Const HKEY_DYN_DATA = &H80000006
Private Const REG_NONE = 0
Private Const REG_SZ = 1
Private Const REG_EXPAND_SZ = 2
Private Const REG_BINARY = 3
Private Const REG_DWORD = 4
Private Const REG_DWORD_BIG_ENDIAN = 5
Private Const REG_MULTI_SZ = 7

Private Const KEYVALUE As String = "SOFTWARE\yfMaterielManagement"

'配置數據源
Public Function ConfigDataSource(ByVal strDatabasePath As String, _
                                 ByVal strDatabaseName As String) As Boolean
Dim lpSuccess As Long
Dim hKey As Long
    lpSuccess = RegCreateKey(HKEY_LOCAL_MACHINE, KEYVALUE, hKey)
    If lpSuccess = 0 Then
       lpSuccess = RegSetValue(hKey, "DatabasePath", _
                   REG_SZ, strDatabasePath, Len(strDatabasePath))
       lpSuccess = RegSetValue(hKey, "DatabaseName", _
                   REG_SZ, strDatabaseName, Len(strDatabaseName))
       ConfigDataSource = True
    Else
       ConfigDataSource = False
    End If
    RegCloseKey hKey
End Function

'獲取數據源信息
Public Function GetDataSourceInfo(ByRef strDatabasePath As String, _
                                  ByRef strDatabaseName As String) As Boolean
Dim lPos As Long
Dim lpSuccess As Long
Dim hKey As Long
    lpSuccess = RegOpenKey(HKEY_LOCAL_MACHINE, KEYVALUE, hKey)
    If lpSuccess = 0 Then
       strDatabasePath = String$(255, vbNullChar)
       lpSuccess = RegQueryValue(hKey, "DatabasePath", strDatabasePath, 255)
       lPos = InStr(1, strDatabasePath, vbNullChar)
       strDatabasePath = Trim$(Left$(strDatabasePath, lPos - 1))
       
       strDatabaseName = String$(255, vbNullChar)
       lpSuccess = RegQueryValue(hKey, "DatabaseName", strDatabaseName, 255)
       lPos = InStr(1, strDatabaseName, vbNullChar)
       strDatabaseName = Trim$(Left$(strDatabaseName, lPos - 1))
       
       GetDataSourceInfo = True
    Else
       GetDataSourceInfo = False
    End If
    RegCloseKey hKey
End Function