module1.bas

来自「我自己编写的个人财务系统,VB语言,用于个人财务统计,可自己初始化财务类别,密码」· BAS 代码 · 共 88 行

Attribute VB_Name = "Module1"
Option Explicit
Public db As New ADODB.Connection
Public Cmd As New ADODB.Command
Public myName As String
Public sid As Integer
'Public myKeys As String
Public myGrade, myPass As String
Public Status1, Status2, Status3 As Integer

'Public UserCode As String
'Public UserName As String
'Public OldSort As In teger '存贮栅格排序方式

Sub Main()
    If App.PrevInstance = True Then
        MsgBox " 系统巳在运行中 !!!   ", vbQuestion
        End
    End If
    If Not ServerConnect Then
        MsgBox "数据库联接错误，请查看联机帮助文件 !!!  ", vbCritical
        End
    End If
    'administer.Show
    'MDIForm1.Show
     Dim ii As Integer
    login.Show
'                DoEvents '将控制权交给操作系统，意味者下述操作(数据库连接)将在后台执行
'
'                For ii = 0 To 1000
'                   login.ProgressBar1.Value = ii / 10    '控制展示屏的进度条（慢）
'                Next ii

    'On Error GoTo err1

     'Form1.Show
End Sub

Public Function ServerConnect() As Boolean
    Dim strConnectString As String
    ServerConnect = False
    Dim A, B, C As Variant
    Dim database As String
    Dim SQLstatus As String
    
On Error GoTo ErrHandle
    SQLstatus = "ACCESS"
    Select Case UCase(SQLstatus)
    Case "ACCESS"
        strConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Password='';Data Source=" & App.Path & "\xitong.cci"
    Case "SQL"
        'strConnectString = "driver={SQL SERVER};SERVER=" & ServerName & "; UID=sa;PWD=;DATABASE=" & DatabaseName & ""
        'strConnectString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=" & DatabaseName & ";Data Source=" & ServerName
    Case "ORACLE"
        'strConnectString = "driver={ORACLE ODBC DRIVER};CONNECTSTRING=ORA;UID=wsfy;PWD=wsfy;"
        'strConnectString = "Provider=MSDAORA.1;Password=wsfy;User ID=wsfy;Data Source=" & ServerName & ";Persist Security Info=True"
    End Select
    db.ConnectionString = strConnectString
    db.ConnectionTimeout = 100
    db.Open strConnectString
    Set Cmd.ActiveConnection = db
    ServerConnect = True
    Exit Function
ErrHandle:
    Dim adoErr As ADODB.Error
    If db.Errors.Count > 0 Then
        For Each adoErr In db.Errors
            MsgBox "[Error Code] " & adoErr.Number & Chr(13) & adoErr.Description, vbCritical + vbOKOnly, "Error"
        Next adoErr
    End If
End Function

Public Sub MyOpen(rs As ADODB.Recordset, Sql As String)
'On Error GoTo l:
    With rs
        If .State = 1 Then .Close
        .CursorLocation = adUseClient
        '.CursorLocation = adUseServer
        .Open Sql, db, adOpenKeyset, adLockOptimistic
    End With
'Exit Sub
'l:
'MsgBox "操作无效!", vbCritical, "错误"
End Sub