item.bas

金算盘软件代码

'                End If
            End If
            strSQL = strSQL & " ORDER BY to_char(ItemActivity.lngReceiptTypeID) || to_char(ItemActivity.intYear) || to_Char(ItemActivity.bytPeriod) || to_char(ItemActivity.strReceiptNO) || to_char(ItemActivity.lngReceiptNO),ItemActivityDetail.lngRowID"
            Set recTemp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
            With recTemp
                intFileNum = FreeFile
                If Dir(GetFilePath(strPath) & "ItemActivity_" & intIndex & ".Dat") <> "" Then
                    Kill GetFilePath(strPath) & "ItemActivity_" & intIndex & ".Dat"
                End If
                Open GetFilePath(strPath) & "ItemActivity_" & intIndex & ".Dat" For Binary As #intFileNum
                Do While Not .EOF
                    strTemp = ""
                    For intCount = 0 To .rdoColumns.Count - 1
                        If intCount = 29 Then
                            strTemp = strTemp & BatchItemOutID2INCode(C2lng(IIf(IsNull(.rdoColumns(intCount)), "", .rdoColumns(intCount)))) & Chr(9)
                        Else
                            strTemp = strTemp & IIf(IsNull(.rdoColumns(intCount)), "" & Chr(9), .rdoColumns(intCount) & Chr(9))
                        End If
                    Next
                    strTemp = strTemp & Chr(13) & Chr(10)
                    Put #intFileNum, , strTemp
                    .MoveNext
                Loop
                Close #intFileNum
            End With
        Case 29
        '商品调价单
            strTemp = "文件名=ItemActivity_" & intIndex & ".dat" & Chr(0) & "字段数=34"
            strTemp = strTemp & Chr(0) & "字段1=单据类型,1,1"
            strTemp = strTemp & Chr(0) & "字段2=业务类型,2,1"
            strTemp = strTemp & Chr(0) & "字段3=会计年度,3,1"
            strTemp = strTemp & Chr(0) & "字段4=会计期间,4,1"
            strTemp = strTemp & Chr(0) & "字段5=单据号,5,2"
            strTemp = strTemp & Chr(0) & "字段6=制单日期,6,2"
            strTemp = strTemp & Chr(0) & "字段7=职员,7,2"
            strTemp = strTemp & Chr(0) & "字段8=部门,8,2"
            strTemp = strTemp & Chr(0) & "字段9=汇率,9,5"
            strTemp = strTemp & Chr(0) & "字段10=币种,10,2"
            strTemp = strTemp & Chr(0) & "字段11=项目,11,2"
            strTemp = strTemp & Chr(0) & "字段12=统计,12,2"
            strTemp = strTemp & Chr(0) & "字段13=作废,13,2"
            strTemp = strTemp & Chr(0) & "字段14=备注,14,2"
            strTemp = strTemp & Chr(0) & "字段15=行号,15,4"
            strTemp = strTemp & Chr(0) & "字段16=商品,16,2"
            strTemp = strTemp & Chr(0) & "字段17=计量单位,17,2"
            strTemp = strTemp & Chr(0) & "字段18=数量,18,5"
            strTemp = strTemp & Chr(0) & "字段19=原价,19,5"
            strTemp = strTemp & Chr(0) & "字段20=现价,20,5"
            strTemp = strTemp & Chr(0) & "字段21=金额,21,5"
            strTemp = strTemp & Chr(0) & "字段22=税率,22,2"
            strTemp = strTemp & Chr(0) & "字段23=税额,23,2"
            strTemp = strTemp & Chr(0) & "字段24=自定义项目0,24,2"
            strTemp = strTemp & Chr(0) & "字段25=自定义项目1,25,2"
            strTemp = strTemp & Chr(0) & "字段26=自定义项目2,26,2"
            strTemp = strTemp & Chr(0) & "字段27=自定义项目3,27,2"
            strTemp = strTemp & Chr(0) & "字段28=自定义项目4,28,2"
            strTemp = strTemp & Chr(0) & "字段29=自定义项目5,29,2"
            strTemp = strTemp & Chr(0) & "字段30=成本差异,31,5"
            strTemp = strTemp & Chr(0) & "字段31=成本金额,32,5"
            strTemp = strTemp & Chr(0) & "字段32=制单人,32,2"
            strTemp = strTemp & Chr(0) & "字段33=模板,33,2"
            strTemp = strTemp & Chr(0) & "字段34=待打印标志,34,3"
            strTemp = strTemp & Chr(0) & "导出日期=" & Format(Date, "yyyy-mm-dd")
            
            lngResult = WritePrivateProfileSection(ReceiptType(intIndex).strReceiptTypeName, strTemp, strPath)
            strSQL = "SELECT ItemActivity.lngReceiptTypeID, ItemActivity.lngActivityTypeID, ItemActivity.intYear, " & _
            "ItemActivity.bytPeriod, LTRIM(ItemActivity.strReceiptNO || LTRIM(TO_CHAR(ItemActivity.lngReceiptNO,'0000'))), " & _
            "ItemActivity.strDate, Employee.strEmployeeCode, " & _
            "Department.strDepartmentCode, ItemActivity.dblRate, " & _
            "Currencys.strCurrencyCode, Class2.strClassCode, Class1.strClassCode, " & _
            "ItemActivity.blnIsVoid, ItemActivity.strNote, " & _
            "ItemActivityDetail.lngRowID, Item.strItemCode, "
            strSQL = strSQL & _
            "ItemUnit.strUnitName, " & _
            "ItemActivityDetail.dblQuantity, ItemActivityDetail.dblCurrPrice, " & _
            "ItemActivityDetail.dblCurrNewPrice, " & _
            "ItemActivityDetail.dblAmount," & _
            "Tax.strTaxName,ItemActivityDetail.dblCurrTaxAmount," & _
            "Custom0.strCustomCode, Custom1.strCustomCode, " & _
            "Custom2.strCustomCode, Custom3.strCustomCode, Custom4.strCustomCode, Custom5.strCustomCode, " & _
            "ItemActivityDetail.dblCostDiff, " & _
            "ItemActivityDetail.dblCostAmount,Operator.strOperatorName,Template.strTemplateName,ItemActivity.blnIsPrint "
            strSQL = strSQL & " FROM ItemActivity,ItemActivityDetail," & _
            "Employee,Department,Currencys,Class2,Class1,Item,Position,ItemUnit,Tax,Operator,Template,Custom0,Custom1,Custom2,Custom3,Custom4,Custom5 "
            strSQL = strSQL & " WHERE (((((((((((((((((  " & _
            "ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID) AND " & _
            "ItemActivity.lngEmployeeID = Employee.lngEmployeeID(+)) AND  " & _
            "ItemActivity.lngDepartmentID = Department.lngDepartmentID(+)) AND " & _
            "ItemActivity.lngCurrencyID = Currencys.lngCurrencyID) AND " & _
            "ItemActivity.lngClassID2 = Class2.lngClassID(+)) AND  " & _
            "ItemActivity.lngClassID1 = Class1.lngClassID(+)) AND "
            strSQL = strSQL & "ItemActivityDetail.lngItemID = Item.lngItemID) AND " & _
            "ItemActivityDetail.lngPositionID = Position.lngPositionID(+)) AND " & _
            "ItemActivityDetail.lngUnitID = ItemUnit.lngUnitID(+)) AND " & _
            "ItemActivityDetail.lngTaxID = Tax.lngTaxID(+)) AND " & _
            "ItemActivity.lngOperatorID = Operator.lngOperatorID(+)) AND " & _
            "ItemActivity.lngTemplateID = Template.lngTemplateID(+)) AND " & _
            "ItemActivityDetail.lngCustomID0 = Custom0.lngCustomID(+)) AND " & _
            "ItemActivityDetail.lngCustomID1 = Custom1.lngCustomID(+)) AND " & _
            "ItemActivityDetail.lngCustomID2 = Custom2.lngCustomID(+)) AND " & _
            "ItemActivityDetail.lngCustomID3 = Custom3.lngCustomID(+)) AND " & _
            "ItemActivityDetail.lngCustomID4 = Custom4.lngCustomID(+)) AND " & _
            "ItemActivityDetail.lngCustomID5 = Custom5.lngCustomID(+) AND "

            strSQL = strSQL & "(ItemActivity.lngReceiptTypeID)=" & intIndex
            If Trim(strWhere) <> "" Then
                strSQL = strSQL & " AND ItemActivity.lngActivityID IN " & strWhere
            End If
            strSQL = strSQL & " ORDER BY ItemActivity.lngActivityID,ItemActivityDetail.lngRowID"
            
            Set recTemp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
            With recTemp
                intFileNum = FreeFile
                If Dir(GetFilePath(strPath) & "ItemActivity_" & intIndex & ".Dat") <> "" Then
                    Kill GetFilePath(strPath) & "ItemActivity_" & intIndex & ".Dat"
                End If
                Open GetFilePath(strPath) & "ItemActivity_" & intIndex & ".Dat" For Binary As #intFileNum
                Do While Not .EOF
                    strTemp = ""
                    For intCount = 0 To .rdoColumns.Count - 1
                        strTemp = strTemp & IIf(IsNull(.rdoColumns(intCount)), "" & Chr(9), .rdoColumns(intCount) & Chr(9))
                    Next
                    strTemp = strTemp & Chr(13) & Chr(10)
                    Put #intFileNum, , strTemp
                    .MoveNext
                Loop
                Close #intFileNum
            End With
    End Select
    ActivityExport1 = True
    Exit Function
errhandel:
    ActivityExport1 = False
End Function

'修改某张单据时，同时处理与本单据相关的对应业务类型的记录
'这里，修改的是使用记录(ItemActivityDeltail_Del) 改变的是源记录(ItemActivityDetail)
Private Function BatchItemOutID2INCode(ByVal lngID As Long) As String
    Dim strSQL As String
    Dim recTmp As rdoResultset
    
    strSQL = "SELECT ItemActivity.lngReceiptTypeID,ItemActivity.lngActivityTypeID, ItemActivity.intYear, ItemActivity.bytPeriod, ItemActivity.strReceiptNO," & _
        "ItemActivity.lngReceiptNO, ItemActivityDetail.lngRowID " & _
        "FROM PositionItemDetail,ItemActivityDetail,ItemActivity " & _
        "WHERE ItemActivityDetail.lngActivityID = ItemActivity.lngActivityID AND PositionItemDetail.lngInActivityDetailID =" & _
        "ItemActivityDetail.lngActivityDetailID AND PositionItemDetail.lngINActivityDetailID<>0 AND PositionItemDetail.lngOutActivityDetailID=" & lngID
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenForwardOnly)
    If recTmp.BOF And recTmp.EOF Then
        BatchItemOutID2INCode = ""
    Else
        BatchItemOutID2INCode = CStr(recTmp(0)) & "," & CStr(recTmp(1)) & "," & CStr(recTmp(2)) & "," & CStr(recTmp(3)) & "," & recTmp(4) & "," & CStr(recTmp(5)) & "," & CStr(recTmp(6))
    End If
    recTmp.Close
    Set recTmp = Nothing
End Function

Public Function AfterHaveActivity(ByVal ItemID As Long, ByVal strDate As String, Optional ByVal lngActivityID As Long = 0) As Boolean
    '判断某商品某日及以后是否有业务发生(本张单据除外）
    '有---TRUE
    '无---FALSE
    Dim recTmp As rdoResultset
    Dim strSQL As String
    On Error GoTo ErrHandle
    If ItemID = 0 Then GoTo ErrHandle
    strDate = Format$(strDate, "yyyy-mm-dd")
    strSQL = "SELECT ItemActivity.lngActivityID " & _
           "FROM ItemActivity ,ItemActivityDetail " & _
           "WHERE rownum<=1 AND ItemActivity.blnIsVoid=0" & _
           " AND ItemActivity.lngReceiptTypeID NOT IN (3,5,7,8,14,16,19,20,22,26)" & _
           " AND ItemActivity.lngActivityID=ItemActivityDetail.lngActivityID" & _
           " AND ItemActivityDetail.lngItemID= " & ItemID & _
           " AND ItemActivity.strDate>='" & strDate & "'"
    If lngActivityID > 0 Then
        strSQL = strSQL & " AND ItemActivity.lngActivityID<>" & lngActivityID
    End If
    
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
    If recTmp.EOF And recTmp.BOF Then
        AfterHaveActivity = False
    Else
        AfterHaveActivity = True
    End If
    recTmp.Close
    Set recTmp = Nothing
    Exit Function
ErrHandle:
        AfterHaveActivity = False
End Function
Public Function FindLastAdjustPrice(ByVal ItemID As Long, ByVal lngActivityID As Long, strDate As String) As Double
    '找出最后一张调价单的日期及其新价(本张单据除外）
    '有---TRUE
    '无---FALSE
    Dim recTmp As rdoResultset
    Dim strSQL As String
    On Error GoTo ErrHandle
    If ItemID = 0 Then GoTo ErrHandle
    strDate = Format$(strDate, "yyyy-mm-dd")
    strSQL = "SELECT ItemActivity.strDate,ItemActivityDetail.dblCurrNewPrice " & _
           "FROM ItemActivity, ItemActivityDetail " & _
           "WHERE rownum<=1 and ItemActivity.blnIsVoid=0 AND ItemActivity.lngActivityID=ItemActivityDetail.lngActivityID and ItemActivityDetail.lngItemID= " & ItemID & _
           " AND ItemActivity.lngReceiptTypeId =29  AND ItemActivity.lngActivityID<>" & lngActivityID & _
           " ORDER BY strDate DESC "
    
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
    If recTmp.EOF And recTmp.BOF Then
        FindLastAdjustPrice = -1
        strDate = ""
    Else
        strDate = Format(recTmp!strDate, "yyyy-mm-dd")
        FindLastAdjustPrice = recTmp!dblCurrNewPrice
    End If
    recTmp.Close
    Set recTmp = Nothing
    Exit Function
ErrHandle:
        FindLastAdjustPrice = -1
        strDate = ""
End Function

Public Function AfterNowBillHaveActivity(ByVal lngActivityID) As Boolean
    '判断某调价单以后是否有业务发生(本张单据除外）
    '有---TRUE
    '无---FALSE
    Dim ItemID As Long, strDate As String
    Dim recTmp As rdoResultset
    Dim strSQL As String
    AfterNowBillHaveActivity = False
    On Error GoTo ErrHandle
    strSQL = "SELECT ItemActivityDetail.lngItemID,ItemActivity.strDate,ItemActivity.blnIsVoid " & _
           "FROM ItemActivity,ItemActivityDetail " & _
           "WHERE ItemActivity.lngActivityID=ItemActivityDetail.lngActivityID" & _
           " AND ItemActivity.lngActivityID=" & lngActivityID
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
    If recTmp.EOF And recTmp.BOF Then
        AfterNowBillHaveActivity = False
    ElseIf recTmp(2) <> 0 Then
        AfterNowBillHaveActivity = False
    Else
        Do While recTmp.EOF = False
            ItemID = recTmp!lngItemID
            strDate = Format$(recTmp!strDate, "yyyy-mm-dd")
            If AfterHaveActivity(ItemID, strDate, lngActivityID) = True Then
                AfterNowBillHaveActivity = True
                Exit Do
            End If
            recTmp.MoveNext
        Loop
    End If
    recTmp.Close
    Set recTmp = Nothing
    Exit Function
ErrHandle:
End Function