mdlboot.bas

一个用VB写的财务软件源码

Attribute VB_Name = "mdlBoot"
Option Explicit

Public fMainForm As frmMain
  Public clsMyNavigateInit As clsNavigateInit
  Public myfrmNavigate As frmNavigate
  
Sub Main()
'----------------------------------------------------------
' boot procedure:
'   Step1:设置子系统代号
'   Step2:连接系统库(用户)
'       取得服务器名称/主机字符串
'       创建与'YkcwSysDB'的连接/创建'YkcwSysDB'用户的连接
'   Step3:注册
'       system login
'       show splash
'       建立与账套库(用户)的连接
'       {各个子系统个性环境的检测}
'       创建主界面窗体
'       进行操作员的权限设置，如果不成功退出
'   Step4:运行系统，显示界面
'       生成系统本次运行的管理流水号
'       {各个子系统个性环境的创建}
'       显示主界面
'----------------------------------------------------------
'    Dim fLogin As frmSystemLogin
      Dim rSt As ADODB.Recordset
       Dim qjj As String
 
    
   If App.PrevInstance = True Then Exit Sub
'==========================2002.08.25===yao revise添加加密============================================================
   Set s = CreateObject("encryption.iencryption")
'=================================================================================================================

'Step1:设置子系统代号
    gloSys.sSubSysId = "ZW"
    App.HelpFile = App.Path & "\Help Files\集成账务.chm"
    
    m_Mutex.uiFlat = g_FLAT
    m_Mutex.DeleteMutexSome (gloSys.sSubSysId)
    m_Mutex.DeleteObjectMutex (gloSys.sSubSysId)
    
'Step2:连接系统库(用户)
    Select Case g_FLAT
         Case "SQL"
            '取得服务器名称
            gloSys.sServer = GetSetting("Ykcw", "Startup", "ServerName")
            If gloSys.sServer = "" Then
                MsgBox "未取得服务器名称，可能尚未进行系统预装。" & vbCr & _
                            "请运行‘系统总控’后重新进行。", vbCritical
                Exit Sub
            Else
                gloSys.sUser = GetSetting("Ykcw", "Startup", "SQLUser")
                gloSys.sPassword = GetSetting("Ykcw", "Startup", "SQLPassword")
                '创建与'YkcwSysDB'的连接
                Set gloSys.cnnSYS = New ADODB.Connection
                On Error GoTo ErrorHandler
                gloSys.cnnSYS.Open GetConnectString(g_FLAT, gloSys.sServer, _
                    gloSys.sUser, s.decrypt(gloSys.sPassword), g_SYSDBNAME)
            End If
            
        Case "ORACLE"
            '取得主机字符串
            gloSys.sServer = GetSetting("Ykcw", "Startup", "OracleServer")
            gloSys.sUser = GetSetting("Ykcw", "Startup", "OracleUser")
            gloSys.sPassword = GetSetting("Ykcw", "Startup", "OraclePassword")
            If gloSys.sPassword = "" And gloSys.sUser = "" And gloSys.sServer = "" Then
                MsgBox "未取得主机字符串，可能尚未进行系统预装。" & vbCr & _
                            "请运行‘系统总控’后重新进行。", vbCritical
                Exit Sub
            Else
                '创建'YkcwSysDB'用户的连接
                Set gloSys.cnnSYS = New ADODB.Connection
                gloSys.cnnSYS.CommandTimeout = 300
                gloSys.cnnSYS.CursorLocation = adUseClient
                On Error GoTo ErrorHandler
                gloSys.cnnSYS.Open GetConnectString(g_FLAT, gloSys.sServer, _
                    g_SYSDBNAME, g_SYSPASSWORD)
            End If
            
        Case Else
            Err.Raise 5
    End Select
    
    
'Step3:注册
    'system login
'    Set fLogin = New frmSystemLogin
'    With fLogin
'        .usServer = gloSys.sServer
'        .Show 1
'        If .OK Then
'        '成功注册
'            glo.sAccountID = .usAccountID
'            glo.sAccountName = .usAccountName
'            glo.sOperateYear = .uiAccountYear
'            glo.sUserID = .usUserID
'            glo.sUserName = .usUserName
'            glo.sOperateDate = .usOperateDate
'            glo.iOperatePeriod = .uiPeriod
'            glo.sUnEarlierDate = .usUnEarlierDate
'            glo.sBeginYear = .uiAccountBeginYear
'            glo.sBeginMonth = .uiAccountBeginMonth
'        Else
'        '操作员取消注册
'            Unload fLogin
'            Exit Sub
'        End If
'    End With
'    Unload fLogin
 qjj = GetSetting("Ykcw", "Startup", "qj")
 If qjj <> "" Then
   If Format(Date, "yyyy-mm-dd") > Format(qjj, "yyyy-mm-dd") Then
     MsgBox "预使用时间已到请与开发商联系！", vbCritical
                Exit Sub
   Else
   If (Format(qjj, "mm") - Format(Date, "mm")) * 30 + Format(qjj, "dd") - Format(Date, "dd") < 15 Then
    MsgBox "预使用时间还有" & (Format(qjj, "mm") - Format(Date, "mm")) * 30 + Format(qjj, "dd") - Format(Date, "dd") & "天", vbCritical
   End If
   End If
 End If
'
    If Not funSystemLogin Then Exit Sub
    'show splash
    frmSplash.Show
    frmSplash.Refresh
    
    Dim sTmp As String
    sTmp = GetSetting(App.Title, "Settings", "IsDisplayVoucherInfo", "True")
    If UCase$(Trim$(sTmp)) = "TRUE" Then
        IsDisplayVoucherInfo = True
    Else
        IsDisplayVoucherInfo = False
    End If
    sTmp = GetSetting(App.Title, "Settings", "IsDisplayBalance", "True")
    If UCase$(Trim$(sTmp)) = "TRUE" Then
        IsDisplayBalance = True
    Else
        IsDisplayBalance = False
    End If
    
    '建立与账套库(用户)的连接
    Set glo.cnnMain = New ADODB.Connection
    Select Case g_FLAT
        Case "SQL"
            glo.cnnMain.Open GetConnectString(g_FLAT, gloSys.sServer, _
                gloSys.sUser, s.decrypt(gloSys.sPassword), "cwDB" & glo.sAccountID)
        Case "ORACLE"
            glo.cnnMain.CommandTimeout = 300
            glo.cnnMain.CursorLocation = adUseClient
            glo.cnnMain.Open GetConnectString(g_FLAT, gloSys.sServer, _
                "cwDB" & glo.sAccountID, "ykcwDB" & glo.sAccountID)
    End Select
    
'----------------------------------------------------------
   '设置明细账打印标志
    Dim rstPrint As New ADODB.Recordset
    Dim sSQL As String
     With rstPrint
        .CursorLocation = adUseClient
        sSQL = "select VoucherPrintMode from tsys_account where AccountID='" & glo.sAccountID & "'"
        .Open sSQL, gloSys.cnnSYS, adOpenStatic, adLockReadOnly
        If Not (.EOF And .BOF) Then
           glo.detailPrintMode = .Fields("VOUCHERPRINTMODE").value
        End If
     End With
     Set rstPrint = Nothing
    sSQL = "DELETE FROM tUSU_PzMutex "
    glo.cnnMain.Execute sSQL
    '创建主窗体
    Set fMainForm = New frmMain
   
    fMainForm.Show
    frmSplash.ZOrder
    frmSplash.Refresh

    '进行操作员的权限设置，如果不成功退出
    If Not SetUserAuth(glo.sAccountID, glo.sUserID) Then
        Unload fMainForm
        Unload frmSplash
        Exit Sub
    End If
    
    
'Step4:运行系统，显示界面
    '生成系统本次运行的管理流水号
    glo.lManageID = Manage_BootProject()

    '{各个子系统个性环境的创建}
'----------------------------------------------------------
    Select Case g_FLAT
        Case "SQL"
            gloSys.sDateType = "datetime"
        Case "ORACLE"
            gloSys.sDateType = "date"
    End Select
    
   
    '取出科目代码符号分隔的标志
    Set rSt = New ADODB.Recordset
    With rSt
        .CursorLocation = adUseClient
        .Open "SELECT Separatechar,voucherprintmode FROM tSYS_Account" & _
                " WHERE AccountID = '" & glo.sAccountID & "'", _
            gloSys.cnnSYS, adOpenStatic, adLockReadOnly
        On Error GoTo ErrorHandler
        
        If Not IsNull(.Fields("separatechar").value) Then
              glo.sSeparateSubject = .Fields("separatechar").value
        Else
              glo.sSeparateSubject = "0"
        End If
              glo.detailPrintMode = .Fields("voucherprintmode").value
        .Close
    End With
    Set rSt = Nothing
    
    '装入科目帮助窗体
'    Set frmUSU_KmHelp = New frmUSU_KmHelp
'    Load frmUSU_KmHelp
'    frmUSU_Kmhelp.Show 1
    
    '创建全程进度条窗体
    Set glo.frmProg = New frmProgress2
'----------------------------------------------------------

    '显示主界面
    Unload frmSplash
    
    Exit Sub
ErrorHandler:
    '显示出错信息
    MsgBox g_FLAT & " - 启动发生错误:" & vbCr & vbCr & _
        Err.Number & ":" & vbTab & Err.Description, vbExclamation
    '卸载可能已装入的窗体
    Set s = Nothing
    If Forms.Count > 0 Then
        Dim frm As Form
        For Each frm In Forms
            Unload frm
        Next
    End If
End Sub