frmtl_restores.frm

来自「一个用VB写的财务软件源码」· FRM 代码 · 共 871 行 · 第 1/2 页

        End If
        For j = 0 To UBound(aryValidFile1)
            If lSt.ListCount > 0 Then
                m_aryPath(iPosBound + 1 + j).sPath = txtPath.text
                m_aryPath(iPosBound + 1 + j).sFile = aryValidFile1(j)
            Else
                m_aryPath(iPosBound + j).sPath = txtPath.text
                m_aryPath(iPosBound + j).sFile = aryValidFile1(j)
            End If
        Next j
        For j = 0 To UBound(aryValidFile1)
            lSt.AddItem aryValidFile1(j)
            lSt.Refresh
        Next j
        Call isComSelect(bYhdz, bCustomer, bItem, bVendor, sString)
        lblMemo.Caption = IIf(sString = "", "提示：" & vbCrLf & _
            "选择的文件齐全，可以进入下一步操作！", "提示:" & vbCrLf & sString)
        lblMemo.Refresh
    End If
    
    If sExistFile <> "" Then
        sExistFile = Mid(sExistFile, 1, Len(sExistFile) - 1)
        MsgBox sExistFile & "文件已经存在", vbInformation, "提示"
    End If
    If sValidFile <> "" Then
        sValidFile = Mid(sValidFile, 1, Len(sValidFile) - 1)
        MsgBox sValidFile & "文件格式错误！", vbInformation, "提示"
    End If
    Exit Sub
errhandler:
    Exit Sub
End Sub

Private Sub cmdDelete_Click()
    Dim bYhdz As Boolean
    Dim bCustomer As Boolean
    Dim bItem As Boolean
    Dim bVendor As Boolean
    Dim sString As String
    Dim i As Integer
    Dim iPos As Integer
    If lSt.ListCount > 0 Then
        If lSt.ListIndex = -1 Then
            MsgBox "请选择要删除的文件！", vbInformation, "提示"
            Exit Sub
        End If
        For i = 0 To UBound(m_aryPath)
            If m_aryPath(i).sFile = lSt.List(lSt.ListIndex) Then
                iPos = i
                Exit For
            End If
        Next i
        
        For i = iPos To UBound(m_aryPath) - 1
            m_aryPath(i).sFile = m_aryPath(i + 1).sFile
            m_aryPath(i).sPath = m_aryPath(i + 1).sPath
        Next i
        If UBound(m_aryPath) > 0 Then
            ReDim Preserve m_aryPath(UBound(m_aryPath) - 1)     '移除最后一个数据
        Else
            ReDim m_aryPath(0)
        End If
        If lSt.ListCount > 0 Then
           lSt.RemoveItem lSt.ListIndex
        End If
        
        lSt.Refresh
        If lSt.ListCount > 0 Then
            lSt.Selected(0) = True
        Else
            txtLine.text = ""
        End If
        If lSt.ListCount > 0 Then
            Call isComSelect(bYhdz, bCustomer, bItem, bVendor, sString)
            lblMemo.Caption = IIf(sString = "", "提示：" & _
                vbCrLf & "选择的文件齐全，可以进入下一步操作！", "提示:" & _
                vbCrLf & sString)
            lblMemo.Refresh
        Else
            lblMemo.Caption = "提示：" & vbCrLf & "请选择恢复表的备份文件！"
        End If
    End If
End Sub


Private Sub cmdNext1_Click()
Dim i As Integer
Dim bYhdz As Boolean
Dim bCustomer As Boolean
Dim bItem As Boolean
Dim bVendor As Boolean
Dim sString As String
If lSt.ListCount > 0 Then
    Call isComSelect(bYhdz, bCustomer, bItem, bVendor, sString)
    If bYhdz And bCustomer And bItem And bVendor Then
    Else
        MsgBox "请看提示，将漏选的表所对应的备份文件添加到文件列表中！", _
            vbInformation, "提示"
        Exit Sub
    End If
Else
    MsgBox "没有相应的恢复文件！", vbInformation, "提示"
    Exit Sub
End If

cmdOk.Enabled = True
lblMsg.Visible = False
sTb.Tab = 1
    
End Sub
Private Sub isComSelect(ByRef bYhdz As Boolean, ByRef bCustomer As Boolean, _
    ByRef bItem As Boolean, ByRef bVendor As Boolean, ByRef sString As String)
Dim i As Integer
Dim iYhdz  As Integer
Dim iCustomer As Integer
Dim iItem As Integer
Dim iVendor As Integer

Dim sTemp As String
Dim lMonth As Long
Dim sTable As String


iYhdz = 0
iCustomer = 0
iItem = 0
iVendor = 0
bYhdz = False
bCustomer = False
bItem = False
bVendor = False
For i = 0 To UBound(m_aryPath)
    If ReadTextHead(m_aryPath(i).sPath & "\" & m_aryPath(i).sFile, _
        lMonth, sTemp, sTable) Then
        If UCase(sTable) Like "TZW_YHDZ*" Then
            iYhdz = iYhdz + 1
        End If
        If UCase(sTable) Like "TZW_CUSTOMER*" Then
            iCustomer = iCustomer + 1
        End If
        If UCase(sTable) Like "TZW_ITEM*" Then
            iItem = iItem + 1
        End If
        If UCase(sTable) Like "TZW_VENDOR*" Then
            iVendor = iVendor + 1
        End If
    End If
Next i
sString = ""
If iYhdz = 0 Or iYhdz = 2 Then
    bYhdz = True
Else
    sString = sString & "“" & glo.sOperateYear & _
        "银行对账单”与“银行对账启用日期”必须同时恢复;" & vbCrLf
End If
If iCustomer = 0 Or iCustomer = 2 Then
    bCustomer = True
Else
    sString = sString & "“客户档案表”与“客户分类表”必须同时恢复;" & vbCrLf
End If
If iItem = 0 Or iItem = 2 Then
    bItem = True
Else
    sString = sString & "“项目档案表”与“项目分类表”必须同时恢复;" & vbCrLf
End If
If iVendor = 0 Or iVendor = 3 Then
    bVendor = True
Else
    sString = sString & "“供应商档案”、“供应商分类”与“供应商设置”必须同时恢复;"
End If

End Sub

Private Sub cboYear_Click()
Call FillTable
End Sub


Private Sub cmdCancel1_Click()
Unload Me
End Sub

Private Sub cmdCancel2_Click()
Unload Me
End Sub

Private Sub cmdOk_Click()
Dim i As Integer
Dim sTemp As String
Dim lMonth As Long
Dim sTable As String
Dim sSQL As String
Dim sPath As String
lblMsg.Visible = True
lblMsg.Refresh
cmdOk.Enabled = False
cmdPrevious2.Enabled = False
cmdCancel2.Enabled = False
cmdPrevious2.Refresh
cmdCancel2.Refresh
cmdOk.Refresh

For i = 0 To UBound(m_aryPath)
    sPath = m_aryPath(i).sPath & "\" & m_aryPath(i).sFile
    If ReadTextHead(sPath, lMonth, sTemp, sTable) Then
        If lMonth = 0 Then
            sSQL = "Delete from " & sTable
        Else
            sSQL = "Delete from " & sTable & " where kjqj=" & lMonth
        End If
        If DeleteRecord(sSQL, sTable, glo.cnnMain, lMonth) Then
            Call Import(sTable, glo.cnnMain, sPath, g_FLAT, lMonth)
        End If
    End If
Next i
lblMsg.Caption = "提示：数据恢复结束！"
'ReDim m_aryPath(0)
cmdPrevious2.Enabled = True
cmdCancel2.Enabled = True

End Sub


Private Sub cmdPrevious2_Click()
lstResult.ListItems.Clear
lstResult.Refresh
lblMsg.Caption = "提示:正在恢复数据，请等候......"
lblMsg.Visible = False
cmdOk.Enabled = True
sTb.Tab = 0
End Sub

'读已经打开的数据备份文件的前几行标题,
'根据标题的特性来判断打开文件的正确性。
'函数本身返回布尔型值，即文件打开的正确性，参数将当初备份的基本信息传出。
Private Function ReadTextHead(ByVal sFile As String, ByRef lMonth As Long, ByRef sStr As String, ByRef sTable As String) As Boolean
    Dim iFileNum As Integer
    Dim lLineCount As Long
    Dim sLine As String
    Dim sTemp As String
    Dim sTempValue As String
    Dim aryTemp() As String
    Dim sMonNum As String
    Dim i As Integer
    Dim iPos As Integer
    
    sTemp = ""
    sTempValue = ""
    lMonth = 0
    sStr = ""
    sTable = ""
    iFileNum = FreeFile()
    Open sFile For Input As #iFileNum
    lLineCount = 0
    Do Until EOF(iFileNum)
        Line Input #iFileNum, sLine
        iPos = InStr(1, sLine, "备份", vbTextCompare)
        If iPos > 0 Then
            sTemp = ""
            If InStr(1, sLine, "[Memo]", vbTextCompare) > 0 Then
                aryTemp() = Split(sLine, vbTab)
                sTemp = Space(2) & Mid(aryTemp()(0), iPos) & Trim(aryTemp()(1)) & vbCrLf & Space(2) & Trim(aryTemp()(2)) & Mid(Trim(aryTemp()(3)), 1, 11) & vbCrLf & Space(10) & Mid(Trim(aryTemp()(3)), 12)
            Else
                If InStr(1, sLine, "[Month]") > 0 Then
                    sMonNum = Trim(Mid(sLine, iPos + 6, 2))
                    If IsNumeric(sMonNum) Then
                        lMonth = CLng(sMonNum)
                    Else
                        lMonth = CLng(Mid(sMonNum, 1, 1))
                    End If
                End If
                sTemp = Space(2) & Mid(sLine, iPos, 5) & Trim(Mid(sLine, iPos + 6))
            End If
            sTempValue = sTempValue & sTemp & vbCrLf
            lLineCount = lLineCount + 1
        ElseIf InStr(1, sLine, "TF") > 0 Then
            sTable = Mid(sLine, 5, InStr(5, sLine, "(") - 5)
        Else
            Exit Do
        End If
    Loop
    Close #iFileNum

    If lLineCount > 1 And sTempValue <> "" Then
        ReadTextHead = True
        sStr = sTempValue
    Else
        ReadTextHead = False
        sStr = ""
    End If

End Function

Private Sub form_load()
ReDim m_aryPath(0)
Dim i As Integer
    lblMsg.Caption = "提示:正在恢复数据，请等候......"
    lblMsg.Visible = False
    lstResult.View = lvwList
    lstResult.ListItems.Clear
    lstResult.Refresh
    Call FillTable
    lblMemo.Caption = "提示：" & vbCrLf & "请选择恢复表的备份文件！"
    sTb.Tab = 0
End Sub
Private Sub FillTable()
Dim i As Integer
    m_aryItem(0) = glo.sOperateYear & "年会计科目表.txt"
    m_aryItem(1) = glo.sOperateYear & "年累计数据表.txt"
    m_aryItem(2) = glo.sOperateYear & "年辅助核算表.txt"
    m_aryItem(3) = glo.sOperateYear & "年支票登记表.txt"
    m_aryItem(4) = glo.sOperateYear & "年银行对账单.txt"
    m_aryItem(5) = "银行对账启用日期.txt"
    m_aryItem(6) = glo.sOperateYear & "客户档案表.txt"
    m_aryItem(7) = glo.sOperateYear & "客户分类表.txt"
    m_aryItem(8) = glo.sOperateYear & "项目档案表.txt"
    m_aryItem(9) = glo.sOperateYear & "项目分类表.txt"
    m_aryItem(10) = glo.sOperateYear & "供应商档案.txt"
    m_aryItem(11) = glo.sOperateYear & "供应商分类.txt"
    m_aryItem(12) = glo.sOperateYear & "供应商设置.txt"
    m_aryItem(13) = "摘要维护表.txt"
    m_aryItem(14) = glo.sOperateYear & "部门维护表.txt"
    For i = 15 To 26
        m_aryItem(i) = glo.sOperateYear & "年_" & (i - 14) & "月份凭证.txt"
    Next i
End Sub
Private Function DeleteRecord(ByVal sSQL As String, ByVal sTable As String, _
    ByVal sConn As ADODB.Connection, ByVal lMonth As Long) As Boolean
Dim adoCmd As New ADODB.Command
DeleteRecord = False
On Error GoTo errhandle
With adoCmd
    .ActiveConnection = sConn
    .CommandType = adCmdText
    .CommandText = sSQL
    .Execute
    DeleteRecord = True
End With
Exit Function
errhandle:
    DeleteRecord = False
    If lMonth = 0 Then
        lstResult.ListItems.Add , , sTable & "表恢复失败！"
    Else
        lstResult.ListItems.Add , , sTable & "表" & lMonth & "月份凭证恢复失败！"
    End If
    lstResult.Refresh
    Exit Function
End Function
Private Sub Import(ByVal sTableName As String, ByVal sConn As ADODB.Connection, ByVal sFilePath As String, ByVal sVersion As String, ByVal lMonth As Long)
        Dim i As Long
        Dim sLine As String
        Dim sTable, sValues As String
        Dim adoCmd As ADODB.Command
        Dim located As Integer
        '文件记录变量
        Dim iFileNum As Integer
        
        Set adoCmd = New ADODB.Command
            adoCmd.ActiveConnection = sConn
            adoCmd.CommandType = adCmdText
        sConn.BeginTrans
        On Error GoTo HandleError
       
        If sConn.State <> 1 Then
           sConn.Open
        End If
       
        iFileNum = FreeFile()
        Open sFilePath For Input As #iFileNum
        Do Until EOF(iFileNum)
            Line Input #iFileNum, sLine
            If Len(sLine) > 0 Then
                If InStr(1, sLine, "备份") > 0 And InStr(1, sLine, "[") > 0 Then
                              '不作处理，跳过
                ElseIf UCase$(Left$(sLine, 2)) = "TF" Then
                    sTable = Mid$(sLine, 4)
                    sTable = Replace(sTable, vbTab, ",")
                    sTable = Mid(sTable, 1, Len(sTable) - 2) & ")"
                Else
                    sValues = Replace(sLine, vbTab, ",")
                    sValues = Left$(sValues, Len(sValues))
                    
                    If UCase(sVersion) = "SQL" Then
                        located = InStr(1, sValues, "to_date", 1)
                       If located > 0 Then
                            sValues = Replace(sValues, "to_date(", "")
                            sValues = Replace(sValues, ",'yyyy-mm-dd')", "")
                       End If
                    End If
                    sValues = Mid(sValues, 1, Len(sValues) - 1)
                    adoCmd.CommandText = "INSERT INTO " & sTable & " VALUES(" & sValues & ")"
                    adoCmd.Execute
                End If
            End If
        Loop
        sConn.CommitTrans
        Close #iFileNum
        If lMonth = 0 Then
            lstResult.ListItems.Add , , sTableName & "表恢复成功！"
        Else
            lstResult.ListItems.Add , , sTableName & "表" & lMonth & "月份凭证恢复成功！"
        End If
        lstResult.Refresh
        Exit Sub
HandleError:
    If lMonth = 0 Then
        lstResult.ListItems.Add , , sTableName & "表恢复失败！"
    Else
        lstResult.ListItems.Add , , sTableName & "表" & lMonth & "月份凭证恢复失败！"
    End If
    lstResult.Refresh
    Err.Clear
    sConn.RollbackTrans
    Close #iFileNum
    Exit Sub
End Sub

Private Sub lSt_Click()
Dim sTemp As String
Dim lMonth As Long
Dim sTable As String
Dim i As Integer
For i = 0 To UBound(m_aryPath)
    If m_aryPath(i).sFile = lSt.List(lSt.ListIndex) Then
        If ReadTextHead(m_aryPath(i).sPath & "\" & m_aryPath(i).sFile, _
            lMonth, sTemp, sTable) Then
             txtLine.text = "注意：" & vbCrLf & sTemp
             txtLine.Refresh
        End If
        Exit For
    End If
Next i
End Sub