説明:レジストリを利用してアプリケーションの中で必要なDBドライバー、DSN名、データベース名などのDBへのアクセス情報を 提供したり、ファイルパスやキーワードなど様々なアプリケーションの実行環境の変更によって変わり得る情報を 提供することで、アプリケーションの修正なしに様々な環境に適応可能となります。
STEP1:レジストリの決めたルートの配下に必要なキーを作成し、設計した文字列に値を設定する [方法] Windowの[スタート]の[ファイル名を指定して実行]を開いて regedit を実行する
STEP2: レジストリエディタで上記図のようにHKEY_LOCAL_MACHINE→Mytest→SQLServer→{DSN、Server、Database、 UserID、PWD、Provider}作成する
STEP3: 下記のようにCOMのソースを用意する(VBの場合)
STEP4: アプリケーションからSTEP3で提供しているメソッド(Function)を呼んでレジストリから必要な情報を取得する
下記のソースは実戦でテストを受けたものです。
Option Explicit Const TestConnection As String = "driver={SQL Server};SERVER=JPSQLDBDEV7;Database=[データベース名];UID=[ユーザー名];PWD=[パスワード];" Const sRootKey = HKEY_LOCAL_MACHINE 'ここはルートのキーワード(名)です Const sSQLServerKey = "Software\OnlineStore\SQLServer" 'ここは情報が格納されているレジストリの中のPathです Const sFilePathKey = "Software\OnlineStore\FilePath" 'ここは情報が格納されているレジストリの中のPathです
Public Function GetSQLServerConnectionString() As String
Dim sProvider As String Dim sDSN As String Dim sServerName As String Dim sDBName As String Dim sUserID As String Dim sPassword As String sProvider = QueryKeyValue(sRootKey, sSQLServerKey, "Provider") 'レジストリからProvaiderを取得。例えば、SQLOLEDB.1 sDSN = QueryKeyValue(sRootKey, sSQLServerKey, "DSN") sServerName = QueryKeyValue(sRootKey, sSQLServerKey, "Server") sDBName = QueryKeyValue(sRootKey, sSQLServerKey, "Database") sUserID = QueryKeyValue(sRootKey, sSQLServerKey, "UserID") sPassword = QueryKeyValue(sRootKey, sSQLServerKey, "PWD") GetSQLServerConnectionString = "PROVIDER=" & sProvider & ";DSN=" & sDSN & ";SERVER=" & sServerName & ";Database=" & sDBName & ";UID=" & sUserID & ";PWD=" & sPassword & ";"
End Function
Public Function GetFilePathString() As String
Dim sFilePath As String sConfigFilePath = QueryKeyValue(sRootKey, sFileKey, "Filepath") GetFilePathString = sFilePathKey
'This module contains all common API calls and functions 'shared among all COM objects such as registry access, etc.
Option Explicit
'/* Win32 constant and functions related to manager NT Task bar Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias _ "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long Public Type NOTIFYICONDATA cbSize As Long hwnd As Long uID As Long uFlags As Long uCallbackMessage As Long hIcon As Long szTip As String * 64 End Type
'/* Win32 constant and functions related to registry Public Const HKEY_LOCAL_MACHINE = &H80000002 Public Const HKEY_CLASSES_ROOT = &H80000000 Public Const HKEY_CURRENT_CONFIG = &H80000005 Public Const HKEY_CURRENT_USER = &H80000001 Public Const HKEY_DYN_DATA = &H80000006
Public Const REG_SZ = 1 ' Unicode null terminated string Public Const REG_MULTI_SZ = 7 ' Multiple Unicode strings Public Const REG_DWORD As Long = 4
Public Const READ_CONTROL = &H20000 Public Const STANDARD_RIGHTS_READ = (READ_CONTROL) Public Const SYNCHRONIZE = &H100000
Public Const KEY_CREATE_LINK = &H20 Public Const KEY_CREATE_SUB_KEY = &H4 Public Const KEY_ENUMERATE_SUB_KEYS = &H8 Public Const KEY_EVENT = &H1 ' Event contains key event record
Public Const KEY_NOTIFY = &H10 Public Const KEY_SET_VALUE = &H2 Public Const KEY_QUERY_VALUE = &H1 Public Const KEY_ALL_ACCESS = &H3F
Public Const NIM_ADD = &H0 Public Const NIM_MODIFY = &H1 Public Const NIM_DELETE = &H2 Public Const NIF_MESSAGE = &H1 Public Const NIF_ICON = &H2 Public Const NIF_TIP = &H4 'Make your own constant, e.g.: Public Const NIF_DOALL = NIF_MESSAGE Or NIF_ICON Or NIF_TIP Public Const WM_MOUSEMOVE = &H200 Public Const WM_LBUTTONDBLCLK = &H203 Public Const WM_LBUTTONDOWN = &H201 Public Const WM_RBUTTONDOWN = &H204
'EA PROCESSOR status constant Public Const EAFP_ST_IDLE = 1 'no polling, no working Public Const EAFP_ST_PULLING = 2 'in polling mode Public Const EAFP_ST_WORKING = 3 'in working mode
'EA file status constant Public Const EAFP_FST_READY = 1 Public Const EAFP_FST_INPROC = 2 Public Const EAFP_FST_PROCESSED = 3 Public Const EAFP_FST_REJECTED = 4
'EA Processor error notification method Public Const EAFP_NM_EMAIL = 1 Public Const EAFP_NM_TODB = 2 Public Const EAFP_NM_TOFILE = 3 Public Const EAFP_NM_WINMSG = 4
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
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, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long 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.
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long Dim lValue As Long Dim sValue As String Select Case lType Case REG_SZ sValue = vValue & Chr$(0) SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue)) Case REG_DWORD lValue = vValue SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4) End Select
Public Function QueryKeyValue(RootKey As Long, sKeyName As String, sValueName As String) As Variant Dim lRetVal As Long 'result of the API functions Dim hKey As Long 'handle of opened key
lRetVal = RegOpenKeyEx(RootKey, sKeyName, 0, KEY_ALL_ACCESS, hKey) lRetVal = QueryValueEx(hKey, sValueName, QueryKeyValue) RegCloseKey (hKey) End Function
Public Sub SetKeyValue(RookKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long) Dim lRetVal As Long 'result of the SetValueEx function Dim hKey As Long 'handle of open key
'open the specified key lRetVal = RegOpenKeyEx(RookKey, sKeyName, 0, KEY_ALL_ACCESS, hKey) lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting) RegCloseKey (hKey)
End Sub
Public Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long Dim cch As Long Dim lrc As Long Dim lType As Long Dim lValue As Long Dim sValue As String
On Error GoTo QueryValueExError
' Determine the size and type of data to be read lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch) If lrc <> ERROR_NONE Then Error 5
Select Case lType ' For strings Case REG_SZ: sValue = String(cch, 0) lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch) If lrc = ERROR_NONE Then vValue = Left$(sValue, cch - 1) Else vValue = Empty End If ' For DWORDS Case REG_DWORD: lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch) If lrc = ERROR_NONE Then vValue = lValue Case Else 'all other data types not supported lrc = -1 End Select
QueryValueExExit: QueryValueEx = lrc Exit Function QueryValueExError: Resume QueryValueExExit End Function