Attribute VB_Name = "mdlMain"
Option Explicit

Public cn As ADODB.Connection
Public rs As ADODB.Recordset


Public Sub Main()

    If App.PrevInstance Then                                '只允許運(yùn)行一個(gè)實(shí)例
        MsgBox "本系統(tǒng)正在運(yùn)行中！", vbOKOnly
        Exit Sub
    End If
    
    frmConnect.Show



End Sub



'連接數(shù)據(jù)庫(kù)
Public Function ConnectDB(DBServer As String, DBUserID As String, DBPassword As String) As Boolean
    On Error GoTo err
    
    Set cn = New ADODB.Connection
    With cn
        .ConnectionString = "Provider=SQLOLEDB.1;Password=" & DBPassword & ";Persist Security Info=True;User ID=" & DBUserID & ";Initial Catalog=master;Data Source=" & DBServer
        .Mode = adModeReadWrite
        .CursorLocation = adUseServer
        .ConnectionTimeout = 5
        .CommandTimeout = 5
        .Open
    End With
    
    Set rs = New ADODB.Recordset
    With rs
        .CursorLocation = adUseServer
        .CursorType = adOpenForwardOnly
        .LockType = adLockOptimistic
        .ActiveConnection = cn
    End With
        
    ConnectDB = True
    Exit Function
err:
    ConnectDB = False
    MsgBox err.Description
End Function



'備份數(shù)據(jù)庫(kù)
Public Function BackUpDataBase(ByVal sBackUpFilePath As String, ByVal sDataBaseName As String) As Boolean
    On Error GoTo err
        
    Dim sFileName As String
    sFileName = sDataBaseName & "(" & Format(CStr(Now()), "yy-mm-dd hh.mm") & ").備份文件"
    If Right(sBackUpFilePath, 1) <> "\" Then
        sBackUpFilePath = sBackUpFilePath & "\"
    End If
    sFileName = sBackUpFilePath & sFileName
    
    Dim SQLTemp As String
    SQLTemp = "backup database [" & sDataBaseName & "]" & vbCrLf & _
            "to disk='" & sFileName & "'" & vbCrLf & _
            "with  name=N'" & sDataBaseName & "'," & vbCrLf & _
            "description='完全備份',init,format,skip,restart"
       
    cn.Execute SQLTemp
          
    
    BackUpDataBase = True
    Exit Function
err:
    BackUpDataBase = False
    MsgBox err.Description
End Function