unit ProjectMergeSplitUnit; interface uses Classes, ScBillsTree, ConstVarUnit, ConstTypeUnit, ConstMethodUnit, ADODB, DB, DBClient, Provider, Windows, ScProjectManager, ScKindsOfTrees, ScProgressFrm, ScFileArchiver; type { TODO : It Seems that use Mutil-Thread can not improve efficiency here. } { So it is a failing design. } { *************** Thread ********************* } TMergeThread = class(TThread) private FExecuting : Boolean; FIsOpen : Boolean; FIsCreate : Boolean; FHasGather : Boolean; FBillsTree : TScBillsTree; FDoExecute : TNotifyEvent; FTable : TADOTable; FDrawTable : TADOTable; FCdsDraw : TClientDataSet; FDspDraw : TDataSetProvider; FArchiver : TScProjectFileArchiver; FGatherTree : TMergeGatherTree; FCriticalSec: TRTLCriticalSection; procedure WaitThread(aProjThread: TMergeThread); procedure ExecuteBefore; { Merge Tree } procedure MergeBillsTree(aThread: TMergeThread); procedure MergeGatherTree(aThread: TMergeThread); procedure UpdateGatherTree(aThread: TMergeThread); procedure UpdateBillsTree(aThread: TMergeThread); { property } procedure SetExecuting(const Value: Boolean); protected procedure Execute; override; public constructor Create(const aFileName: string; aExecuteEvt: TNotifyEvent; aBillsTree: TScBillsTree = nil); destructor Destroy; override; { Merge } procedure MergeTree(aThread: TMergeThread); property Archiver: TScProjectFileArchiver read FArchiver; property Executing: Boolean read FExecuting write SetExecuting; end; TSplitThread = class(TThread) private { Build Project } // FOwnerArchiver : TScProjectFileArchiver; FOwnerBillsTree : TAdditinalTree; FOwnerDrawCds : TClientDataSet; { BidLot Project } FIsOpened : Boolean; FBidShortName : string; FBidFilePath : string; FBidArchiver : TScProjectFileArchiver; FBidBillsTable : TADOTable; FBidBillsDsp : TDataSetProvider; FBidBillsCds : TClientDataSet; FBidDrawTable : TADOTable; FBidDrawDsp : TDataSetProvider; FBidDrawCds : TClientDataSet; FGatherTree : TSplitGatherTree; FThreadList : TThreadList; FProjectMgr : TProjectManager; FProjectIdx : Integer; { Events } FSplitOverEvt : TInternalEvent; FBeginSynchronize : TInternalEvent; FEndSynchronize : TInternalEvent; procedure RemoveFormList; procedure AddToList; function OpenArchiverFile: Boolean; procedure DoBeforeExecute; procedure DeleteAll; procedure WriteGatherTreeToOpenedDB; procedure WriteGatherTreeToDB; protected procedure Execute; override; public constructor Create(aThreadList: TThreadList; const aShortName, aFilePath: string); destructor Destroy; override; procedure BeginExecute; end; { ***************** End Thread ********************} TProjectConverter = class private FFileDir : string; FDoneOver : Boolean; FProjectList : TThreadList; FProjectMgr : TProjectManager; FSrcTree : TMergeGatherTree; FBillsTable : TADOTable; FDrawTable : TADOTable; FDrawDsp : TDataSetProvider; FDrawCds : TClientDataSet; FBillsTree : TAdditinalTree; FIsSplit : Boolean; FSynchronize : Integer; { ************* Merge ************************* } // aFileName is a Extract File Path, eg: 'C:\Test\Test.smb' function OpenProject(const aFileName: string; aBillsTree: TScBillsTree): TMergeThread; procedure OpenProjects(aProjList: TStrings); { Wait thread } procedure WaitUntilOver; function WaitUntilTerminated(aThread: TMergeThread): Boolean; procedure NotifyExecuteOver; { Synchronize } procedure BeginSynchronize; procedure EndSynchronize; procedure WaitOverWithSync; procedure RemoveThread(aThread: TMergeThread); function GetThread(var aThread: TMergeThread): Boolean; function GetOperateThread(aThread: TMergeThread): TMergeThread; procedure DoMerge(aThread: TObject); { Execute Thread } procedure ExecuteMerge; { Write } procedure DeleteAllRecords(aQuery: TADOQuery); procedure WriteDB(aBillsTable, aDrawTable: TDataSet; aThread: TMergeThread); procedure WriteProjectUnOpened(aThread: TMergeThread; const aFileName: string); procedure WriteBuildProject(const aFileName: string); // 2011.5.13 procedure MergeTree(AProjList: TStrings); { ***************** Split ******************************} procedure QueryExtractBidLots(aArchiver: TScProjectFileArchiver; aStrings: TStrings); function OpenBuildProject(const aFullName: string; aStrings: TStrings; var aIsOpened: Boolean): TScProjectFileArchiver; procedure ExecuteSplit(aStrings: TStrings; aArchiver: TScProjectFileArchiver); public constructor Create(aProjMgr: TProjectManager; aIsSplit, AMergeByCode: Boolean); destructor Destroy; override; { 把 aProjList 里的标段合并成 aFileName 项目 } procedure Merge(aProjList: TStrings; const aFileName: string); { TODO litao : 2011.5.13 } procedure MergeNew(aProjList: TStrings; const aFileName: string); { TODO : Split BuildProject } procedure Split(const aFileName: string); end; implementation uses SysUtils, ZjIDTree, Forms, ScUpdateDataBase, DataBase; { TMergeThread } constructor TMergeThread.Create(const aFileName: string; aExecuteEvt: TNotifyEvent; aBillsTree: TScBillsTree); begin FGatherTree := TMergeGatherTree.Create; InitializeCriticalSection(FCriticalSec); FDoExecute := aExecuteEvt; FBillsTree := aBillsTree; if Assigned(FBillsTree) then FIsOpen := True else begin FArchiver := TScProjectFileArchiver.Create; FArchiver.FileName := aFileName; FArchiver.OpenFile; UpdateDB(FArchiver); end; FreeOnTerminate := False; inherited Create(True); end; destructor TMergeThread.Destroy; begin FTable.Free; FGatherTree.Free; DeleteCriticalSection(FCriticalSec); if not FIsOpen then begin FBillstree.Free; FDrawTable.Free; FDspDraw.Free; FCdsDraw.Free; FArchiver.Free; end; inherited; end; procedure TMergeThread.Execute; begin inherited; if Terminated then Exit; ExecuteBefore; if Terminated then Exit; FDoExecute(Self); end; procedure TMergeThread.ExecuteBefore; begin if not Assigned(FBillsTree) then begin FTable := TADOTable.Create(nil); FTable.Connection := FArchiver.Connection; FTable.TableName := 'Bills'; FTable.Open; if Terminated then Exit; FIsCreate := True; FDrawTable := TADOTable.Create(nil); FDrawTable.Connection := FArchiver.Connection; FDrawTable.TableName := 'DrawingQuantity'; FDspDraw := TDataSetProvider.Create(nil); FDspDraw.DataSet := FDrawTable; FCdsDraw := TClientDataSet.Create(nil); FCdsDraw.SetProvider(FDspDraw); FCdsDraw.Active := True; FCdsDraw.IndexFieldNames := sBillsID + ';' + sSerinalNo; FBillsTree := TAdditinalTree.Create; FBillsTree.KeyFieldName := SID; FBillsTree.ParentFieldName := sParentID; FBillsTree.NextSiblingFieldName := sNextSiblingID; { because it does not need to write , so can use table, if it is needed to write ,then should use cds } FBillsTree.DataSet := FTable; if Terminated then Exit; FBillsTree.Active := True; FIsCreate := False; end else begin FIsCreate := True; FCdsDraw := TDMDataBase(FBillsTree.Bills).cdsDrawingQuantity; FCdsDraw.IndexFieldNames := sBillsID + ';' + sSerinalNo; FIsCreate := False; end; end; procedure TMergeThread.MergeBillsTree(aThread: TMergeThread); begin FGatherTree.IsOpen1 := FIsOpen; FGatherTree.CdsDraw1 := FCdsDraw; FGatherTree.GatherBillsTree(FBillsTree); FGatherTree.IsOpen2 := aThread.FIsOpen; FGatherTree.CdsDraw2 := aThread.FCdsDraw; FGatherTree.UpdateBillsTree(aThread.FBillsTree); end; procedure TMergeThread.MergeGatherTree(aThread: TMergeThread); begin FGatherTree.GatherTree(aThread.FGatherTree); end; procedure TMergeThread.MergeTree(aThread: TMergeThread); begin WaitThread(aThread); if FHasGather then begin if aThread.FHasGather then MergeGatherTree(aThread) else UpdateGatherTree(aThread); end else begin if aThread.FHasGather then UpdateBillsTree(aThread) else MergeBillsTree(aThread); end; end; procedure TMergeThread.SetExecuting(const Value: Boolean); begin EnterCriticalSection(FCriticalSec); FExecuting := Value; LeaveCriticalSection(FCriticalSec); end; procedure TMergeThread.UpdateBillsTree(aThread: TMergeThread); begin FGatherTree.IsOpen1 := FIsOpen; FGatherTree.CdsDraw1 := FCdsDraw; FGatherTree.GatherBillsTree(FBillsTree); FGatherTree.GatherTree(aThread.FGatherTree); end; procedure TMergeThread.UpdateGatherTree(aThread: TMergeThread); begin // FGatherTree.BillsTree1 := nil; FGatherTree.IsOpen2 := aThread.FIsOpen; FGatherTree.CdsDraw2 := aThread.FCdsDraw; FGatherTree.UpdateBillsTree(aThread.FBillsTree); end; procedure TMergeThread.WaitThread(aProjThread: TMergeThread); begin while (aProjThread.FBillsTree = nil) or aProjThread.FIsCreate do begin Sleep(100); end; end; { TProjectConverter } procedure TProjectConverter.DeleteAllRecords(aQuery: TADOQuery); begin with aQuery do begin SQL.Clear; SQL.Add('Delete * From Bills'); ExecSQL; SQL.Clear; SQL.Add('Delete * From DrawingQuantity'); ExecSQL; SQL.Clear; SQL.Add('Delete * From Exprs'); ExecSQL; end; end; constructor TProjectConverter.Create(aProjMgr: TProjectManager; aIsSplit, AMergeByCode: Boolean); begin FProjectList := TThreadList.Create; FFileDir := ExtractFilePath(ParamStr(0)); FProjectMgr := aProjMgr; FSrcTree := TMergeGatherTree.Create; FSrcTree.MergeByCode := AMergeByCode; FIsSplit := aIsSplit; if FIsSplit then begin FBillsTable := TADOTable.Create(nil); FDrawTable := TADOTable.Create(nil); FDrawDsp := TDataSetProvider.Create(nil); FDrawCds := TClientDataSet.Create(nil); FBillsTree := TAdditinalTree.Create; FBillsTable.TableName := 'Bills'; FBillsTree.DataSet := FBillsTable; FBillsTree.KeyFieldName := SID; FBillsTree.ParentFieldName := sParentID; FBillsTree.NextSiblingFieldName := sNextSiblingID; FDrawTable.TableName := 'DrawingQuantity'; FDrawDsp.DataSet := FDrawTable; FDrawCds.SetProvider(FDrawDsp); FDrawCds.IndexFieldNames := sBillsID; end; end; destructor TProjectConverter.Destroy; begin FProjectList.Free; FSrcTree.Free; if FIsSplit then begin FBillsTable.Free; FDrawTable.Free; FDrawDsp.Free; FDrawCds.Free; FBillsTree.Free; end; inherited; end; procedure TProjectConverter.DoMerge(aThread: TObject); var pctThread: TMergeThread; begin pctThread := GetOperateThread(TMergeThread(aThread)); if Assigned(pctThread) then begin if TMergeThread(aThread).Terminated then Exit; TMergeThread(aThread).MergeTree(pctThread); TMergeThread(aThread).FHasGather := True; TMergeThread(aThread).Executing := False; if aThread <> pctThread then begin RemoveThread(pctThread); pctThread.FreeOnTerminate := True; pctThread.Terminate; end else Exit; end else Exit; if TMergeThread(aThread).Terminated then Exit; DoMerge(aThread); end; procedure TProjectConverter.ExecuteMerge; var I: Integer; thrList: TList; begin thrList := FProjectList.LockList; try for I := 0 to thrList.Count - 1 do begin TMergeThread(thrList.List^[I]).Resume; end; finally FProjectList.UnlockList; end; end; procedure TProjectConverter.Merge(aProjList: TStrings; const aFileName: string); begin // 1. 打开标段 OpenProjects(aProjList); // 2. 合并标段 ExecuteMerge; // 3. 把数据写入建设项目 WriteBuildProject(aFileName); end; function TProjectConverter.OpenProject(const aFileName: string; aBillsTree: TScBillsTree): TMergeThread; begin Result := TMergeThread.Create(aFileName, DoMerge, aBillsTree); end; procedure TProjectConverter.OpenProjects(aProjList: TStrings); var I, iIdx: Integer; sFileName: string; sbtTree: TScBillsTree; pctThread: TMergeThread; begin if aProjList.Count = 0 then begin FDoneOver := True; Exit; end; for I := 0 to aProjList.Count - 1 do begin sbtTree := nil; sFileName := FFileDir + aProjList[I]; iIdx := FProjectMgr.CheckProjectExists(sFileName); if iIdx <> -1 then sbtTree := FProjectMgr.Projects[iIdx].BillsData.BillsTree; pctThread := OpenProject(sFileName, sbtTree); FProjectList.Add(pctThread); end; end; procedure TProjectConverter.Split(const aFileName: string); var bOpened: Boolean; sgsBidLots: TStrings; pfArchiver: TScProjectFileArchiver; begin sgsBidLots := TStringList.Create; try { 1. Open BuildProject, and get Bidlot List } pfArchiver := OpenBuildProject(aFileName, sgsBidLots, bOpened); try if pfArchiver = nil then Exit; { 2. begin Split } ExecuteSplit(sgsBidLots, pfArchiver); { 3. end Split } WaitOverWithSync; finally if not bOpened then pfArchiver.Free; end; finally sgsBidLots.Free; end; end; procedure TProjectConverter.WriteBuildProject(const aFileName: string); var iIdx: Integer; // pctThread: TMergeThread; begin // WaitUntilOver; // if not GetThread(pctThread) then Exit; iIdx := FProjectMgr.CheckProjectExists(FFileDir + aFileName); if iIdx <> -1 then begin FSrcTree.TraverseOwnerIntoDB(FProjectMgr.Projects[iIdx]); //pctThread.FGatherTree.TraverseOwnerIntoDB(FProjectMgr.Projects[iIdx]); end else WriteProjectUnOpened({pctThread} nil, aFileName); // pctThread.Free; end; procedure TProjectConverter.WriteDB(aBillsTable, aDrawTable: TDataSet; aThread: TMergeThread); begin aBillsTable.Open; aDrawTable.Open; //aThread.FGatherTree.WriteTo(aBillsTable, aDrawTable); end; procedure TProjectConverter.WaitUntilOver; begin while not FDoneOver do begin Sleep(100); end; end; function TProjectConverter.GetThread(var aThread: TMergeThread): Boolean; var thrList: TList; begin Result := True; thrList := FProjectList.LockList; try if thrList.Count = 0 then Result := False else aThread := TMergeThread(thrList[0]); finally FProjectList.UnlockList; end; end; procedure TProjectConverter.RemoveThread(aThread: TMergeThread); var thrList: TList; begin thrList := FProjectList.LockList; try thrList.Remove(aThread); finally FProjectList.UnlockList; end; end; procedure TProjectConverter.WriteProjectUnOpened(aThread: TMergeThread; const aFileName: string); var aqQuery: TADOQuery; atDrawTable: TADOTable; atBillsTable: TADOTable; atExprs: TADOTable; dspDraw: TDataSetProvider; dspBills: TDataSetProvider; dspExprs: TDataSetProvider; cdsDraw: TClientDataSet; cdsBills: TClientDataSet; cdsExprs: TClientDataSet; pfaArchiver: TScProjectFileArchiver; begin pfaArchiver := TScProjectFileArchiver.Create; aqQuery := TADOQuery.Create(nil); atBillsTable := TADOTable.Create(nil); atDrawTable := TADOTable.Create(nil); atExprs := TADOTable.Create(nil); dspDraw := TDataSetProvider.Create(nil); dspBills := TDataSetProvider.Create(nil); dspExprs := TDataSetProvider.Create(nil); cdsDraw := TClientDataSet.Create(nil); cdsBills := TClientDataSet.Create(nil); cdsExprs := TClientDataSet.Create(nil); try pfaArchiver.FileName := FFileDir + aFileName; pfaArchiver.OpenFile; aqQuery.Connection := pfaArchiver.Connection; DeleteAllRecords(aqQuery); atBillsTable.Connection := pfaArchiver.Connection; atBillsTable.TableName := 'Bills'; dspBills.DataSet := atBillsTable; cdsBills.SetProvider(dspBills); // 有相同的Owner下才能用ProviderName,否则应用SetProvider,具体Help有写明 // cdsBills.ProviderName := 'dspBills'; atDrawTable.Connection := pfaArchiver.Connection; atDrawTable.TableName := 'DrawingQuantity'; dspDraw.DataSet := atDrawTable; cdsDraw.SetProvider(dspDraw); atExprs.Connection := pfaArchiver.Connection; atExprs.TableName := 'Exprs'; dspExprs.DataSet := atExprs; cdsExprs.SetProvider(dspExprs); // cdsDraw.ProviderName := 'dspDraw'; cdsBills.Open; cdsDraw.Open; cdsExprs.Open; FSrcTree.WriteTo(cdsBills, cdsDraw, cdsExprs); //WriteDB(cdsBills, cdsDraw, aThread); cdsBills.ApplyUpdates(0); cdsDraw.ApplyUpdates(0); cdsExprs.ApplyUpdates(0); pfaArchiver.Save; finally pfaArchiver.Free; aqQuery.Free; atBillsTable.Free; atDrawTable.Free; dspDraw.Free; dspBills.Free; cdsDraw.Free; cdsBills.Free; atExprs.Free; dspExprs.Free; cdsExprs.Free; end; end; function TProjectConverter.GetOperateThread( aThread: TMergeThread): TMergeThread; var I: Integer; bWait: Boolean; pctList: TList; pctThread: TMergeThread; begin Result := nil; if WaitUntilTerminated(aThread) then Exit; bWait := True; while bWait do begin pctList := FProjectList.LockList; try if pctList.Count <= 1 then begin NotifyExecuteOver; Result := aThread; Break; end; if aThread.Terminated then Break; for I := 0 to pctList.Count - 1 do begin pctThread := TMergeThread(pctList.List^[I]); if pctThread <> aThread then begin if not pctThread.FExecuting then begin aThread.Executing := True; pctThread.Executing := True; Result := pctThread; bWait := False; Break; end; end; end; finally FProjectList.UnlockList; end; if bWait then Sleep(100); end; end; function TProjectConverter.WaitUntilTerminated(aThread: TMergeThread): Boolean; begin Result := False; while aThread.FExecuting do begin if aThread.Terminated then begin Result := True; Break; end; Sleep(100); end; end; procedure TProjectConverter.ExecuteSplit(aStrings: TStrings; aArchiver: TScProjectFileArchiver); var I: Integer; iIdx: Integer; sAliasName: string; sFullName: string; ThrSplit: TSplitThread; begin if aStrings.Count = 0 then Exit; FBillsTable.Connection := aArchiver.Connection; FBillsTree.Active := True; FDrawTable.Connection := aArchiver.Connection; FDrawCds.Active := True; for I := 0 to aStrings.Count - 1 do begin sAliasName := aStrings[I]; sFullName := FFileDir + string(aStrings.Objects[I]); ThrSplit := TSplitThread.Create(FProjectList, sAliasName, sFullName); ThrSplit.FOwnerBillsTree := FBillsTree; ThrSplit.FOwnerDrawCds := FDrawCds; ThrSplit.FProjectMgr := FProjectMgr; ThrSplit.FSplitOverEvt := NotifyExecuteOver; ThrSplit.FBeginSynchronize := BeginSynchronize; ThrSplit.FEndSynchronize := EndSynchronize; iIdx := FProjectMgr.CheckProjectExists(sFullName); if iIdx <> -1 then begin ThrSplit.FBidBillsCds := FProjectMgr.Projects[iIdx].BillsData.cdsBills; ThrSplit.FBidDrawCds := FProjectMgr.Projects[iIdx].BillsData.cdsDrawingQuantity; end; ThrSplit.BeginExecute; end; end; function TProjectConverter.OpenBuildProject(const aFullName: string; aStrings: TStrings; var aIsOpened: Boolean): TScProjectFileArchiver; var iIdx: Integer; begin iIdx := FProjectMgr.CheckProjectExists(FFileDir + aFullName); if iIdx = -1 then begin { BuildProject is not Opened } Result := TScProjectFileArchiver.Create; Result.FileName := FFileDir + aFullName; if not Result.OpenFile then begin FreeAndNil(Result); Exit; end; aIsOpened := False; end else begin { BuildProject Has been Opened } Result := FProjectMgr.Projects[iIdx].Archiver; Result.Save; aIsOpened := True; end; { Get Extract BidlotList } QueryExtractBidLots(Result, aStrings); end; procedure TProjectConverter.QueryExtractBidLots( aArchiver: TScProjectFileArchiver; aStrings: TStrings); var aqQuery: TADOQuery; sAliasName: string; sFullName: string; begin aqQuery := TADOQuery.Create(nil); try aqQuery.Connection := aArchiver.Connection; with aqQuery do begin SQL.Text := 'Select AliasName, FullName From BidLot ' + 'Where AliasName in ' + '(Select Distinct OwnerName From Bills ' + 'Where (not IsNull(OwnerName)) and (OwnerName<>''''))'; Open; First; while not Eof do begin sAliasName := FieldByName('AliasName').AsString; sFullName := FieldByName('FullName').AsString; aStrings.AddObject(sAliasName, Pointer(sFullName)); Integer(sFullName) := 0; Next; end; end; finally aqQuery.Free; end; end; procedure TProjectConverter.NotifyExecuteOver; begin FDoneOver := True; end; procedure TProjectConverter.WaitOverWithSync; begin while not FDoneOver do begin Sleep(100); if FSynchronize > 0 then Application.ProcessMessages; end; end; procedure TProjectConverter.BeginSynchronize; begin InterlockedIncrement(FSynchronize); end; procedure TProjectConverter.EndSynchronize; begin InterlockedDecrement(FSynchronize); end; procedure TProjectConverter.MergeNew(aProjList: TStrings; const aFileName: string); begin CreateProgressForm(15, '正在合并树结构!'); MergeTree(aProjList); CreateProgressForm(45, '正在合并写入数据!'); WriteBuildProject(aFileName); CreateProgressForm(99, '合并清单完成!'); end; procedure TProjectConverter.MergeTree(AProjList: TStrings); var atDrawTable1: TADOTable; atBillsTable1: TADOTable; dspDraw1: TDataSetProvider; dspBills1: TDataSetProvider; cdsDraw1: TClientDataSet; cdsBills1: TClientDataSet; atDrawTable2: TADOTable; atBillsTable2: TADOTable; dspDraw2: TDataSetProvider; dspBills2: TDataSetProvider; cdsDraw2: TClientDataSet; cdsBills2: TClientDataSet; arArchiver1: TScProjectFileArchiver; arArchiver2: TScProjectFileArchiver; BillsTree1: TScBillsTree; BillsTree2: TScBillsTree; atExprs: TADOTable; dspExprs: TDataSetProvider; cdsExprs: TClientDataSet; procedure InnerCreate; begin atDrawTable1 := TADOTable.Create(nil); atBillsTable1 := TADOTable.Create(nil); dspDraw1 := TDataSetProvider.Create(nil); dspBills1 := TDataSetProvider.Create(nil); cdsDraw1 := TClientDataSet.Create(nil); cdsBills1 := TClientDataSet.Create(nil); atDrawTable2 := TADOTable.Create(nil); atBillsTable2 := TADOTable.Create(nil); dspDraw2 := TDataSetProvider.Create(nil); dspBills2 := TDataSetProvider.Create(nil); cdsDraw2 := TClientDataSet.Create(nil); cdsBills2 := TClientDataSet.Create(nil); atExprs := TADOTable.Create(nil); dspExprs := TDataSetProvider.Create(nil); cdsExprs := TClientDataSet.Create(nil); atDrawTable1.TableName := 'DrawingQuantity'; dspDraw1.DataSet := atDrawTable1; cdsDraw1.SetProvider(dspDraw1); cdsDraw1.IndexFieldNames := sBillsID + ';' + sSerinalNo; atBillsTable1.TableName := 'Bills'; dspBills1.DataSet := atBillsTable1; cdsBills1.SetProvider(dspBills1); atDrawTable2.TableName := 'DrawingQuantity'; dspDraw2.DataSet := atDrawTable2; cdsDraw2.SetProvider(dspDraw2); cdsDraw2.IndexFieldNames := sBillsID + ';' + sSerinalNo; atBillsTable2.TableName := 'Bills'; dspBills2.DataSet := atBillsTable2; cdsBills2.SetProvider(dspBills2); atExprs.TableName := 'Exprs'; dspExprs.DataSet := atExprs; cdsExprs.SetProvider(dspExprs); cdsExprs.IndexFieldNames := 'MajorID;MinorID;RecdID'; arArchiver1 := TScProjectFileArchiver.Create; arArchiver2 := TScProjectFileArchiver.Create; BillsTree1 := nil; BillsTree2 := nil; end; procedure InnerFree; begin atDrawTable1.Free; atBillsTable1.Free; dspDraw1.Free; dspBills1.Free; cdsDraw1.Free; cdsBills1.Free; atDrawTable2.Free; atBillsTable2.Free; dspDraw2.Free; dspBills2.Free; cdsDraw2.Free; cdsBills2.Free; arArchiver1.Free; arArchiver2.Free; atExprs.Free; dspExprs.Free; cdsExprs.Free; end; procedure InnerOpen1(const AFileName: string); begin arArchiver1.FileName := AFileName; arArchiver1.OpenFile; UpdateDB(arArchiver1); atDrawTable1.Connection := arArchiver1.Connection; atBillsTable1.Connection := arArchiver1.Connection; atExprs.Connection := arArchiver1.Connection; cdsDraw1.Open; cdsBills1.Open; cdsExprs.SetProvider(dspExprs); cdsExprs.Open; BillsTree1 := TAdditinalTree.Create; BillsTree1.KeyFieldName := SID; BillsTree1.ParentFieldName := sParentID; BillsTree1.NextSiblingFieldName := sNextSiblingID; BillsTree1.DataSet := atBillsTable1; BillsTree1.Active := True; end; procedure InnerOpen2(const AFileName: string); begin if arArchiver2.IsOpened then arArchiver2.CloseFile; arArchiver2.FileName := AFileName; arArchiver2.OpenFile; UpdateDB(arArchiver2); atDrawTable2.Connection := arArchiver2.Connection; atBillsTable2.Connection := arArchiver2.Connection; atExprs.Connection := arArchiver2.Connection; cdsDraw2.Open; cdsBills2.Open; cdsExprs.SetProvider(dspExprs); cdsExprs.Open; BillsTree2 := TAdditinalTree.Create; BillsTree2.KeyFieldName := SID; BillsTree2.ParentFieldName := sParentID; BillsTree2.NextSiblingFieldName := sNextSiblingID; BillsTree2.DataSet := atBillsTable2; BillsTree2.Active := True; end; var I: Integer; iIdx: Integer; strFileName: string; begin InnerCreate; try CreateProgressForm(AProjList.Count, '正在合并树结构!'); for I := 0 to AProjList.Count - 1 do begin //RefreshProgressForm(I + 1, '正在合并树结构…'); strFileName := FFileDir + AProjList[I]; RefreshProgressForm(I + 1, '正在处理 ' + strFileName + ' 文件'); iIdx := FProjectMgr.CheckProjectExists(strFileName); cdsExprs.Close; if iIdx <> -1 then begin if BillsTree1 = nil then begin BillsTree1 := FProjectMgr.Projects[iIdx].BillsData.BillsTree; atDrawTable1.Connection := FProjectMgr.Projects[iIdx].Connection; cdsDraw1.Open; atExprs.Connection := FProjectMgr.Projects[iIdx].Connection; cdsExprs.SetProvider(dspExprs); cdsExprs.Open; FSrcTree.IsOpen1 := True; FSrcTree.CdsDraw1 := cdsDraw1; FSrcTree.CdsExprs := cdsExprs; FSrcTree.GatherBillsTree(BillsTree1); end else begin BillsTree2 := FProjectMgr.Projects[iIdx].BillsData.BillsTree; atDrawTable2.Connection := FProjectMgr.Projects[iIdx].Connection; atExprs.Connection := FProjectMgr.Projects[iIdx].Connection; cdsDraw2.Open; cdsExprs.SetProvider(dspExprs); cdsExprs.Open; FSrcTree.IsOpen2 := True; FSrcTree.CdsDraw2 := cdsDraw2; FSrcTree.CdsExprs := cdsExprs; FSrcTree.UpdateBillsTree(BillsTree2); end; end else begin if BillsTree1 = nil then begin InnerOpen1(strFileName); FSrcTree.IsOpen1 := False; FSrcTree.CdsDraw1 := cdsDraw1; FSrcTree.CdsExprs := cdsExprs; FSrcTree.GatherBillsTree(BillsTree1); BillsTree1.Free; end else begin InnerOpen2(strFileName); FSrcTree.IsOpen2 := False; FSrcTree.CdsDraw2 := cdsDraw2; FSrcTree.UpdateBillsTree(BillsTree2); BillsTree2.Free; end; end; end; CloseProgressForm; finally InnerFree; end; end; { TSplitThread } procedure TSplitThread.AddToList; var thrList: TList; begin thrList := FThreadList.LockList; try thrList.Add(Self); finally FThreadList.UnlockList; end; end; procedure TSplitThread.BeginExecute; begin Resume; end; constructor TSplitThread.Create(aThreadList: TThreadList; const aShortName, aFilePath: string); begin FThreadList := aThreadList; FBidShortName := aShortName; FBidFilePath := aFilePath; FGatherTree := TSplitGatherTree.Create; AddToList; if not OpenArchiverFile then Exit; FreeOnTerminate := True; inherited Create(True); end; procedure TSplitThread.DeleteAll; var acCommand: TADOCommand; begin if FBidArchiver = nil then Exit; acCommand := TADOCommand.Create(nil); try acCommand.Connection := FBidArchiver.Connection; acCommand.CommandText := 'Delete * From Bills'; acCommand.Execute; acCommand.CommandText := 'Delete * From DrawingQuantity'; acCommand.Execute; finally acCommand.Free; end; end; destructor TSplitThread.Destroy; begin if not FIsOpened then begin FBidArchiver.Free; FBidBillsTable.Free; FBidBillsDsp.Free; FBidBillsCds.Free; FBidDrawTable.Free; FBidDrawDsp.Free; FBidDrawCds.Free; end; FGatherTree.Free; RemoveFormList; inherited; end; procedure TSplitThread.DoBeforeExecute; begin if (FBidBillsCds = nil) or (FBidDrawCds = nil) then begin { 打开加密文件只能在主线程里完成,否则会出错 } {FBidArchiver := TScProjectFileArchiver.Create; FBidArchiver.FileName := aFilePath; if not FBidArchiver.OpenFile then begin Terminate; Exit; end;} FBidBillsTable := TADOTable.Create(nil); FBidBillsTable.Connection := FBidArchiver.Connection; FBidBillsTable.TableName := 'Bills'; FBidBillsDsp := TDataSetProvider.Create(nil); FBidBillsDsp.DataSet := FBidBillsTable; FBidBillsCds := TClientDataSet.Create(nil); FBidBillsCds.SetProvider(FBidBillsDsp); // FBidBillsCds.Active := True; FBidDrawTable := TADOTable.Create(nil); FBidDrawTable.Connection := FBidArchiver.Connection; FBidDrawTable.TableName := 'DrawingQuantity'; FBidDrawDsp := TDataSetProvider.Create(nil); FBidDrawDsp.DataSet := FBidDrawTable; FBidDrawCds := TClientDataSet.Create(nil); FBidDrawCds.SetProvider(FBidDrawDsp); // FBidDrawCds.Active := True; end else FIsOpened := True; end; procedure TSplitThread.Execute; begin inherited; DoBeforeExecute; if Terminated then Exit; { Split Tree } FGatherTree.SplitBillsTree(FOwnerBillsTree, FOwnerDrawCds, FBidShortName); { Write DB } WriteGatherTreeToDB; end; function TSplitThread.OpenArchiverFile: Boolean; begin FBidArchiver := TScProjectFileArchiver.Create; FBidArchiver.FileName := FBidFilePath; Result := FBidArchiver.OpenFile; UpdateDB(FBidArchiver); end; procedure TSplitThread.RemoveFormList; var thrList: TList; begin thrList := FThreadList.LockList; try thrList.Remove(Self); if thrList.Count = 0 then FSplitOverEvt; finally FThreadList.UnlockList; end; end; procedure TSplitThread.WriteGatherTreeToDB; begin FProjectIdx := FProjectMgr.CheckProjectExists(FBidFilePath); if FProjectIdx <> -1 then begin FBeginSynchronize; try Synchronize(WriteGatherTreeToOpenedDB); finally FEndSynchronize; end; end else begin DeleteAll; FBidBillsCds.Active := True; FBidDrawCds.Active := True; FGatherTree.WriteTo(FBidBillsCds, FBidDrawCds, nil); FBidBillsCds.ApplyUpdates(0); FBidDrawCds.ApplyUpdates(0); FBidArchiver.Save; end; end; procedure TSplitThread.WriteGatherTreeToOpenedDB; begin FGatherTree.TraverseOwnerIntoDB(FProjectMgr.Projects[FProjectIdx]); end; end.