module1.bas

来自「车辆管理系统是一个协助各单位进行全面的车辆管理的系统。包括车辆档案管理;驾驶员档」· BAS 代码 · 共 85 行

BAS
85
字号
Attribute VB_Name = "Module1"
Public fMainForm As FrmMain  '定义一个全局对象
Public username As String    '用于记录当前用户
Public password As String    '记录当前密码
Public flagtoexcel As Integer  '标志当前的导出数据对象
Public gintcMode As Integer
Public gintdMode As Integer
Public gintvMode As Integer
Public gintsMode As Integer
Public gintrMode As Integer
Public gintaMode As Integer
Public flagcEdit As Boolean
Public flagdEdit As Boolean
Public flagvEdit As Boolean
Public flagsEdit As Boolean
Public flagrEdit As Boolean
Public flagaEdit As Boolean            '以下是定义5个模块的标志,用于标志其处于添加还是修改状态
Sub Main()
    Dim fLogin As New frmlogin
    Dim fblogin As New Frmblogin
    fblogin.Show vbModal
    fLogin.Show vbModal
    If Not fLogin.OK Then
       
        End                           '失败则退出
    End If
    Unload fLogin


    Set fMainForm = New FrmMain       '登陆成功转主界面
    fMainForm.Show
    flagtoexcel = 0
End Sub

'定义一个数据库连接函数,返回一个连接字符串
Public Function ConnectString() As String
   ConnectString = "FileDSN=myconnection.dsn;UID=sa;PWD=" '连接数据库
End Function
'执行SQL,返回记录集合函数
Public Function ExecuteSQL(ByVal SQL As String, MsgString As String) As ADODB.Recordset

   Dim cnn As ADODB.Connection
   Dim rst As ADODB.Recordset
   Dim sTokens() As String
   
   On Error GoTo ExecuteSQL_Error                    ' 出错转向ExecuteSQL_Error
    
   sTokens = Split(SQL)
  '' sTokens = Split(" ")
   Set cnn = New ADODB.Connection
    cnn.Open ConnectString
   If InStr("INSERT,DELETE,UPDATE", UCase$(sTokens(0))) Then     '比较SQL语句,与三种操作匹配则执行
   'If InStr("ADDNEW,INSERT,DELETE,UPDATE", UCase$(sTokens(0))) Then
      cnn.Execute SQL
      ''cnn.Execute "delete from driver where sj_id='" & "968453714'"
     '' cnn.Execute ""
      MsgString = sTokens(0) & " query successful"
     'cnn.Close
   Else                                                          '否则执行查询记录集
      Set rst = New ADODB.Recordset
      rst.Open Trim$(SQL), cnn, adOpenKeyset, adLockOptimistic
      'rst.MoveLast     'get RecordCount
      Set ExecuteSQL = rst
      MsgString = "查询到" & rst.RecordCount & " 条记录 "
      'rst.Close
   End If
ExecuteSQL_Exit:
   Set rst = Nothing
   Set cnn = Nothing
  ' cnn.Close
  ' rst.Close
   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


⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?