mdlpublic.bas

用VB6.0编写的关于车辆运输调度的系统

Attribute VB_Name = "mdlPublic"
Option Explicit
Public gsUserCode As String
Public gsUserName As String
Public gsRoleCode As String
Public gsCmpCode As String
Public gsCmpDesc As String
Public gsEntCode As String
Public gsEntDesc As String
Public Const SpreadW As Integer = 9000
Public Const SpreadH As Integer = 3000

Global Const TREEKEY = "k"

Public DBF_cnt As New ADODB.Connection
Public DBF_Rec As New Recordset
Public Acs_cnt As New ADODB.Connection
Public acs_rec As New Recordset
Public rstDB As New Recordset

' CellType property settings
Public Const SS_CELL_TYPE_DATE = 0
Public Const SS_CELL_TYPE_EDIT = 1
Public Const SS_CELL_TYPE_FLOAT = 2
Public Const SS_CELL_TYPE_INTEGER = 3
Public Const SS_CELL_TYPE_PIC = 4
Public Const SS_CELL_TYPE_STATIC_TEXT = 5
Public Const SS_CELL_TYPE_TIME = 6
Public Const SS_CELL_TYPE_BUTTON = 7
Public Const SS_CELL_TYPE_COMBOBOX = 8
Public Const SS_CELL_TYPE_PICTURE = 9
Public Const SS_CELL_TYPE_CHECKBOX = 10
Public Const SS_CELL_TYPE_OWNER_DRAWN = 11


Public Function DBFC(DBF_S As String) As Boolean
On Error GoTo err
    DBFC = False
    
    DBF_cnt.ConnectionString = "Provider=MSDASQL.1;Persist Security Info=False;Data Source=" & DBF_S
    DBF_cnt.CursorLocation = adUseClient
    DBF_cnt.CommandTimeout = 15
    DBF_cnt.Open
    DBF_Rec.CursorType = adOpenStatic
    Set DBF_Rec.ActiveConnection = DBF_cnt
    
    DBFC = True
    Exit Function
err:

End Function

Public Function DBFD() As Boolean
On Error GoTo err
    DBFD = False
    
    DBF_Rec.Close
    Set DBF_Rec = Nothing
    DBF_cnt.Close
    Set DBF_cnt = Nothing
    
    DBFD = True
    Exit Function
err:

End Function

Public Function AcsS(acs_s As String) As Boolean
On Error GoTo err
    AcsS = False
    
    Set Acs_cnt = New ADODB.Connection
    Acs_cnt.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=false;Data Source= '" & acs_s & "'" '& ";pwd= 'shiyun'"
    Acs_cnt.CursorLocation = adUseClient
    Acs_cnt.CommandTimeout = 15
    Acs_cnt.Open
    acs_rec.CursorType = adOpenStatic
    Set acs_rec.ActiveConnection = Acs_cnt
    
    AcsS = True
    Exit Function
    
err:

End Function

Public Function ConnectDB(ByVal adoconn As ADODB.Connection, sPath As String) As Boolean
On Error GoTo err
    ConnectDB = False
    
'    Set adoconn = New ADODB.Connection
    adoconn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=false;Data Source= '" & sPath & "'"
    adoconn.CursorLocation = adUseClient
    adoconn.CommandTimeout = 15
    adoconn.Open
    rstDB.CursorType = adOpenStatic
    Set rstDB.ActiveConnection = adoconn
    
    ConnectDB = True
    Exit Function
    
err:

End Function

Public Function AcsD() As Boolean
On Error GoTo err
    Acs_cnt.Close
    Set Acs_cnt = Nothing
    acs_rec.Close
    Set acs_rec = Nothing
    
    AcsD = True
    Exit Function

err:

End Function

Public Sub main()
Dim acs_s As String
    
    If App.PrevInstance Then
        Exit Sub
    End If

'    acs_s = App.Path & "\.." & "\Dbs\LDS.mdb"
'    AcsS (acs_s)
'
'    Call AcsS(acs_s)
    
    frmLogin.Show
    
End Sub