module1.bas

一个简单的用vb制作的公司贸易管理系统

Attribute VB_Name = "Module1"
Public fMainForm As frmMain
Public flagAedit As Boolean '工厂联系人
Public gintAmode As Integer '工厂联系人

Public flagLedit As Boolean '公司联系人
Public gintLmode As Integer '公司联系人

Public flagPedit As Boolean '供应商
Public gintPmode As Integer '供应商

Public flagCedit As Boolean '客户
Public gintCmode As Integer '客户

Public flagGedit As Boolean
Public gintGmode As Integer
Public flagSedit As Boolean
Public gintSmode As Integer
Public flagOedit As Boolean
Public gintOmode As Integer
Public UserName As String
Public IDlist As Collection
Public SPFlag As Integer
Public ServerName, DataBase, UserID, UserPsw As String





Sub Main()
Shell "regsvr32.exe /s " & App.Path & "RevMDITabs.ocx", vbHide

    If App.PrevInstance = True Then MsgBox "程序已经在运行！", 64: Exit Sub
    frmSplash.Show 1
    frmLogin.Show vbModal
    If Not frmLogin.LoginSucceeded Then
        End
    End If
    Unload frmLogin

    Set fMainForm = New frmMain
    fMainForm.Show
End Sub

Public Function ConnectString() _
                              As String
    'returns a DB ConnectString
    '   ConnectString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" & UserID & ";Initial Catalog=Trade;Data Source=" & ServerName & ""
    ConnectString = "Provider=SQLOLEDB.1;Password=" & UserPsw & ";Persist Security Info=True;User ID=" & UserID & ";Initial Catalog=" & DataBase & ";Data Source=" & ServerName & ""

End Function
Public Function ExecuteSQL(ByVal SQL _
                           As String, MsgString As String) _
                           As ADODB.Recordset
    'executes SQL and returns Recordset
    Dim cnn As ADODB.Connection
    Dim Rst As ADODB.Recordset
    Dim sTokens() As String

    On Error GoTo ExecuteSQL_Error

    sTokens = Split(SQL)
    Set cnn = New ADODB.Connection
    cnn.Open ConnectString
    If InStr("INSERT,DELETE,UPDATE", _
       UCase$(sTokens(0))) Then
        cnn.Execute SQL
        MsgString = sTokens(0) & _
                    " query successful"
    Else
        Set Rst = New ADODB.Recordset
        Rst.Open Trim$(SQL), cnn, _
                 adOpenKeyset, _
                 adLockOptimistic
        'rst.MoveLast     'get RecordCount
        Set ExecuteSQL = Rst
        MsgString = "查询到" & Rst.RecordCount & _
                    " 条记录 "
    End If
ExecuteSQL_Exit:
    Set Rst = Nothing
    Set cnn = Nothing

Exit Function

ExecuteSQL_Error:
    MsgString = "查询错误: " & _
                Err.Description
    Resume ExecuteSQL_Exit
End Function
Public Sub EnterToTab(Keyasc As Integer)
    If Keyasc = 13 Then
        SendKeys "{TAB}"
    End If
End Sub
Public Function GetRkno() As String
    GetRkno = Format(Now, "yymmddhhmmss")
    Randomize
    GetRkno = GetRkno & Int((99 - 10 + 1) * Rnd + 10)
End Function