frmwizard.frm

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

            txtEnterName.SetFocus
        Case 2
            cboMonthEnd.SetFocus
        Case 3
            If Not m_bUpdate Then
                chkPreSet.SetFocus
            End If
        Case 4
            mfgCodeLevel.Row = 1
            mfgCodeLevel.Col = 4
            mfgCodeLevel.SetFocus
        Case STEPS - 1
            cmdFinish.SetFocus
    End Select
    
End Sub


Private Sub cmdAbort_Click()
    
    If MsgBox("确实要放弃吗？", vbQuestion + vbYesNo) = vbYes Then
        m_bUpdate = False
        Unload Me
    End If
End Sub
'Private Sub cmdHelp_Click()
'    SendKeys "{F1}"
'End Sub


'按“完成”，开始创建一个新账套
Private Sub cmdFinish_Click()
    Dim sConnection As String
    Dim cnnVirtual As ADODB.Connection
    Dim adoCmd As ADODB.Command
    Dim NewDBName As String
    
    If Not m_bUpdate Then
        lblMsg.Caption = "正在创建账套..."
        pbr.Visible = True
        fraCommands.Enabled = False
        Me.MousePointer = vbHourglass
        Me.Refresh
        
    '一、建立账套数据库并打开连接
        NewDBName = "cwDB" & Trim$(txtAccountID.text)
        
        Select Case g_FLAT
            Case "SQL"
                '1:打开一个虚数据环境（不指向任何数据库）
                Set cnnVirtual = New ADODB.Connection
                cnnVirtual.Open GetConnectString(g_FLAT, gloSys.sServer, _
                    gloSys.sUser, s.decrypt(gloSys.sPassword))
                pbr.Value = 5
                lbPro.Caption = "完成：5%"
                '2:新建“cwDB”& AccountID 库
                Set adoCmd = New ADODB.Command
                adoCmd.ActiveConnection = cnnVirtual
                adoCmd.CommandText = "CREATE DATABASE " & NewDBName
                adoCmd.Execute
                Set adoCmd = Nothing
                pbr.Value = 10
                lbPro.Caption = "完成：10%"
                
                '3:打开与所新建的账套库的数据连接
                cnnVirtual.Close
                cnnVirtual.Open GetConnectString(g_FLAT, gloSys.sServer, _
                    gloSys.sUser, s.decrypt(gloSys.sPassword), NewDBName)
            
            Case "ORACLE"
                '1:新建“cwDB”& AccountID 用户，密码为"ykcwDB####"
                Set adoCmd = New ADODB.Command
                With adoCmd
                    .ActiveConnection = gloSys.cnnSys
                    .CommandType = adCmdText
                    .CommandTimeout = 300
'================================2002.9.5 yao Add=============================================================
                    If Not IsExist Then
                        .CommandText = "CREATE TABLESPACE CW_ts" & _
                                    " DATAFILE 'CW_ts_1.dat' SIZE 200M REUSE AUTOEXTEND ON NEXT 40M MAXSIZE UNLIMITED," & _
                                    " 'CW_ts_2.dat' SIZE 200M REUSE  AUTOEXTEND ON NEXT 40M MAXSIZE UNLIMITED" & _
                                    " DEFAULT STORAGE (PCTINCREASE 0)"
                        .Execute
                     End If
                     If Not IsExistTMP Then
                         .CommandText = "CREATE TABLESPACE CW_tsTmp" & _
                                       " DATAFILE 'CW_tsTmp.dat' SIZE 100M  REUSE AUTOEXTEND ON NEXT 20M" & _
                                        " DEFAULT STORAGE (PCTINCREASE 0)  TEMPORARY"
                         .Execute
                     End If
'============================================================================================================
                   .CommandText = "CREATE USER " & NewDBName & " IDENTIFIED BY " & s.decrypt(gloSys.sPassword) & _
                       " DEFAULT TABLESPACE CW_ts TEMPORARY TABLESPACE CW_tsTmp" & _
                       " QUOTA UNLIMITED ON CW_ts QUOTA UNLIMITED ON CW_tsTmp"
                    .Execute
                    .CommandText = "ALTER USER " & NewDBName & " IDENTIFIED BY yk" & NewDBName
                    .Execute
                    .CommandText = "GRANT DBA TO " & NewDBName
                    .Execute
                End With
                Set adoCmd = Nothing
                pbr.Value = 5
                lbPro.Caption = "完成：5%"
                
                '2:利用新建的"cwDB####"用户登录
                Set cnnVirtual = New ADODB.Connection
                cnnVirtual.CursorLocation = adUseClient
                cnnVirtual.CommandTimeout = 300
                cnnVirtual.Open GetConnectString(g_FLAT, gloSys.sServer, _
                    NewDBName, "yk" & NewDBName)
                pbr.Value = 10
                lbPro.Caption = "完成：10%"
                
            Case Else
                Err.Raise 5
        End Select
    
    '二、创建所有表格式
       lbPro.Caption = ""
        Call CreateCWDBTables(cnnVirtual, txtBeginYear.text, pbr, lbPro)
        lbPro.Caption = ""
        pbr.Value = 50
        lbPro.Caption = "完成：50%"
    
    '三、预装记录
        Call PreSetRecords(cnnVirtual)
        lbPro.Caption = ""
        pbr.Value = 95
        lbPro.Caption = "完成：95%"

        
    '四、添加YkcwSysDB 中几个表的记录
        Call AppendSysDB
        
        pbr.Value = 100
        lbPro.Caption = "完成：100%"
        lblMsg.Visible = False
        
        '*********** add 2002.07.17
        lblInfo.Caption = "系统正在优化,请等待..."
        lblInfo.Visible = True
        Me.Refresh
        Call Wait
        
        
        Me.Refresh
        Me.MousePointer = vbDefault
        lbPro.Visible = False
        MsgBox "成功创建账套“" & Trim$(txtAccountName.text) & _
                "[" & Trim$(txtAccountID.text) & "]”！", vbInformation
                
        cnnVirtual.Close
        Set cnnVirtual = Nothing
    Else
        lblMsg.Visible = True
        lblMsg.Caption = "正在修改账套..."
    
        '更新YkcwSysDB 中几个表的记录
        Call UpdateSysDB
       
       '*************** 2002.06.21 add 更新报表部分
       Set cnnVirtual = New ADODB.Connection
       NewDBName = "cwDB" & Trim$(txtAccountID.text)
       If g_FLAT = "SQL" Then
            cnnVirtual.Open GetConnectString(g_FLAT, gloSys.sServer, _
                         gloSys.sUser, s.decrypt(gloSys.sPassword), NewDBName)
            
       Else
            cnnVirtual.Open GetConnectString(g_FLAT, gloSys.sServer, _
                         NewDBName, "yk" & NewDBName, NewDBName)
       End If
       Set adoCmd = New ADODB.Command
       adoCmd.ActiveConnection = cnnVirtual
       adoCmd.CommandText = "update tbb_company set " & _
        "vcname='" & Trim(txtEnterName.text) & "' where vccode='0000' and cyear='" & txtBeginYear.text & "'"
        adoCmd.Execute
        Set adoCmd = Nothing
        cnnVirtual.Close
        Set cnnVirtual = Nothing
       '*************** 2002.06.21 end 更新报表部分
       
        lblInfo.Caption = "系统正在优化，请等待。"
        Call Wait
        
        
        lblMsg.Visible = False
        lblInfo.Visible = True
        Me.Refresh
        Me.MousePointer = vbDefault
        
        MsgBox "成功修改账套“" & Trim$(txtAccountName.text) & _
                "[" & Trim$(txtAccountID.text) & "]”！", vbInformation
    End If
    Unload Me
End Sub

Private Sub Wait()
'   18秒
    Dim lLong As Long
    Dim lStep As Long
'    For lStep = 0 To 10000
    For lStep = 0 To 10000
        For lLong = 0 To 5000
            lLong = lLong
        Next lLong
    Next lStep
End Sub
     '===========================判断用户是否存在===================================================================
Private Function IsExistUser(ByVal sUser As String) As Boolean
Dim rSt As New ADODB.Recordset
    IsExistUser = False
On Error GoTo HandleErr
    With rSt
        .CursorLocation = adUseClient
        If g_FLAT = "ORACLE" Then
        .Open "select * from sys.dba_users where username='" & UCase("CWDB" & Trim("" & sUser)) & "'", _
            gloSys.cnnSys, adOpenStatic, adLockReadOnly
        Else
        .Open "select * from master.dbo.sysdatabases where name='" & UCase("CWDB" & Trim("" & sUser)) & "'", _
            gloSys.cnnSys, adOpenStatic, adLockReadOnly
        End If
        If Not (.EOF And .BOF) Then
            IsExistUser = True
        End If
        .Close
    End With
    Exit Function
HandleErr:
    MsgBox Err.Description, vbInformation, "提示"
    Exit Function
End Function

    '============================判断表空间是否存在================================================================
Private Function IsExist() As Boolean
    Dim rSt As New ADODB.Recordset
    IsExist = False
   
    With rSt
        .CursorLocation = adUseClient
        .Open "select * from sys.dba_tablespaces where tablespace_name='CW_TS'", _
            gloSys.cnnSys, adOpenStatic, adLockReadOnly
        If Not (.EOF And .BOF) Then
            IsExist = True
        End If
        .Close
    End With
End Function

   '============================判断表空间是否存在================================================================
Private Function IsExistTMP() As Boolean
    Dim rSt As New ADODB.Recordset
    IsExistTMP = False
   
    With rSt
        .CursorLocation = adUseClient
        .Open "select * from sys.dba_tablespaces where tablespace_name='CW_TSTMP'", _
            gloSys.cnnSys, adOpenStatic, adLockReadOnly
          If Not (.EOF And .BOF) Then
            IsExistTMP = True
        End If
        .Close
    End With
End Function
'========================================== end ==================================================================

Private Sub PreSetRecords(ByRef Cnn As ADODB.Connection)
    Dim i As Long
    Dim adoCmd As ADODB.Command
    Dim rstTemp As ADODB.Recordset
    Dim rstS As ADODB.Recordset, rstD As ADODB.Recordset
    Dim cnnMDB As ADODB.Connection
    Dim sSql As String
    Dim sValues() As String        '2002.06.26 add

    Dim rstMDB As New ADODB.Recordset

    Dim sTableName As String
    Dim bYear As Boolean
    Dim yField As String
    Dim lField As String
    
    Dim FirstLevelSubjectLength As Integer '一级科目的长度
    Dim iTemp As Integer
    
    Set adoCmd = New ADODB.Command
    adoCmd.ActiveConnection = Cnn
    adoCmd.CommandType = adCmdText
    
'二、预置记录
    '1:置入级数设置
    Set rstTemp = New ADODB.Recordset
    rstTemp.CursorLocation = adUseClient
    rstTemp.Open "select * from tUSU_DmJS", Cnn, adOpenStatic, adLockOptimistic
    With rstTemp
        For i = 1 To 5
            .AddNew
            .Fields("type").Value = "部门"
            .Fields("jc").Value = i
            .Fields("ws").Value = val(mfgCodeLevel.TextMatrix(3, i + 3))
            .Update
        Next i
        For i = 1 To 8
            .AddNew
            .Fields("type").Value = "科目"
            .Fields("jc").Value = i
            .Fields("ws").Value = val(mfgCodeLevel.TextMatrix(1, i + 3))
            .Update
        Next i
        For i = 1 To 2
            .AddNew
            .Fields("type").Value = "结算"
            .Fields("jc").Value = i
            .Fields("ws").Value = val(mfgCodeLevel.TextMatrix(2, i + 3))
            .Update
        Next i
        For i = 1 To 8
            .AddNew
            .Fields("type").Value = "项目"
            .Fields("jc").Value = i
            .Fields("ws").Value = val(mfgCodeLevel.TextMatrix(4, i + 3))
            .Update
        Next i
        For i = 1 To 5
            .AddNew
            .Fields("type").Value = "客户"
            .Fields("jc").Value = i
            .Fields("ws").Value = val(mfgCodeLevel.TextMatrix(5, i + 3))
            .Update
        Next i
        For i = 1 To 5