unit stgGather; interface uses Classes, stgGatherCacheData, ProjectData, BillsTree, sdIDTree; type TstgSumBaseFileLoader = class private FTree: TstgGatherTree; FSumBaseFile: string; FTempFolder: string; FFileName: string; FProjectData: TProjectData; procedure LoadFileName; function LoadTreeNodeData(ANode: TBillsIDTreeNode; AParent: TstgGatherTreeNode): TstgGatherTreeNode; procedure LoadSumBaseTreeNode(ANode: TsdIDTreeNode; AParent: TstgGatherTreeNode); public constructor Create(ATree: TstgGatherTree; const ASumBaseFile: string); destructor Destroy; override; procedure LoadData; end; TstgSubTenderFileGather = class private FCacheData: TstgGatherCacheData; FProjectData: TProjectData; FCurSubTenderID: Integer; procedure GatherDetailData(AGatherNode: TstgGatherTreeNode; ASourceNode: TMeasureBillsIDTreeNode); function GatherSubTenderTreeNodeData(ANode: TsdIDTreeNode; AParent: TstgGatherTreeNode): TstgGatherTreeNode; procedure GatherSubTenderTreeNode(ANode: TsdIDTreeNode; AParent: TstgGatherTreeNode); procedure GatherSubTender(ASubTenderID: Integer); public procedure GatherTo(AGatherCacheData: TstgGatherCacheData; ASubTenders: TList); end; TstgErrorChecker = class private FCacheData: TstgGatherCacheData; procedure NewError(ANode: TstgGatherTreeNode; AType: Integer); function SafeCheckParent(ANode, ACheckParent: TstgGatherTreeNode): TstgGatherTreeNode; // ACheckParent的子项(总包中存在),存在与ANode同编号节点 function HasSameCodeLevelChild(ANode: TstgGatherTreeNode; ACheckParent: tstgGatherTreeNode = nil): Boolean; // ACheckParent的子项(总包中存在),存在与ANode同编号、名称、单位,但不同层次节点 function HasSameChildWithDiffLevel(ANode: TstgGatherTreeNode; ACheckParent: TstgGatherTreeNode = nil): Boolean; // ACheckParent的子项(总包中存在)(含子项的子项),存在与ANode同编号节点 // 子项(含子项的子项),存在与CheckParent的子项(总包中存在)同编号节点 function HasShortRelaCodeChild(ANode: TstgGatherTreeNode): Boolean; function HasLongRelaCodeChild(ANode:TstgGatherTreeNode): Boolean; function HasXmjChildWithSameCodeChild(ANode: TstgGatherTreeNode): Boolean; procedure AddXmjError(ANode: TstgGatherTreeNode); procedure AddGclError(ANode: TstgGatherTreeNode); procedure AddError(ANode: TstgGatherTreeNode); public procedure Check(AGatherCacheData: TstgGatherCacheData); end; implementation uses Math, Globals, mDataRecord, UtilMethods, SysUtils, XMLDoc, XMLIntf, CacheTree; { TstgSumBaseFileLoader } constructor TstgSumBaseFileLoader.Create(ATree: TstgGatherTree; const ASumBaseFile: string); begin FTree := ATree; FSumBaseFile := ASumBaseFile; FTempFolder := GenerateTempFolder(GetTempFilePath); FProjectData := TProjectData.Create; end; destructor TstgSumBaseFileLoader.Destroy; begin if FileExists(FTempFolder) then DeleteFolder(FTempFolder); if Assigned(FProjectData) then FProjectData.Free; inherited; end; procedure TstgSumBaseFileLoader.LoadData; begin UnZipFile(FSumBaseFile, FTempFolder); LoadFileName; FProjectData.OpenForSumUpBase(FTempFolder + '\' + FFileName); LoadSumBaseTreeNode(FProjectData.BillsCompileData.BillsCompileTree.FirstNode, nil); FTree.MarkLeafXmj; end; procedure TstgSumBaseFileLoader.LoadFileName; var FXmlDocument: IXMLDocument; RootXmlNode, InfoXmlNode: IXMLNode; ChildNodes: IXMLNodeList; begin FXmlDocument := TXMLDocument.Create(nil) as IXMLDocument; try FXmlDocument.LoadFromFile(FTempFolder + '\Info.xml'); FXmlDocument.Options := [doNodeAutoCreate,doNodeAutoIndent,doAutoPrefix,doNamespaceDecl]; RootXmlNode := FXmlDocument.DocumentElement; ChildNodes := RootXmlNode.ChildNodes; InfoXmlNode := ChildNodes.FindNode('ProjectInfo'); FFileName := InfoXmlNode.Attributes['FileName']; finally FXmlDocument := nil; end; end; procedure TstgSumBaseFileLoader.LoadSumBaseTreeNode(ANode: TsdIDTreeNode; AParent: TstgGatherTreeNode); var vCurGatherNode: TstgGatherTreeNode; begin if not Assigned(ANode) then Exit; vCurGatherNode := LoadTreeNodeData(TBillsIDTreeNode(ANode), AParent); LoadSumBaseTreeNode(ANode.FirstChild, vCurGatherNode); LoadSumBaseTreeNode(ANode.NextSibling, AParent); end; function TstgSumBaseFileLoader.LoadTreeNodeData(ANode: TBillsIDTreeNode; AParent: TstgGatherTreeNode): TstgGatherTreeNode; begin Result := FTree.AddSumBaseNode(AParent, ANode.ID); Result.Code := ANode.Rec.Code.AsString; Result.B_Code := ANode.Rec.B_Code.AsString; Result.Name := ANode.Rec.Name.AsString; Result.Units := ANode.Rec.Units.AsString; end; { TstgSubTenderFileGather } procedure TstgSubTenderFileGather.GatherDetailData( AGatherNode: TstgGatherTreeNode; ASourceNode: TMeasureBillsIDTreeNode); var vSubTender: TstgSubTenderStageData; begin //if Assigned(ASourceNode.StageRec) and // ((ASourceNode.StageRec.GatherQuantity.AsFloat <> 0) or (ASourceNode.StageRec.GatherTotalPrice.AsFloat <> 0)) then if not ASourceNode.HasChildren then begin vSubTender := AGatherNode.SafeSubTender(FCurSubTenderID); vSubTender.AddDetail(ASourceNode); end; end; procedure TstgSubTenderFileGather.GatherSubTender(ASubTenderID: Integer); var vNode: TsdIDTreeNode; begin FCurSubTenderID := ASubTenderID; vNode := ProjectManager.ProjectsTree.FindNode(ASubTenderID); if vNode.Rec.ValueByName('Type').AsInteger = 1 then begin FProjectData := TProjectData.Create; try FProjectData.OpenForSumUpGather(GetMyProjectsFilePath + vNode.Rec.ValueByName('FileName').AsString); FCacheData.AddSubTender(vNode.Rec); GatherSubTenderTreeNode(FProjectData.BillsMeasureData.BillsMeasureTree.FirstNode, nil); finally FProjectData.Free; end; end; end; procedure TstgSubTenderFileGather.GatherSubTenderTreeNode( ANode: TsdIDTreeNode; AParent: TstgGatherTreeNode); var vCur: TstgGatherTreeNode; begin if not Assigned(ANode) then Exit; vCur := GatherSubTenderTreeNodeData(ANode, AParent); GatherSubTenderTreeNode(ANode.FirstChild, vCur); GatherSubTenderTreeNode(ANode.NextSibling, AParent); end; function TstgSubTenderFileGather.GatherSubTenderTreeNodeData( ANode: TsdIDTreeNode; AParent: TstgGatherTreeNode): TstgGatherTreeNode; var vNode: TMeasureBillsIDTreeNode; vNext: TstgGatherTreeNode; begin vNode := TMeasureBillsIDTreeNode(ANode); if ANode.ID <= 100 then Result := FCacheData.GatherTree.FindNode(ANode.ID) else Result := FCacheData.GatherTree.FindNode(AParent, vNode); if not Assigned(Result) then begin if not Assigned(AParent) or (not (AParent.IsSumBase and AParent.IsLeafXmj)) or (not ANode.HasChildren) then begin if ANode.ID < 100 then Result := FCacheData.GatherTree.AddSubTenderNode(AParent, nil, ANode.ID) else Result := FCacheData.GatherTree.AddSubTenderNode(AParent, nil); Result.Code := vNode.Rec.Code.AsString; Result.B_Code := vNode.Rec.B_Code.AsString; Result.Name := vNode.Rec.Name.AsString; Result.Units := vNode.Rec.Units.AsString end else Result := AParent; end; if Assigned(Result) then GatherDetailData(Result, vNode) else Result := AParent; end; procedure TstgSubTenderFileGather.GatherTo(AGatherCacheData: TstgGatherCacheData; ASubTenders: TList); var i, iSubTenderID: Integer; begin FCacheData := AGatherCacheData; for i := 0 to ASubTenders.Count - 1 do GatherSubTender(Integer(ASubTenders.Items[i])); FCacheData.GatherTree.CalculateAll; end; { TstgErrorChecker } procedure TstgErrorChecker.AddError(ANode: TstgGatherTreeNode); begin if ANode.IsGclBills then AddGclError(ANode) else AddXmjError(ANode); end; procedure TstgErrorChecker.AddGclError(ANode: TstgGatherTreeNode); begin if HasXmjChildWithSameCodeChild(ANode) then NewError(ANode, iErrorXmjLess) else if HasLongRelaCodeChild(ANode) then NewError(ANode, iErrorGclLess) else if HasShortRelaCodeChild(ANode) then NewError(ANode, iErrorGclMore) else if HasSameChildWithDiffLevel(ANode) then NewError(ANode, iErrorGclMore) else if HasSameCodeLevelChild(ANode) then NewError(ANode, iErrorGclDiff) else NewError(ANode, iErrorGclAdd); end; procedure TstgErrorChecker.AddXmjError(ANode: TstgGatherTreeNode); begin if HasSameCodeLevelChild(ANode) then NewError(ANode, iErrorXmjDiff) else NewError(ANode, iErrorXmjAdd); end; procedure TstgErrorChecker.Check(AGatherCacheData: TstgGatherCacheData); var i: Integer; vNode, vParent: TstgGatherTreeNode; begin FCacheData := AGatherCacheData; for i := 0 to FCacheData.GatherTree.CacheNodes.Count - 1 do begin vNode := TstgGatherTreeNode(FCacheData.GatherTree.CacheNodes[i]); vParent := TstgGatherTreeNode(vNode.Parent); if vNode.IsSubTender and (not Assigned(vParent) or not vParent.IsSubTender) then AddError(vNode); end; end; function TstgErrorChecker.HasLongRelaCodeChild( ANode: TstgGatherTreeNode): Boolean; var vParent, vChild: TstgGatherTreeNode; i: Integer; begin Result := False; vParent := SafeCheckParent(ANode, nil); for i := 0 to vParent.Children.Count - 1 do begin vChild := TstgGatherTreeNode(vParent.Children.Items[i]); if Pos(ANode.B_Code + '-', vChild.B_Code) = 1 then begin Result := True; Break; end; end; end; function TstgErrorChecker.HasSameChildWithDiffLevel(ANode, ACheckParent: TstgGatherTreeNode): Boolean; var vParent, vChild: TstgGatherTreeNode; i: Integer; begin Result := False; vParent := SafeCheckParent(ANode, ACheckParent); for i := 0 to vParent.Children.Count - 1 do begin vChild := TstgGatherTreeNode(vParent.Children.Items[i]); if vChild.IsSumBase and (vChild.Code = ANode.Code) and (vChild.B_Code = ANode.B_Code) and (vChild.Name = ANode.Name) and (vChild.Units = ANode.Units) and (vChild.IsLeaf = vChild.IsLeaf) then begin Result := True; Break; end; end; end; function TstgErrorChecker.HasSameCodeLevelChild(ANode, ACheckParent: tstgGatherTreeNode): Boolean; var vParent, vChild: TstgGatherTreeNode; i: Integer; begin Result := False; vParent := SafeCheckParent(ANode, ACheckParent); for i := 0 to vParent.Children.Count - 1 do begin vChild := TstgGatherTreeNode(vParent.Children.Items[i]); if vChild.IsSumBase and (vChild.Code = ANode.Code) and (vChild.B_Code = ANode.B_Code) and (vChild.IsLeaf = vChild.IsLeaf) then begin Result := True; Break; end; end; end; function TstgErrorChecker.HasShortRelaCodeChild( ANode: TstgGatherTreeNode): Boolean; var vParent, vChild: TstgGatherTreeNode; i: Integer; begin Result := False; vParent := SafeCheckParent(ANode, nil); for i := 0 to vParent.Children.Count - 1 do begin vChild := TstgGatherTreeNode(vParent.Children.Items[i]); if Pos(vChild.B_Code + '-', ANode.B_Code) = 1 then begin Result := True; Break; end; end; end; function TstgErrorChecker.HasXmjChildWithSameCodeChild( ANode: TstgGatherTreeNode): Boolean; var vParent, vChild: TstgGatherTreeNode; i: Integer; begin Result := False; vParent := SafeCheckParent(ANode, nil); for i := 0 to vParent.Children.Count - 1 do begin vChild := TstgGatherTreeNode(vParent.Children.Items[i]); if not vChild.IsGclBills and ANode.IsGclBills then begin Result := True; Break; end; end; end; procedure TstgErrorChecker.NewError(ANode: TstgGatherTreeNode; AType: Integer); procedure RecursiveNewError(AParent: TstgGatherTreeNode); var i: Integer; begin if AParent.Children.Count > 0 then begin for i := 0 to AParent.Children.Count - 1 do RecursiveNewError(TstgGatherTreeNode(AParent.Children.Items[i])); end else FCacheData.AddError(ANode, AParent, AType); end; begin RecursiveNewError(ANode); end; function TstgErrorChecker.SafeCheckParent(ANode, ACheckParent: TstgGatherTreeNode): TstgGatherTreeNode; begin if Assigned(ACheckParent) then Result := ACheckParent else if Assigned(ANode.Parent) then Result := TstgGatherTreeNode(ANode.Parent) else Result := TstgGatherTreeNode(FCacheData.GatherTree.Root); end; end.