Attribute VB_Name = "DB"
'====數據源連接模塊 V1.5====

'   作者:我是乖豬豬
'   QQ:68492919
'   博客:http://hi.baidu.com/sedjamm
'   E-mail:Sedlover@163.com

'   使用方法:   首先引用 Microsoft ActiveX Data Objects 2.5 Library
'               引用方法:工程->引用->勾選Microsoft ActiveX Data Objects 2.5 Library
'               當Microsoft ActiveX Data Objects版本低于2.5時,ADODB沒有Stream對象和Record對象
'               用戶自己可以通過{Public|Private|Dim} 實例名 as New ADODB.Connection 來定義一個ADODB.Connection實例
'               用戶自己可以通過{Public|Private|Dim} 實例名 as New ADODB.Recordset 來定義一個ADODB.Recordset實例 等ADODB的實例
'               也可直接使用給大家定義好的實例名為JDB,JRS的Connection,Recordset實例

'               還需要的DLL文件:    msado15.dll
'                                   oledb32.dll
'                                   oledb32r.dll
'                                   OLEDB32X.DLL
'               把這幾個DLL文件拷貝到工程文件所在的DLL子目錄下.


'    注意：1.當使用Excle方式時，選擇記錄集時表名為 [工作表$]
'            例：   ConnRS JDB, JRS, "select * from [Sheet1$]"
'===========================

'====API引用====

Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Long
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String
End Type

'====數據源變量====
Public JDB As New ADODB.Connection      '----這個 ADODB.Connection 用戶使用,作用域:全局----
Public JRS As New ADODB.Recordset       '----這個 ADODB.Recordset 用戶使用,作用域:全局----

'====SQL服務器變量====
Public JServerName As String            '----SQL服務器名----
Public JUserID As String                '----用戶名----
Public JPassword As String              '----密碼----
Public JDefaultDB As String            '----默認數據庫名----

'====自定義過程:設置SQL服務器變量====
'   ----使用SQL方式接連前使用----
Public Sub SetSQLDef(ServerName As String, UserID As String, Password As String, DefaultDB As String)
JServerName = ServerName
JUserID = UserID
JPassword = Password
JDefaultDB = DefaultDB
End Sub

'====自定義函數:連接數據源====
'       DBClass=1   無密碼的Access數據源連接，ConnStr=mdb文件的完整路徑。

'       DBClass=2   SQL Server 方式連接，ConnStr沒有用
'                   要使用SetSQLDef先設置SQL服務器變量

'       DBClass=3   無密碼的Excle數據源連接，ConnStr=xls文件的完整路徑。
'                   例：ConnDB JDB,3,App.Path & "\Temp.xls"

'       DbClass=4   使用udl文件連接
'                   connstr 為udl文件的完整路徑

'       DBClass=11 有密碼的Access數據源連接，ConnStr=mdb文件的完整路徑 & "*" & 密碼
'                   例：ConnDB JDB, 11, App.Path & "\sysDB.mdb*ps123"

'       返回值為：連接成功=True；連接失敗=False
Public Function ConnDB(DBs As ADODB.Connection, DBClass As Long, ByVal connstr As String) As Boolean
    connstr = Trim(connstr)
    If DBs.State = adStateOpen And Not IsEmpty(adStateOpen) Then DBs.Close
    Select Case DBClass
    Case 1:    DBs.Open "PROVIDER=Microsoft.jet.OLEDB.4.0;data source= " & connstr
    
    Case 2:    DBs.Open "Provider=SQLOLEDB.1;Password=" & JPassword & ";Persist Security Info=True;User ID=" & JUserID & ";Initial Catalog=" & JDefaultDB & ";Data Source=" & JServerName
    Case 3:
                
            With DBs
                .Provider = "Microsoft.Jet.OLEDB.4.0"
                .ConnectionString = "Data Source=" & connstr & ";Extended Properties=Excel 8.0;"
                .Provider = "MSDASQL"
                .ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};DBQ=" & connstr & ";"
                .CursorLocation = adUseClient
                .Open
            End With

    Case 4:
        With DBs
            .ConnectionString = "FILE NAME=" & connstr
            .Open
        End With
    
    

    Case 11:
        Dim temp As Integer
            temp = InStr(connstr, "*")
    DBs.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Left(connstr, temp - 1) & ";Persist Security Info=False;Jet OLEDB:database password=" & Right(connstr, Len(connstr) - temp)
    Case Else:
    
    End Select
    ConnDB = DBs.State = adStateOpen And Not IsEmpty(adStateOpen)
End Function

'====自定義函數:選擇記錄集（游標）====

'           SQLStr SQL語句，一般為"select * from table"，可由自己的程序設計制定。
'           返回值為：連接成功=True；連接失敗=False
'           注意：當使用Excle方式時，選擇記錄集時表名為 [工作表$]
'           例:   ConnRS JDB, JRS, "select * from [Sheet1$]"
            
Public Function ConnRS(DBs As ADODB.Connection, RSs As ADODB.Recordset, SQLstr As String) As Boolean
    If RSs.State = adStateOpen And Not IsEmpty(adStateOpen) Then RSs.Close
        RSs.Open SQLstr, DBs, adOpenDynamic, adLockBatchOptimistic
    ConnRS = RSs.State = adStateOpen And Not IsEmpty(adStateOpen)
End Function


'====自定義過程:關閉數據源====
Public Sub CloseDB(DBs As ADODB.Connection)
    If DBs.State = adStateOpen And Not IsEmpty(adStateOpen) Then DBs.Close
End Sub

'====自定義過程:關閉記錄集（游標）====
Public Sub CloseRS(RSs As ADODB.Recordset)
If RSs.State = adStateOpen And Not IsEmpty(adStateOpen) Then RSs.Close
End Sub


'====自定義函數:新建/覆蓋UDL文件====

'       參數:
'           UDLname     文件完整路徑
'           Mode        False:如果文件存在,不覆蓋./True:如果文件存在,覆蓋.
'           CreateOpen  新建后打開文件. False:不打開/True:打開

'       返回值:         True:成功/False失敗


Public Function CreateUDL(UDLname As String, Mode As Boolean, CreateOpen As Boolean) As Boolean

On Error GoTo CreateUDLErrPro

    If Right(UDLname, 4) <> ".udl" Then UDLname = UDLname & ".udl"
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set a = fs.CreateTextFile(UDLname, Mode)
        a.Close
    CreateUDL = True
    If CreateOpen Then
        Dim ExecStr As String
        ExecStr = "rundll32.exe " & App.Path & "\DLL\oledb32.dll,OpenDSLFile " & UDLname
        Shell ExecStr
    End If



CreateUDLErrPro:
    Select Case Err.Number
    Case 0:
    Case 58:
        CreateUDL = False
    End Select
    
End Function


'====自定義過程:打開UDL文件====
'
Public Sub OpenUDL(UDLname As String)
        Dim ExecStr As String
        ExecStr = "rundll32.exe " & App.Path & "\DLL\oledb32.dll,OpenDSLFile " & UDLname
        Shell ExecStr
End Sub


'====自定義過程:刪除UDL文件====


Public Sub DeleteUDL(UDLname As String)
    If LCase(Right(UDLname, 4)) = ".udl" Then
        Dim result As Long, fileop As SHFILEOPSTRUCT
        With fileop
            .hwnd = 0
            .wFunc = &H3
            .pFrom = UDLname & vbNullChar & vbNullChar
            .fFlags = &H40
        End With
        result = SHFileOperation(fileop)
    End If
    
End Sub