frmgrantbybank.frm

金算盘软件代码

            CreateFile False
            MousePointer = vbDefault
            Me.Hide
            Unload Me
    End Select
End Sub

'显示代发文件
Private Sub DispFile()
    Dim lngFileNum As Long
    Dim strTmp As String
    Dim strTxtTmp As String
    
    On Error Resume Next
    lngFileNum = FreeFile
    Open txtFile For Input As lngFileNum
    If Err Then
        If Err = 55 Then
            Close lngFileNum
            Open txtFile For Input As lngFileNum
            Err.Clear
        Else
            Exit Sub
        End If
    End If
    Do While Not EOF(lngFileNum)
        Line Input #lngFileNum, strTmp
        strTxtTmp = strTxtTmp & strTmp & Chr(13) & Chr(10)
    Loop
    txtPreView = strTxtTmp
    Close lngFileNum
    Kill txtFile
End Sub
'保存代发文件格式
Private Sub SaveFileFormat()
    Dim lngCnt As Long
    Dim strSql As String
    On Error GoTo HandleErr
    gclsBase.BaseWorkSpace.BeginTrans
    'gclsBase.BaseDB.Execute "DELETE BankField.* " _
    & "FROM Bank,BankField WHERE Bank.lngBankID=" & ltxtBank.ID _
    & "AND Bank.lngBankID=BankField.lngBankID"
    strSql = "DELETE FROM BankField WHERE BankField.lngBankID=" & ltxtBank.ID _
        & " AND BankField.lngBankID IN (SELECT Bank.lngBankID FROM Bank )"
    gclsBase.BaseDB.Execute strSql
    For lngCnt = 0 To 2
        WriteBankField ltxtBank.ID, grdData(lngCnt), lngCnt
    Next lngCnt
    WriteBank ltxtBank.ID
    gclsBase.BaseWorkSpace.CommitTrans
    Exit Sub
HandleErr:
    ShowMsg hwnd, "未知错误，不能保存代发文件格式。", vbInformation, Me.Caption
    gclsBase.BaseWorkSpace.RollBacktrans
End Sub

'将单位编号、文件名写入Bank表(入口：lngBankID 代发银行ID)
Private Sub WriteBank(ByVal lngBankID As Long)
    gclsBase.BaseDB.Execute "UPDATE Bank SET strFileName='" _
            & txtFile & "',strCustomerCode='" & txtCusNO _
            & "' WHERE lngBankID=" & lngBankID
    Set ltxtBank.Recordset = Nothing
    RefreshLtxt
    ltxtBank.SeekId lngBankID
End Sub

'将代发文件格式数据写入BankField表
'///////////////////////////////////////////////////////////////////////
'说明：
'    1、代发文件格式在BankField表中有三种类型。
'       BankField.strFieldType="0"、"1"、"2"时分别对应于
'       文件首记录、文件数据和文件尾记录。
'    2、根据"数据来源"、"标题名称"(仅限文件数据)的不同
'       情况写BankField表：
'    2.1 数据来源为空的行不保存。
'    2.2 对于文件数据，BankField.strFieldDesc采用标题名称(可为空) &
'        "(" & 数据来源 & ")"的格式保存。例如BankFieldField.strFieldDesc为
'        aaaaa(基本工资)，表示在代发文件中该项目的标题为aaaa,数据来源于基本
'        工资。又(职员姓名)则表示在代发文件中该项目无标题，数据来源于职员姓名
'    2.3 如果用户在"数据来源"中录入的内容不属于参照框的项目，一律视为常数。
'///////////////////////////////////////////////////////////////////////
'入口：lngBankID 代发银行ID
'      grdTmp 当前Grid
'      lngIndex Grid控件数组的索引(取0、1或2)
Private Sub WriteBankField(ByVal lngBankID As Long, grdTmp As MSFlexGrid, ByVal lngIndex As Long)
    Dim lngRow As Long
    Dim strSql As String
    Dim strSource As String
    Dim strFillStyle As String
    Dim varFieldSize As Variant
    Dim varFieldDec As Variant
    Dim recBankField As rdoResultset
    Dim recBank As rdoResultset
    Dim recTmp As rdoResultset
    Dim recFind As rdoResultset
    Dim i As Integer
    'strSQL = "SELECT ViewField.lngViewFieldID,strViewFieldDesc " _
        & "FROM ViewField,SalaryField WHERE ViewField.lng" _
        & "ViewFieldID=SalaryField.lngViewFieldID AND " _
        & "SalaryField.lngSalaryListID=" & Me.SalaryListID _
        & " UNION ALL SELECT lngViewFieldID,strViewFieldDesc" _
        & " FROM ViewField WHERE lngViewID=63" _
        & " AND blnIsFixed"
    strSql = "SELECT ViewField.lngViewFieldID,ViewField.strViewFieldDesc FROM ViewField,SalaryField " _
        & " WHERE ViewField.lngViewFieldID=SalaryField.lngViewFieldID " _
        & " AND SalaryField.lngSalaryListID=" & Me.SalaryListID _
        & " UNION ALL SELECT lngViewFieldID,strViewFieldDesc FROM ViewField " _
        & " WHERE lngViewID=63 AND blnIsFixed=1 "
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    strSql = "SELECT BankField.* FROM BankField "
    Set recBankField = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurRowVer, 64)
    With grdTmp
        For lngRow = 1 To .Rows - 1
            If (lngIndex = 0 And Trim(.TextMatrix(lngRow, 3)) <> "") Or _
            (lngIndex > 0 And Trim(.TextMatrix(lngRow, 2)) <> "") Then
                recBankField.AddNew
                recBankField!lngBankFieldID = BillPublic.GetNewID("BankField")
                recBankField!lngBankID = lngBankID
                recBankField!strFieldType = Choose(lngIndex + 1, 1, 0, 2)
                recBankField!lngBankFieldNO = lngRow
                recBankField!strDefault = " "
                If lngIndex = 0 Then
                    i = 4
                Else
                    i = 3
                End If
                Select Case .TextMatrix(lngRow, i)
                Case "数字"
                    recBankField!strDataType = "DOUBLE"
                Case "日期"
                    recBankField!strDataType = "DATE"
                Case Else
                    recBankField!strDataType = "STRING"
                End Select
                If lngIndex = 0 Then
                    recBankField!strFieldDesc = .TextMatrix(lngRow, 2) & "(" & _
                    .TextMatrix(lngRow, 3) & ")"
                Else
                    recBankField!strFieldDesc = .TextMatrix(lngRow, 2)
                End If
                strSource = .TextMatrix(lngRow, IIf(lngIndex = 0, 3, 2))
                If InStr(strSource, "求合计") > 0 Then
                    recBankField!strSource = "1"
                    strSource = Mid(strSource, 5, Len(strSource) - 5)
                    recBankField!lngViewFieldID = GetViewFieldID(strSource)
                Else
                    If strSource = "单位编号" Then
                        recBankField!strSource = "3"
                        recBankField!strDefault = txtCusNO.Text
                    ElseIf strSource = "当前年度" Then
                        recBankField!strSource = "3"
                        recBankField!strDefault = Year(gclsBase.BaseDate)
                    ElseIf strSource = "当前月份" Then
                        recBankField!strSource = "3"
                        recBankField!strDefault = Month(gclsBase.BaseDate)
                    ElseIf strSource = "当前日期" Then
                        recBankField!strSource = "3"
                        recBankField!strDefault = Day(gclsBase.BaseDate)
                    ElseIf strSource = "职员姓名" Then
                        recBankField!strSource = "3"
                        recBankField!strDefault = .TextMatrix(lngRow, 2)
                    ElseIf strSource = "工资帐号" Then
                        recBankField!strSource = "3"
                        recBankField!strDefault = .TextMatrix(lngRow, 2)
                    ElseIf strSource = "求人数" Then
                        recBankField!strSource = "2"
                    Else
                        strSql = "SELECT ViewField.lngViewFieldID,ViewField.strViewFieldDesc FROM ViewField,SalaryField " _
                            & " WHERE ViewField.lngViewFieldID=SalaryField.lngViewFieldID " _
                            & " AND SalaryField.lngSalaryListID=" & Me.SalaryListID _
                            & " AND ViewField.strViewFieldDesc='" & strSource & "'" _
                            & " UNION ALL SELECT lngViewFieldID,strViewFieldDesc FROM ViewField " _
                            & " WHERE lngViewID=63 AND blnIsFixed=1 AND ViewField.strViewFieldDesc='" & strSource & "'"
                        Set recFind = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                        If Not recFind.EOF Then
                            recBankField!strSource = "0"
                            recBankField!lngViewFieldID = recFind!lngViewFieldID
                        Else
                            recBankField!strSource = "3"
                            recBankField!strDefault = IIf(lngIndex = 0, .TextMatrix(lngRow, 3), .TextMatrix(lngRow, 2))
                        End If
                        recFind.Close
                        Set recFind = Nothing
                    End If
                End If
                varFieldSize = .TextMatrix(lngRow, IIf(lngIndex = 0, 5, 4))
                If IsNumeric(varFieldSize) Then
                    If varFieldSize <= 255 And varFieldSize > 0 Then
                        recBankField!bytFieldSize = varFieldSize
                    Else
                        recBankField!bytFieldSize = 16
                    End If
                Else
                    recBankField!bytFieldSize = 16
                End If
                
                varFieldDec = .TextMatrix(lngRow, IIf(lngIndex = 0, 6, 5))
                If IsNumeric(varFieldDec) Then
                    If varFieldDec <= 255 And varFieldDec > 0 Then
                        recBankField!bytFieldDec = varFieldDec
                    Else
                        recBankField!bytFieldDec = 0
                    End If
                Else
                    recBankField!bytFieldDec = 0
                End If
                
                If lngIndex = 0 Then
                    If .TextMatrix(lngRow, 7) = "是" Then
                        recBankField!blnIsDot = 1
                    Else
                        recBankField!blnIsDot = 0
                    End If
                Else
                    If .TextMatrix(lngRow, 6) = "是" Then
                        recBankField!blnIsDot = 1
                    Else
                        recBankField!blnIsDot = 0
                    End If
                End If
                
                If Trim(.TextMatrix(lngRow, IIf(lngIndex = 0, 8, 7))) <> "" Then
                    recBankField!strFillChar = Left(Trim(.TextMatrix(lngRow, IIf(lngIndex = 0, 8, 7))), 1)
                Else
                    recBankField!strFillChar = " "
                End If
                strFillStyle = .TextMatrix(lngRow, IIf(lngIndex = 0, 9, 8))
                recBankField!strFillStyle = IIf(strFillStyle = "左", 0, _
                IIf(strFillStyle = "右", 2, 1))
                
                If recBankField!strDefault = "" Then
                    recBankField!strDefault = " "
                End If
                If IsNull(.TextMatrix(lngRow, IIf(lngIndex = 0, 10, 9))) Then
                    recBankField!strCompartChar = " "
                Else
                    recBankField!strCompartChar = IIf(.TextMatrix(lngRow, IIf(lngIndex = 0, 10, 9)) = "", " ", .TextMatrix(lngRow, IIf(lngIndex = 0, 10, 9)))
                End If
                
                recBankField.Update
            End If
        Next lngRow
    End With
    
    recBankField.Close
    Set recBankField = Nothing
    recTmp.Close
    Set recTmp = Nothing
End Sub

'返回ViewFieldID
'入口：strSource 对应于strViewFieldDesc的字符串
'出口：ViewFieldID
Private Function GetViewFieldID(ByVal strSource As String) As Long
    Dim recViewField As rdoResultset
    Dim strSql As String
    strSql = "SELECT * FROM ViewField WHERE lngViewID=63 AND strViewFieldDesc='" & strSource & "'"
    Set recViewField = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With recViewField
        If .EOF Then
            GetViewFieldID = 0
            Exit Function
        End If
        GetViewFieldID = !lngViewFieldID
        .Close
    End With
    Set recViewField = Nothing
End Function

'生成并显示代发文件(blnIsDisplay是否进行文件预览)
Private Sub CreateFile(ByVal blnIsDisplay As Boolean)
    Dim lngFileNum As Long
    Dim i As Integer
    lngFileNum = FreeFile
    
    On Error GoTo HandleErr
    If FileExists Then
        If ShowMsg(hwnd, "文件" & txtFile & "已经存在，要覆盖它吗？", _
        vbQuestion + vbYesNo, Me.Caption) = vbYes Then
            If InStr(UCase(txtFile), ".GDB") > 0 Then
                If ShowMsg(hwnd, "文件" & txtFile & "为系统数据文件，覆盖后将可能导致难以预料的错误，要覆盖它吗？", _
                    vbQuestion + vbYesNo, Me.Caption) = vbYes Then
                    Open txtFile For Output As lngFileNum
                Else
                    With txtFile
                        .SelStart = 0
                        .SelLength = Len(.Text)
                        .SetFocus
                    End With
                    tabGrant.Tab = 0
                    Exit Sub
                End If
            Else
                Open txtFile For Output As lngFileNum
            End If
        Else
            With txtFile
                .SelStart = 0
                .SelLength = Len(.Text)
                .SetFocus
            End With
            tabGrant.Tab = 0
            Exit Sub
        End If
    Else
        For i = 0 To 10
            Close i
        Next i
        Open txtFile For Output As lngFileNum
    End If
    mblnIsTooLong = False
    SumEmployeeNO
    CreateFileHeadTail lngFileNum, "head"
    CreateFileBody lngFileNum
    CreateFileHeadTail lngFileNum, "tail"
    Close lngFileNum
    If blnIsDisplay Then
        DispFile
    End If
    Exit Sub
    
HandleErr:
    Select Case Err
        Case 52, 53
            tabGrant.Tab = 0
            ShowMsg hwnd, "错误的文件名，请重新录入。", _
            vbInformation, Me.Caption
            With txtFile
                .SelStart = 0
                .SelLength = Len(.Text)
                .SetFocus
            End With
        Case 55