Attribute VB_Name = "ModFunction"
Option Explicit
Global g_DSN As String
Global SYS_Cnn As ADODB.Connection
Global g_Password As String

Global gMsgShow As Boolean

'INI變量
Global g_Database As String
Global g_UID As String
Global g_PWD As String
Global g_Server As String
Global g_driver As String
Global gbConnected As Boolean
Global gAccessFileType As String

Global gRAdmin As Boolean
Global gRInput As Boolean
Global gRQuery As Boolean
Global gRExt As Boolean
Global gCurUser As String
Global gFileType As String
Global gFileAccess As String


'用戶權限類型
Global Const USER_ADMIN = "0"
Global Const USER_INPUT = "1"
Global Const USER_QUERY = "2"
Global Const USER_DYNADATA = "3"
Global Const USER_GIS = "4"
Global Const USER_IEQUERY = "5"
Global Const USER_IEGIS = "6"
Global Const USER_INTERFACE = "7"
Global Const USER_EXT = "8"



Public Sub ConnectServer()
    gbConnected = True
    If ConnectSysDB Then
        If TestSysTable Then
            frmCheckUser.Show
        Else
            On Error Resume Next
            SYS_Cnn.Close
            gbConnected = False
        End If
    Else
        gbConnected = False
    End If
End Sub

Function ConnectSysDB() As Boolean
Dim adoConnect As String
Dim adoConnect_old As String
Dim g_driver As String
Dim g_Database As String
Dim g_UID As String
Dim vUID As String
Dim g_PWD As String
Dim gsConnectString As String
    adoConnect = ""
    g_driver = "Microsoft Access"
    g_Database = App.Path & "\" & "Test.mdb"
    If g_DSN = "(無)" Or g_DSN = "" Then
        If g_driver = "" Then
            MsgBox "還沒有選擇有效的數據庫驅動程序" & vbCrLf & "請在‘數據源設置’中選擇相應的驅動程序", vbInformation, "連接數據庫"
            gbConnected = False
            ConnectSysDB = False
            GoTo lbl_End
        End If
    Else
        adoConnect = "DSN=" & g_DSN & ";"
    End If
    adoConnect_old = adoConnect_old & "Driver={" & g_driver & "};"
    adoConnect_old = adoConnect_old & IIf(g_UID = "", "", "User ID=" & vUID & ";")
    adoConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;"
    adoConnect = adoConnect & IIf(g_PWD = "", "", "Jet OLEDB:Database Password=" & g_PWD & ";")
    On Error GoTo Err_File
    If Dir(g_Database, vbNormal) <> "" Then
        adoConnect_old = adoConnect_old & IIf(g_Database = "", "", "DBQ=" & g_Database & ";")
        adoConnect = adoConnect & IIf(g_Database = "", "", "Data Source=" & g_Database & ";")
        adoConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & g_Database & ";Mode=ReadWrite;Jet OLEDB:Database Password =" & g_Password & ";Persist Security Info=False"
        adoConnect_old = adoConnect
    Else
Err_File:
        MsgBox "無法找到指定的數據庫!" & vbCrLf & "請檢查設置是否正確", vbExclamation + vbOKOnly, "連接數據庫"
        gbConnected = False
        ConnectSysDB = False
        GoTo lbl_End
    End If
  On Error GoTo 0
    On Error GoTo err_Connectsysdb
    Set SYS_Cnn = New ADODB.Connection
    SYS_Cnn.ConnectionString = adoConnect
    SYS_Cnn.CommandTimeout = 5
    SYS_Cnn.CursorLocation = adUseClient
    SYS_Cnn.Open
    On Error GoTo 0
    gsConnectString = adoConnect
    gbConnected = True
    ConnectSysDB = True
lbl_End:
     Exit Function
err_Connectsysdb:
    MsgBox "連接數據庫出錯!" & vbCrLf & "沒有打開數據庫" & vbCrLf & "檢查設置是否正確", , "系統提示"
    Exit Function
End Function



Function TestSysTable() As Boolean
Dim errTimes As Integer
Dim rcSys As New ADODB.Recordset
Dim temName As String
Dim temCaption As String
Dim sSysTableName As String
Dim temVal As Integer
    TestSysTable = False
    temName = "UserLogin"
    temVal = SearchTable(temName)
    If temVal <> 1 Then GoTo err_NotFound
    TestSysTable = True
    Exit Function
err_NotFound:
    MsgBox "系統表：《" & temName & "》不存在,系統無法正常運行！", , "提示系統"
    TestSysTable = False
    Exit Function
err_OpenSysTable:
    MsgBox "數據庫系統表打開失敗!", , " 系統提示"
End Function


Function SearchTable(vTableName As String) As Integer
Dim rcTest As ADODB.Recordset
    SearchTable = 0
    Set rcTest = New ADODB.Recordset
    On Error GoTo err_NotFound
    rcTest.Open vTableName, SYS_Cnn, adOpenDynamic, adLockOptimistic, adCmdTable
    On Error GoTo 0
    SearchTable = 1
    Exit Function
err_NotFound:
    SearchTable = 0
    Exit Function
End Function

Public Function CanOpenDateBase(fsFilename As String, fsPasswd As String) As Boolean
    On Error GoTo ErrLabel
    Dim sConn As String
    Dim gADO As New ADODB.Connection
    sConn = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & fsFilename & _
            ";Jet OLEDB:Database Password =" & fsPasswd & ";"
    gADO.Open sConn
    If gADO.State > 0 Then
        gADO.Close
    End If
    CanOpenDateBase = True
ErrLabel:
    Err.Clear
    Set gADO = Nothing
End Function