mainmodule.bas

一个为公安系统接警中心控制软件,不错哦.

Attribute VB_Name = "MainModule"
Option Explicit
Public Const SYSTEM_SECTION = "System"

Global m_gMainForm As frmMain
Global m_gsConnection As String
Global m_gCnAlarm As ADODB.Connection
Global m_gsDatabase As String

Global m_gsIniFile As String
Global m_gsSoundFile As String
Global m_sUnitName As String

Global m_gsOperator As String       '当前操作员(m_gbSuperMan = TRUE, 则为主管姓名)
Global m_gsOperatorPass As String   '当前操作员口令(m_gbSuperMan = TRUE, 则为主管口令)

Global m_gbManufacturer As Boolean
Global m_gbSuperMan As Boolean      '是否主管
Global m_gbSystemMan As Boolean     '是否系统管理员

Sub Main()
    Dim sAppName As String
    
    DisableHostReset (True)
    sAppName = App.Path & "\" & App.EXEName & ".EXE"
    SetStringValue "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run", App.Title, sAppName
    
    m_sUnitName = "高特技集团报警中心"
    m_gsDatabase = App.Path & "\Alarm.mdb"
    m_gsConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source= " & m_gsDatabase
    m_gsIniFile = App.Path & "\" & App.EXEName & ".INI"
    m_gsSoundFile = App.Path & "\Siren1.wav"
    
    Set m_gCnAlarm = New ADODB.Connection
    m_gCnAlarm.ConnectionString = m_gsConnection
    m_gCnAlarm.CursorLocation = adUseClient
    m_gCnAlarm.Open
    
    frmSplash.Show
    frmSplash.Refresh
    
    Dim bValidity As Boolean
    bValidity = GetStringValue(GetSubKey(), "Validity", False)
    If Not bValidity Then
        Dim fLogin As New frmLogin
        fLogin.Show vbModal
        If Not fLogin.OK Then
            DisableHostReset (False)
            End
        End If
        RegisterEnvironmentVar (True)
        Unload fLogin
    Else
        ReadEnvironmentVar
    End If

    Set m_gMainForm = New frmMain
    Load m_gMainForm
    Unload frmSplash
    m_gMainForm.Show
End Sub

Sub ComSetting()
    'On Error Resume Next
    Dim rs As ADODB.Recordset
    Dim SetttingStr As String
    Dim ComPort As Integer
    Dim dataBits As String, Stopbits As String
    Dim Baud As String, Parity As String
    
    Set rs = New ADODB.Recordset
    rs.Open "select FBaud,Fparity,FStopBits,FCom,FDataBits from System", m_gCnAlarm
    
    If Not (rs.EOF And rs.BOF) Then
        Baud = rs!Fbaud
        ComPort = rs!FCom
        dataBits = rs!Fdatabits
        Parity = rs!Fparity
        Stopbits = rs!FStopbits
    End If
    rs.Close
    
    m_gMainForm.MSComm1.CommPort = ComPort
    If Err Then
                MsgBox Error$, 48
                Exit Sub
    End If
    Select Case Parity
        Case 0
            Parity = "None"
        Case 1
            Parity = "O"
        Case 2
            Parity = "E"
    End Select
    
    Stopbits = 1
    m_gMainForm.MSComm1.Settings = Baud & "," & Parity & "," & dataBits & "," & Stopbits
    
    
    If Err Then
                MsgBox Error$, 48
                Exit Sub
    End If
    m_gMainForm.MSComm1.Handshaking = comNone
    m_gMainForm.MSComm1.InputLen = 21
    m_gMainForm.MSComm1.PortOpen = True
    If Err Then
                MsgBox Error$, 48
                Exit Sub
    End If
End Sub

Public Sub FillCobAlarmtype(cobAlarmType As ComboBox)
    Dim rs As ADODB.Recordset
    
    Set rs = New ADODB.Recordset
    rs.CursorLocation = adUseClient
    rs.Open "SELECT Sign.FSignCode, Sign.FSignName From Sign Order by Sign.FSignCode", m_gCnAlarm, adOpenStatic, adLockOptimistic
    
    Do While Not rs.EOF
        cobAlarmType.AddItem rs![FSignCode] & " " & rs![FSignName]
        rs.MoveNext
    Loop
    rs.Close
End Sub

Public Function ComboFindData(cobAlarmType As ComboBox, sFindText As String) As String
    Dim i As Integer
    Dim sTemp As String
    
    For i = 0 To cobAlarmType.ListCount
        sTemp = cobAlarmType.List(i)
        If UCase(Left(sTemp, 3)) = UCase(sFindText) Then
            ComboFindData = Right(sTemp, Len(sTemp) - 4)
            Exit Function
        End If
    Next i
    ComboFindData = ""
End Function

Public Sub WriteFile(RecStr As String)
    Dim sFileName As String
    sFileName = App.Path & "\TESTFILE.txt"
    Open sFileName For Append As #1   ' 打开输出文件。
    Write #1, RecStr
    Close #1
End Sub

Private Function GetSubKey() As String
    GetSubKey = "HKEY_CURRENT_USER\Software\" & App.Title
End Function

Public Sub RegisterEnvironmentVar(bValidity As Boolean)
    CreateKey GetSubKey()
    SetStringValue GetSubKey(), "Validity", bValidity
    SetStringValue GetSubKey(), "Operator", m_gsOperator
    SetStringValue GetSubKey(), "OperatorPass", m_gsOperatorPass
    SetStringValue GetSubKey(), "Manufacturer", m_gbManufacturer
    SetStringValue GetSubKey(), "SuperMan", m_gbSuperMan
    SetStringValue GetSubKey(), "SystemMan", m_gbSystemMan
End Sub

Public Sub ReadEnvironmentVar()
    m_gsOperator = GetStringValue(GetSubKey(), "Operator", "")
    m_gsOperatorPass = GetStringValue(GetSubKey(), "OperatorPass", "")
    m_gbManufacturer = GetStringValue(GetSubKey(), "Manufacturer", False)
    m_gbSuperMan = GetStringValue(GetSubKey(), "SuperMan", False)
    m_gbSystemMan = GetStringValue(GetSubKey(), "SystemMan", False)
End Sub