读取配置文件连接数据库的通用模块

Option Explicit

' Application used
Global Const APPL_EXE = "QA.EXE"
Global Const INIT_FILE = "Clv.INI"
Global Const APPL_SECTION = "COMMON"
Global Const DEFA_DRIVE = "Z:"

'Global Const DEFA_PATH = "\\NodeName\ServiceName"
Global Const DEFA_SFMDBTYPE = "ODBC;Uid=CLVOWNER;pwd=CLVOWNER;"
Global Const DEFA_SFMDB = "CLV"
Global Const DEFA_MISDBTYPE = "ODBC;Uid=APPS;pwd=APPS;"
Global Const DEFA_MISDB = "TEST7"
Global Const DEFA_ORGID = ""
Global Const DEFA_InputTester = ""
Global Const DEFA_R1Line = ""

' Windows Constant
Global Const WN_SUCCESS = &H0
Global Const WN_Not_Supported = &H1
Global Const WN_NET_ERROR = &H2
Global Const WN_MORE_DATA = &H3
Global Const WN_BAD_POINTER = &H4
Global Const WN_BAD_VALUE = &H5
Global Const WN_BAD_PASSWORD = &H6
Global Const WN_ACCESS_DENIED = &H7
Global Const WN_FUNCTION_BUSY = &H8
Global Const WN_WINDOWS_ERROR = &H9
Global Const WN_BAD_USER = &HA
Global Const WN_OUT_OF_MEMORY = &HB
Global Const WN_CANCEL = &HC
Global Const WN_CONTINUE = &HD
Global Const WN_NOT_CONNECTED = &H30
Global Const WN_OPEN_FILES = &H31
Global Const WN_BAD_NETNAME = &H32
Global Const WN_BAD_LOCALNAME = &H33
Global Const WN_ALREADY_CONNECTED = &H34
Global Const WN_DEVICE_ERROR = &H35
Global Const WN_CONNECTION_CLOSED = &H36

Function tryOpenDB() As Integer

    Dim msRetstring As String * 144
    Dim mGetLength%
    Dim mDBType$, mUseDBName$, mMsg$
    Dim mOrgID#
    On Error GoTo OpenFail

'SFM DataBase
    mGetLength% = GetPrivateProfileString(APPL_SECTION, "DataBase", DEFA_SFMDB, msRetstring, Len(msRetstring), gInitFile$)
    If mGetLength% = 0 Then
       gSFMDB$ = DEFA_SFMDB
    Else
       gSFMDB$ = Left(msRetstring, mGetLength%)
    End If

'SFM Database Type
    mGetLength% = GetPrivateProfileString(APPL_SECTION, "DBType", DEFA_SFMDBTYPE, msRetstring, Len(msRetstring), gInitFile$)
    If mGetLength% = 0 Then
       gSFMDBType$ = DEFA_SFMDBTYPE
    Else
       gSFMDBType$ = Left(msRetstring, mGetLength%)
    End If

'MIS DataBase
    mGetLength% = GetPrivateProfileString(APPL_SECTION, "MISDataBase", DEFA_MISDB, msRetstring, Len(msRetstring), gInitFile$)
    If mGetLength% = 0 Then
       gMISDB$ = DEFA_MISDB
    Else
       gMISDB$ = Left(msRetstring, mGetLength%)
    End If

'MIS Database Type
    mGetLength% = GetPrivateProfileString(APPL_SECTION, "MISDBType", DEFA_MISDBTYPE, msRetstring, Len(msRetstring), gInitFile$)
    If mGetLength% = 0 Then
       gMISDBType$ = DEFA_MISDBTYPE
    Else
       gMISDBType$ = Left(msRetstring, mGetLength%)
    End If

'OrgID
    mGetLength = GetPrivateProfileString(APPL_SECTION, "OrgID", DEFA_ORGID, msRetstring, Len(msRetstring), gInitFile$)
    If mGetLength = 0 Then
        mOrgID# = DEFA_ORGID
    Else
        mOrgID# = Left(msRetstring, mGetLength)
    End If
    OrgID = mOrgID#

'Sound
    mGetLength = GetPrivateProfileString(APPL_SECTION, "Sound", DEFA_R1Line, msRetstring, Len(msRetstring), gInitFile$)
    If mGetLength = 0 Then
        gSound = "N"
    Else
        gSound = Left(msRetstring, mGetLength)
    End If
   
'InputTester
    'mGetLength = GetPrivateProfileString(APPL_SECTION, "InputTester", DEFA_InputTester, msRetstring, Len(msRetstring), gInitFile$)
    'If mGetLength = 0 Then
    '    InputTester$ = DEFA_InputTester
    'Else
    '    InputTester$ = Left(msRetstring, mGetLength)
    'End If
    'OrgID = mOrgID#

' Open Database
    Set gdb = OpenDatabase(gSFMDB$, False, False, gSFMDBType$)
    tryOpenDB = True
   
' Open Database
    'Set grdb = OpenDatabase(gMISDB$, False, False, gMISDBType$)
    'tryOpenDB = True
   
    Exit Function
OpenFail:
  If Not gdb Is Nothing Then
     gdb.Close
  End If
  tryOpenDB = False
  MsgBox "資料庫連結失敗....."
  Exit Function
End Function

Sub GetInitDrivePath()
    Dim psRetstring As String * 144
    Dim pGetLength

    pGetLength = GetPrivateProfileString(APPL_SECTION, "LocalDrive", DEFA_DRIVE, psRetstring, Len(psRetstring), gInitFile$)
    If pGetLength = 0 Then
        gUseDrive$ = DEFA_DRIVE
    Else
        gUseDrive$ = Left(psRetstring, pGetLength)
    End If
   
    pGetLength = GetPrivateProfileString(APPL_SECTION, "RemoteService", DEFA_DRIVE, psRetstring, Len(psRetstring), gInitFile$)
    If pGetLength = 0 Then
        gUsePath$ = DEFA_DRIVE
    Else
        gUsePath$ = Left(psRetstring, pGetLength)
    End If

End Sub

Sub Main()
    Dim mService$, mPassword$, mDrive$, mSucceed%
    Dim mMsg$, msGetNowService$
   
    If App.PrevInstance = True Then
       MsgBox "You Can't have Two Same-Program in a Windows At a time.", 48
       End
    End If
    If Right$(App.Path, 1) <> "\" Then
       gInitFile$ = App.Path & "\" & INIT_FILE
    Else
       gInitFile$ = App.Path & INIT_FILE
    End If

    'gInitFile$ = "c:\CLV\CLV.INI"       '設定 INI 路徑

'   Setup INI using Local's INI file for ACCESS database
'^-^    SetDataAccessOption DB_OPTIONINIPATH, gInitFile$
    ' "C:\WINDOWS\FIS.INI"

'   Setup Drive/Path using remote service
'   Priority -> *.INI -> Default Drive/Path
    Call GetInitDrivePath
    If tryOpenDB Then
        'frmCOAMain.Show
        frmTRMA_INVOICE.Show
    End If
'Exit Sub
End Sub