ProjectMergeSplitUnit.pas 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272
  1. unit ProjectMergeSplitUnit;
  2. interface
  3. uses
  4. Classes,
  5. ScBillsTree,
  6. ConstVarUnit,
  7. ConstTypeUnit,
  8. ConstMethodUnit,
  9. ADODB,
  10. DB,
  11. DBClient,
  12. Provider,
  13. Windows,
  14. ScProjectManager,
  15. ScKindsOfTrees,
  16. ScProgressFrm,
  17. ScFileArchiver;
  18. type
  19. { TODO : It Seems that use Mutil-Thread can not improve efficiency here. }
  20. { So it is a failing design. }
  21. { *************** Thread ********************* }
  22. TMergeThread = class(TThread)
  23. private
  24. FExecuting : Boolean;
  25. FIsOpen : Boolean;
  26. FIsCreate : Boolean;
  27. FHasGather : Boolean;
  28. FBillsTree : TScBillsTree;
  29. FDoExecute : TNotifyEvent;
  30. FTable : TADOTable;
  31. FDrawTable : TADOTable;
  32. FCdsDraw : TClientDataSet;
  33. FDspDraw : TDataSetProvider;
  34. FArchiver : TScProjectFileArchiver;
  35. FGatherTree : TMergeGatherTree;
  36. FCriticalSec: TRTLCriticalSection;
  37. procedure WaitThread(aProjThread: TMergeThread);
  38. procedure ExecuteBefore;
  39. { Merge Tree }
  40. procedure MergeBillsTree(aThread: TMergeThread);
  41. procedure MergeGatherTree(aThread: TMergeThread);
  42. procedure UpdateGatherTree(aThread: TMergeThread);
  43. procedure UpdateBillsTree(aThread: TMergeThread);
  44. { property }
  45. procedure SetExecuting(const Value: Boolean);
  46. protected
  47. procedure Execute; override;
  48. public
  49. constructor Create(const aFileName: string; aExecuteEvt: TNotifyEvent; aBillsTree: TScBillsTree = nil);
  50. destructor Destroy; override;
  51. { Merge }
  52. procedure MergeTree(aThread: TMergeThread);
  53. property Archiver: TScProjectFileArchiver read FArchiver;
  54. property Executing: Boolean read FExecuting write SetExecuting;
  55. end;
  56. TSplitThread = class(TThread)
  57. private
  58. { Build Project }
  59. // FOwnerArchiver : TScProjectFileArchiver;
  60. FOwnerBillsTree : TAdditinalTree;
  61. FOwnerDrawCds : TClientDataSet;
  62. { BidLot Project }
  63. FIsOpened : Boolean;
  64. FBidShortName : string;
  65. FBidFilePath : string;
  66. FBidArchiver : TScProjectFileArchiver;
  67. FBidBillsTable : TADOTable;
  68. FBidBillsDsp : TDataSetProvider;
  69. FBidBillsCds : TClientDataSet;
  70. FBidDrawTable : TADOTable;
  71. FBidDrawDsp : TDataSetProvider;
  72. FBidDrawCds : TClientDataSet;
  73. FGatherTree : TSplitGatherTree;
  74. FThreadList : TThreadList;
  75. FProjectMgr : TProjectManager;
  76. FProjectIdx : Integer;
  77. { Events }
  78. FSplitOverEvt : TInternalEvent;
  79. FBeginSynchronize : TInternalEvent;
  80. FEndSynchronize : TInternalEvent;
  81. procedure RemoveFormList;
  82. procedure AddToList;
  83. function OpenArchiverFile: Boolean;
  84. procedure DoBeforeExecute;
  85. procedure DeleteAll;
  86. procedure WriteGatherTreeToOpenedDB;
  87. procedure WriteGatherTreeToDB;
  88. protected
  89. procedure Execute; override;
  90. public
  91. constructor Create(aThreadList: TThreadList; const aShortName, aFilePath: string);
  92. destructor Destroy; override;
  93. procedure BeginExecute;
  94. end;
  95. { ***************** End Thread ********************}
  96. TProjectConverter = class
  97. private
  98. FFileDir : string;
  99. FDoneOver : Boolean;
  100. FProjectList : TThreadList;
  101. FProjectMgr : TProjectManager;
  102. FSrcTree : TMergeGatherTree;
  103. FBillsTable : TADOTable;
  104. FDrawTable : TADOTable;
  105. FDrawDsp : TDataSetProvider;
  106. FDrawCds : TClientDataSet;
  107. FBillsTree : TAdditinalTree;
  108. FIsSplit : Boolean;
  109. FSynchronize : Integer;
  110. { ************* Merge ************************* }
  111. // aFileName is a Extract File Path, eg: 'C:\Test\Test.smb'
  112. function OpenProject(const aFileName: string; aBillsTree: TScBillsTree): TMergeThread;
  113. procedure OpenProjects(aProjList: TStrings);
  114. { Wait thread }
  115. procedure WaitUntilOver;
  116. function WaitUntilTerminated(aThread: TMergeThread): Boolean;
  117. procedure NotifyExecuteOver;
  118. { Synchronize }
  119. procedure BeginSynchronize;
  120. procedure EndSynchronize;
  121. procedure WaitOverWithSync;
  122. procedure RemoveThread(aThread: TMergeThread);
  123. function GetThread(var aThread: TMergeThread): Boolean;
  124. function GetOperateThread(aThread: TMergeThread): TMergeThread;
  125. procedure DoMerge(aThread: TObject);
  126. { Execute Thread }
  127. procedure ExecuteMerge;
  128. { Write }
  129. procedure DeleteAllRecords(aQuery: TADOQuery);
  130. procedure WriteDB(aBillsTable, aDrawTable: TDataSet; aThread: TMergeThread);
  131. procedure WriteProjectUnOpened(aThread: TMergeThread; const aFileName: string);
  132. procedure WriteBuildProject(const aFileName: string);
  133. // 2011.5.13
  134. procedure MergeTree(AProjList: TStrings);
  135. { ***************** Split ******************************}
  136. procedure QueryExtractBidLots(aArchiver: TScProjectFileArchiver; aStrings: TStrings);
  137. function OpenBuildProject(const aFullName: string; aStrings: TStrings; var aIsOpened: Boolean): TScProjectFileArchiver;
  138. procedure ExecuteSplit(aStrings: TStrings; aArchiver: TScProjectFileArchiver);
  139. public
  140. constructor Create(aProjMgr: TProjectManager; aIsSplit, AMergeByCode: Boolean);
  141. destructor Destroy; override;
  142. { 把 aProjList 里的标段合并成 aFileName 项目 }
  143. procedure Merge(aProjList: TStrings; const aFileName: string);
  144. { TODO litao : 2011.5.13 }
  145. procedure MergeNew(aProjList: TStrings; const aFileName: string);
  146. { TODO : Split BuildProject }
  147. procedure Split(const aFileName: string);
  148. end;
  149. implementation
  150. uses
  151. SysUtils,
  152. ZjIDTree,
  153. Forms,
  154. ScUpdateDataBase,
  155. DataBase;
  156. { TMergeThread }
  157. constructor TMergeThread.Create(const aFileName: string; aExecuteEvt: TNotifyEvent;
  158. aBillsTree: TScBillsTree);
  159. begin
  160. FGatherTree := TMergeGatherTree.Create;
  161. InitializeCriticalSection(FCriticalSec);
  162. FDoExecute := aExecuteEvt;
  163. FBillsTree := aBillsTree;
  164. if Assigned(FBillsTree) then
  165. FIsOpen := True
  166. else
  167. begin
  168. FArchiver := TScProjectFileArchiver.Create;
  169. FArchiver.FileName := aFileName;
  170. FArchiver.OpenFile;
  171. UpdateDB(FArchiver);
  172. end;
  173. FreeOnTerminate := False;
  174. inherited Create(True);
  175. end;
  176. destructor TMergeThread.Destroy;
  177. begin
  178. FTable.Free;
  179. FGatherTree.Free;
  180. DeleteCriticalSection(FCriticalSec);
  181. if not FIsOpen then
  182. begin
  183. FBillstree.Free;
  184. FDrawTable.Free;
  185. FDspDraw.Free;
  186. FCdsDraw.Free;
  187. FArchiver.Free;
  188. end;
  189. inherited;
  190. end;
  191. procedure TMergeThread.Execute;
  192. begin
  193. inherited;
  194. if Terminated then Exit;
  195. ExecuteBefore;
  196. if Terminated then Exit;
  197. FDoExecute(Self);
  198. end;
  199. procedure TMergeThread.ExecuteBefore;
  200. begin
  201. if not Assigned(FBillsTree) then
  202. begin
  203. FTable := TADOTable.Create(nil);
  204. FTable.Connection := FArchiver.Connection;
  205. FTable.TableName := 'Bills';
  206. FTable.Open;
  207. if Terminated then Exit;
  208. FIsCreate := True;
  209. FDrawTable := TADOTable.Create(nil);
  210. FDrawTable.Connection := FArchiver.Connection;
  211. FDrawTable.TableName := 'DrawingQuantity';
  212. FDspDraw := TDataSetProvider.Create(nil);
  213. FDspDraw.DataSet := FDrawTable;
  214. FCdsDraw := TClientDataSet.Create(nil);
  215. FCdsDraw.SetProvider(FDspDraw);
  216. FCdsDraw.Active := True;
  217. FCdsDraw.IndexFieldNames := sBillsID + ';' + sSerinalNo;
  218. FBillsTree := TAdditinalTree.Create;
  219. FBillsTree.KeyFieldName := SID;
  220. FBillsTree.ParentFieldName := sParentID;
  221. FBillsTree.NextSiblingFieldName := sNextSiblingID;
  222. { because it does not need to write , so can use table,
  223. if it is needed to write ,then should use cds }
  224. FBillsTree.DataSet := FTable;
  225. if Terminated then Exit;
  226. FBillsTree.Active := True;
  227. FIsCreate := False;
  228. end
  229. else
  230. begin
  231. FIsCreate := True;
  232. FCdsDraw := TDMDataBase(FBillsTree.Bills).cdsDrawingQuantity;
  233. FCdsDraw.IndexFieldNames := sBillsID + ';' + sSerinalNo;
  234. FIsCreate := False;
  235. end;
  236. end;
  237. procedure TMergeThread.MergeBillsTree(aThread: TMergeThread);
  238. begin
  239. FGatherTree.IsOpen1 := FIsOpen;
  240. FGatherTree.CdsDraw1 := FCdsDraw;
  241. FGatherTree.GatherBillsTree(FBillsTree);
  242. FGatherTree.IsOpen2 := aThread.FIsOpen;
  243. FGatherTree.CdsDraw2 := aThread.FCdsDraw;
  244. FGatherTree.UpdateBillsTree(aThread.FBillsTree);
  245. end;
  246. procedure TMergeThread.MergeGatherTree(aThread: TMergeThread);
  247. begin
  248. FGatherTree.GatherTree(aThread.FGatherTree);
  249. end;
  250. procedure TMergeThread.MergeTree(aThread: TMergeThread);
  251. begin
  252. WaitThread(aThread);
  253. if FHasGather then
  254. begin
  255. if aThread.FHasGather then
  256. MergeGatherTree(aThread)
  257. else
  258. UpdateGatherTree(aThread);
  259. end
  260. else
  261. begin
  262. if aThread.FHasGather then
  263. UpdateBillsTree(aThread)
  264. else
  265. MergeBillsTree(aThread);
  266. end;
  267. end;
  268. procedure TMergeThread.SetExecuting(const Value: Boolean);
  269. begin
  270. EnterCriticalSection(FCriticalSec);
  271. FExecuting := Value;
  272. LeaveCriticalSection(FCriticalSec);
  273. end;
  274. procedure TMergeThread.UpdateBillsTree(aThread: TMergeThread);
  275. begin
  276. FGatherTree.IsOpen1 := FIsOpen;
  277. FGatherTree.CdsDraw1 := FCdsDraw;
  278. FGatherTree.GatherBillsTree(FBillsTree);
  279. FGatherTree.GatherTree(aThread.FGatherTree);
  280. end;
  281. procedure TMergeThread.UpdateGatherTree(aThread: TMergeThread);
  282. begin
  283. // FGatherTree.BillsTree1 := nil;
  284. FGatherTree.IsOpen2 := aThread.FIsOpen;
  285. FGatherTree.CdsDraw2 := aThread.FCdsDraw;
  286. FGatherTree.UpdateBillsTree(aThread.FBillsTree);
  287. end;
  288. procedure TMergeThread.WaitThread(aProjThread: TMergeThread);
  289. begin
  290. while (aProjThread.FBillsTree = nil) or aProjThread.FIsCreate do
  291. begin
  292. Sleep(100);
  293. end;
  294. end;
  295. { TProjectConverter }
  296. procedure TProjectConverter.DeleteAllRecords(aQuery: TADOQuery);
  297. begin
  298. with aQuery do
  299. begin
  300. SQL.Clear;
  301. SQL.Add('Delete * From Bills');
  302. ExecSQL;
  303. SQL.Clear;
  304. SQL.Add('Delete * From DrawingQuantity');
  305. ExecSQL;
  306. SQL.Clear;
  307. SQL.Add('Delete * From Exprs');
  308. ExecSQL;
  309. end;
  310. end;
  311. constructor TProjectConverter.Create(aProjMgr: TProjectManager; aIsSplit, AMergeByCode: Boolean);
  312. begin
  313. FProjectList := TThreadList.Create;
  314. FFileDir := ExtractFilePath(ParamStr(0));
  315. FProjectMgr := aProjMgr;
  316. FSrcTree := TMergeGatherTree.Create;
  317. FSrcTree.MergeByCode := AMergeByCode;
  318. FIsSplit := aIsSplit;
  319. if FIsSplit then
  320. begin
  321. FBillsTable := TADOTable.Create(nil);
  322. FDrawTable := TADOTable.Create(nil);
  323. FDrawDsp := TDataSetProvider.Create(nil);
  324. FDrawCds := TClientDataSet.Create(nil);
  325. FBillsTree := TAdditinalTree.Create;
  326. FBillsTable.TableName := 'Bills';
  327. FBillsTree.DataSet := FBillsTable;
  328. FBillsTree.KeyFieldName := SID;
  329. FBillsTree.ParentFieldName := sParentID;
  330. FBillsTree.NextSiblingFieldName := sNextSiblingID;
  331. FDrawTable.TableName := 'DrawingQuantity';
  332. FDrawDsp.DataSet := FDrawTable;
  333. FDrawCds.SetProvider(FDrawDsp);
  334. FDrawCds.IndexFieldNames := sBillsID;
  335. end;
  336. end;
  337. destructor TProjectConverter.Destroy;
  338. begin
  339. FProjectList.Free;
  340. FSrcTree.Free;
  341. if FIsSplit then
  342. begin
  343. FBillsTable.Free;
  344. FDrawTable.Free;
  345. FDrawDsp.Free;
  346. FDrawCds.Free;
  347. FBillsTree.Free;
  348. end;
  349. inherited;
  350. end;
  351. procedure TProjectConverter.DoMerge(aThread: TObject);
  352. var
  353. pctThread: TMergeThread;
  354. begin
  355. pctThread := GetOperateThread(TMergeThread(aThread));
  356. if Assigned(pctThread) then
  357. begin
  358. if TMergeThread(aThread).Terminated then Exit;
  359. TMergeThread(aThread).MergeTree(pctThread);
  360. TMergeThread(aThread).FHasGather := True;
  361. TMergeThread(aThread).Executing := False;
  362. if aThread <> pctThread then
  363. begin
  364. RemoveThread(pctThread);
  365. pctThread.FreeOnTerminate := True;
  366. pctThread.Terminate;
  367. end
  368. else Exit;
  369. end
  370. else Exit;
  371. if TMergeThread(aThread).Terminated then Exit;
  372. DoMerge(aThread);
  373. end;
  374. procedure TProjectConverter.ExecuteMerge;
  375. var
  376. I: Integer;
  377. thrList: TList;
  378. begin
  379. thrList := FProjectList.LockList;
  380. try
  381. for I := 0 to thrList.Count - 1 do
  382. begin
  383. TMergeThread(thrList.List^[I]).Resume;
  384. end;
  385. finally
  386. FProjectList.UnlockList;
  387. end;
  388. end;
  389. procedure TProjectConverter.Merge(aProjList: TStrings;
  390. const aFileName: string);
  391. begin
  392. // 1. 打开标段
  393. OpenProjects(aProjList);
  394. // 2. 合并标段
  395. ExecuteMerge;
  396. // 3. 把数据写入建设项目
  397. WriteBuildProject(aFileName);
  398. end;
  399. function TProjectConverter.OpenProject(const aFileName: string; aBillsTree: TScBillsTree): TMergeThread;
  400. begin
  401. Result := TMergeThread.Create(aFileName, DoMerge, aBillsTree);
  402. end;
  403. procedure TProjectConverter.OpenProjects(aProjList: TStrings);
  404. var
  405. I, iIdx: Integer;
  406. sFileName: string;
  407. sbtTree: TScBillsTree;
  408. pctThread: TMergeThread;
  409. begin
  410. if aProjList.Count = 0 then
  411. begin
  412. FDoneOver := True;
  413. Exit;
  414. end;
  415. for I := 0 to aProjList.Count - 1 do
  416. begin
  417. sbtTree := nil;
  418. sFileName := FFileDir + aProjList[I];
  419. iIdx := FProjectMgr.CheckProjectExists(sFileName);
  420. if iIdx <> -1 then
  421. sbtTree := FProjectMgr.Projects[iIdx].BillsData.BillsTree;
  422. pctThread := OpenProject(sFileName, sbtTree);
  423. FProjectList.Add(pctThread);
  424. end;
  425. end;
  426. procedure TProjectConverter.Split(const aFileName: string);
  427. var
  428. bOpened: Boolean;
  429. sgsBidLots: TStrings;
  430. pfArchiver: TScProjectFileArchiver;
  431. begin
  432. sgsBidLots := TStringList.Create;
  433. try
  434. { 1. Open BuildProject, and get Bidlot List }
  435. pfArchiver := OpenBuildProject(aFileName, sgsBidLots, bOpened);
  436. try
  437. if pfArchiver = nil then Exit;
  438. { 2. begin Split }
  439. ExecuteSplit(sgsBidLots, pfArchiver);
  440. { 3. end Split }
  441. WaitOverWithSync;
  442. finally
  443. if not bOpened then pfArchiver.Free;
  444. end;
  445. finally
  446. sgsBidLots.Free;
  447. end;
  448. end;
  449. procedure TProjectConverter.WriteBuildProject(const aFileName: string);
  450. var
  451. iIdx: Integer;
  452. // pctThread: TMergeThread;
  453. begin
  454. // WaitUntilOver;
  455. // if not GetThread(pctThread) then Exit;
  456. iIdx := FProjectMgr.CheckProjectExists(FFileDir + aFileName);
  457. if iIdx <> -1 then
  458. begin
  459. FSrcTree.TraverseOwnerIntoDB(FProjectMgr.Projects[iIdx]);
  460. //pctThread.FGatherTree.TraverseOwnerIntoDB(FProjectMgr.Projects[iIdx]);
  461. end
  462. else
  463. WriteProjectUnOpened({pctThread} nil, aFileName);
  464. // pctThread.Free;
  465. end;
  466. procedure TProjectConverter.WriteDB(aBillsTable, aDrawTable: TDataSet;
  467. aThread: TMergeThread);
  468. begin
  469. aBillsTable.Open;
  470. aDrawTable.Open;
  471. //aThread.FGatherTree.WriteTo(aBillsTable, aDrawTable);
  472. end;
  473. procedure TProjectConverter.WaitUntilOver;
  474. begin
  475. while not FDoneOver do
  476. begin
  477. Sleep(100);
  478. end;
  479. end;
  480. function TProjectConverter.GetThread(var aThread: TMergeThread): Boolean;
  481. var
  482. thrList: TList;
  483. begin
  484. Result := True;
  485. thrList := FProjectList.LockList;
  486. try
  487. if thrList.Count = 0 then
  488. Result := False
  489. else
  490. aThread := TMergeThread(thrList[0]);
  491. finally
  492. FProjectList.UnlockList;
  493. end;
  494. end;
  495. procedure TProjectConverter.RemoveThread(aThread: TMergeThread);
  496. var
  497. thrList: TList;
  498. begin
  499. thrList := FProjectList.LockList;
  500. try
  501. thrList.Remove(aThread);
  502. finally
  503. FProjectList.UnlockList;
  504. end;
  505. end;
  506. procedure TProjectConverter.WriteProjectUnOpened(aThread: TMergeThread; const aFileName: string);
  507. var
  508. aqQuery: TADOQuery;
  509. atDrawTable: TADOTable;
  510. atBillsTable: TADOTable;
  511. atExprs: TADOTable;
  512. dspDraw: TDataSetProvider;
  513. dspBills: TDataSetProvider;
  514. dspExprs: TDataSetProvider;
  515. cdsDraw: TClientDataSet;
  516. cdsBills: TClientDataSet;
  517. cdsExprs: TClientDataSet;
  518. pfaArchiver: TScProjectFileArchiver;
  519. begin
  520. pfaArchiver := TScProjectFileArchiver.Create;
  521. aqQuery := TADOQuery.Create(nil);
  522. atBillsTable := TADOTable.Create(nil);
  523. atDrawTable := TADOTable.Create(nil);
  524. atExprs := TADOTable.Create(nil);
  525. dspDraw := TDataSetProvider.Create(nil);
  526. dspBills := TDataSetProvider.Create(nil);
  527. dspExprs := TDataSetProvider.Create(nil);
  528. cdsDraw := TClientDataSet.Create(nil);
  529. cdsBills := TClientDataSet.Create(nil);
  530. cdsExprs := TClientDataSet.Create(nil);
  531. try
  532. pfaArchiver.FileName := FFileDir + aFileName;
  533. pfaArchiver.OpenFile;
  534. aqQuery.Connection := pfaArchiver.Connection;
  535. DeleteAllRecords(aqQuery);
  536. atBillsTable.Connection := pfaArchiver.Connection;
  537. atBillsTable.TableName := 'Bills';
  538. dspBills.DataSet := atBillsTable;
  539. cdsBills.SetProvider(dspBills);
  540. // 有相同的Owner下才能用ProviderName,否则应用SetProvider,具体Help有写明
  541. // cdsBills.ProviderName := 'dspBills';
  542. atDrawTable.Connection := pfaArchiver.Connection;
  543. atDrawTable.TableName := 'DrawingQuantity';
  544. dspDraw.DataSet := atDrawTable;
  545. cdsDraw.SetProvider(dspDraw);
  546. atExprs.Connection := pfaArchiver.Connection;
  547. atExprs.TableName := 'Exprs';
  548. dspExprs.DataSet := atExprs;
  549. cdsExprs.SetProvider(dspExprs);
  550. // cdsDraw.ProviderName := 'dspDraw';
  551. cdsBills.Open;
  552. cdsDraw.Open;
  553. cdsExprs.Open;
  554. FSrcTree.WriteTo(cdsBills, cdsDraw, cdsExprs);
  555. //WriteDB(cdsBills, cdsDraw, aThread);
  556. cdsBills.ApplyUpdates(0);
  557. cdsDraw.ApplyUpdates(0);
  558. cdsExprs.ApplyUpdates(0);
  559. pfaArchiver.Save;
  560. finally
  561. pfaArchiver.Free;
  562. aqQuery.Free;
  563. atBillsTable.Free;
  564. atDrawTable.Free;
  565. dspDraw.Free;
  566. dspBills.Free;
  567. cdsDraw.Free;
  568. cdsBills.Free;
  569. atExprs.Free;
  570. dspExprs.Free;
  571. cdsExprs.Free;
  572. end;
  573. end;
  574. function TProjectConverter.GetOperateThread(
  575. aThread: TMergeThread): TMergeThread;
  576. var
  577. I: Integer;
  578. bWait: Boolean;
  579. pctList: TList;
  580. pctThread: TMergeThread;
  581. begin
  582. Result := nil;
  583. if WaitUntilTerminated(aThread) then Exit;
  584. bWait := True;
  585. while bWait do
  586. begin
  587. pctList := FProjectList.LockList;
  588. try
  589. if pctList.Count <= 1 then
  590. begin
  591. NotifyExecuteOver;
  592. Result := aThread;
  593. Break;
  594. end;
  595. if aThread.Terminated then Break;
  596. for I := 0 to pctList.Count - 1 do
  597. begin
  598. pctThread := TMergeThread(pctList.List^[I]);
  599. if pctThread <> aThread then
  600. begin
  601. if not pctThread.FExecuting then
  602. begin
  603. aThread.Executing := True;
  604. pctThread.Executing := True;
  605. Result := pctThread;
  606. bWait := False;
  607. Break;
  608. end;
  609. end;
  610. end;
  611. finally
  612. FProjectList.UnlockList;
  613. end;
  614. if bWait then
  615. Sleep(100);
  616. end;
  617. end;
  618. function TProjectConverter.WaitUntilTerminated(aThread: TMergeThread): Boolean;
  619. begin
  620. Result := False;
  621. while aThread.FExecuting do
  622. begin
  623. if aThread.Terminated then
  624. begin
  625. Result := True;
  626. Break;
  627. end;
  628. Sleep(100);
  629. end;
  630. end;
  631. procedure TProjectConverter.ExecuteSplit(aStrings: TStrings;
  632. aArchiver: TScProjectFileArchiver);
  633. var
  634. I: Integer;
  635. iIdx: Integer;
  636. sAliasName: string;
  637. sFullName: string;
  638. ThrSplit: TSplitThread;
  639. begin
  640. if aStrings.Count = 0 then Exit;
  641. FBillsTable.Connection := aArchiver.Connection;
  642. FBillsTree.Active := True;
  643. FDrawTable.Connection := aArchiver.Connection;
  644. FDrawCds.Active := True;
  645. for I := 0 to aStrings.Count - 1 do
  646. begin
  647. sAliasName := aStrings[I];
  648. sFullName := FFileDir + string(aStrings.Objects[I]);
  649. ThrSplit := TSplitThread.Create(FProjectList, sAliasName, sFullName);
  650. ThrSplit.FOwnerBillsTree := FBillsTree;
  651. ThrSplit.FOwnerDrawCds := FDrawCds;
  652. ThrSplit.FProjectMgr := FProjectMgr;
  653. ThrSplit.FSplitOverEvt := NotifyExecuteOver;
  654. ThrSplit.FBeginSynchronize := BeginSynchronize;
  655. ThrSplit.FEndSynchronize := EndSynchronize;
  656. iIdx := FProjectMgr.CheckProjectExists(sFullName);
  657. if iIdx <> -1 then
  658. begin
  659. ThrSplit.FBidBillsCds := FProjectMgr.Projects[iIdx].BillsData.cdsBills;
  660. ThrSplit.FBidDrawCds := FProjectMgr.Projects[iIdx].BillsData.cdsDrawingQuantity;
  661. end;
  662. ThrSplit.BeginExecute;
  663. end;
  664. end;
  665. function TProjectConverter.OpenBuildProject(const aFullName: string;
  666. aStrings: TStrings; var aIsOpened: Boolean): TScProjectFileArchiver;
  667. var
  668. iIdx: Integer;
  669. begin
  670. iIdx := FProjectMgr.CheckProjectExists(FFileDir + aFullName);
  671. if iIdx = -1 then
  672. begin
  673. { BuildProject is not Opened }
  674. Result := TScProjectFileArchiver.Create;
  675. Result.FileName := FFileDir + aFullName;
  676. if not Result.OpenFile then
  677. begin
  678. FreeAndNil(Result);
  679. Exit;
  680. end;
  681. aIsOpened := False;
  682. end
  683. else
  684. begin
  685. { BuildProject Has been Opened }
  686. Result := FProjectMgr.Projects[iIdx].Archiver;
  687. Result.Save;
  688. aIsOpened := True;
  689. end;
  690. { Get Extract BidlotList }
  691. QueryExtractBidLots(Result, aStrings);
  692. end;
  693. procedure TProjectConverter.QueryExtractBidLots(
  694. aArchiver: TScProjectFileArchiver; aStrings: TStrings);
  695. var
  696. aqQuery: TADOQuery;
  697. sAliasName: string;
  698. sFullName: string;
  699. begin
  700. aqQuery := TADOQuery.Create(nil);
  701. try
  702. aqQuery.Connection := aArchiver.Connection;
  703. with aqQuery do
  704. begin
  705. SQL.Text := 'Select AliasName, FullName From BidLot ' +
  706. 'Where AliasName in ' +
  707. '(Select Distinct OwnerName From Bills ' +
  708. 'Where (not IsNull(OwnerName)) and (OwnerName<>''''))';
  709. Open;
  710. First;
  711. while not Eof do
  712. begin
  713. sAliasName := FieldByName('AliasName').AsString;
  714. sFullName := FieldByName('FullName').AsString;
  715. aStrings.AddObject(sAliasName, Pointer(sFullName));
  716. Integer(sFullName) := 0;
  717. Next;
  718. end;
  719. end;
  720. finally
  721. aqQuery.Free;
  722. end;
  723. end;
  724. procedure TProjectConverter.NotifyExecuteOver;
  725. begin
  726. FDoneOver := True;
  727. end;
  728. procedure TProjectConverter.WaitOverWithSync;
  729. begin
  730. while not FDoneOver do
  731. begin
  732. Sleep(100);
  733. if FSynchronize > 0 then
  734. Application.ProcessMessages;
  735. end;
  736. end;
  737. procedure TProjectConverter.BeginSynchronize;
  738. begin
  739. InterlockedIncrement(FSynchronize);
  740. end;
  741. procedure TProjectConverter.EndSynchronize;
  742. begin
  743. InterlockedDecrement(FSynchronize);
  744. end;
  745. procedure TProjectConverter.MergeNew(aProjList: TStrings;
  746. const aFileName: string);
  747. begin
  748. CreateProgressForm(15, '正在合并树结构!');
  749. MergeTree(aProjList);
  750. CreateProgressForm(45, '正在合并写入数据!');
  751. WriteBuildProject(aFileName);
  752. CreateProgressForm(99, '合并清单完成!');
  753. end;
  754. procedure TProjectConverter.MergeTree(AProjList: TStrings);
  755. var
  756. atDrawTable1: TADOTable;
  757. atBillsTable1: TADOTable;
  758. dspDraw1: TDataSetProvider;
  759. dspBills1: TDataSetProvider;
  760. cdsDraw1: TClientDataSet;
  761. cdsBills1: TClientDataSet;
  762. atDrawTable2: TADOTable;
  763. atBillsTable2: TADOTable;
  764. dspDraw2: TDataSetProvider;
  765. dspBills2: TDataSetProvider;
  766. cdsDraw2: TClientDataSet;
  767. cdsBills2: TClientDataSet;
  768. arArchiver1: TScProjectFileArchiver;
  769. arArchiver2: TScProjectFileArchiver;
  770. BillsTree1: TScBillsTree;
  771. BillsTree2: TScBillsTree;
  772. atExprs: TADOTable;
  773. dspExprs: TDataSetProvider;
  774. cdsExprs: TClientDataSet;
  775. procedure InnerCreate;
  776. begin
  777. atDrawTable1 := TADOTable.Create(nil);
  778. atBillsTable1 := TADOTable.Create(nil);
  779. dspDraw1 := TDataSetProvider.Create(nil);
  780. dspBills1 := TDataSetProvider.Create(nil);
  781. cdsDraw1 := TClientDataSet.Create(nil);
  782. cdsBills1 := TClientDataSet.Create(nil);
  783. atDrawTable2 := TADOTable.Create(nil);
  784. atBillsTable2 := TADOTable.Create(nil);
  785. dspDraw2 := TDataSetProvider.Create(nil);
  786. dspBills2 := TDataSetProvider.Create(nil);
  787. cdsDraw2 := TClientDataSet.Create(nil);
  788. cdsBills2 := TClientDataSet.Create(nil);
  789. atExprs := TADOTable.Create(nil);
  790. dspExprs := TDataSetProvider.Create(nil);
  791. cdsExprs := TClientDataSet.Create(nil);
  792. atDrawTable1.TableName := 'DrawingQuantity';
  793. dspDraw1.DataSet := atDrawTable1;
  794. cdsDraw1.SetProvider(dspDraw1);
  795. cdsDraw1.IndexFieldNames := sBillsID + ';' + sSerinalNo;
  796. atBillsTable1.TableName := 'Bills';
  797. dspBills1.DataSet := atBillsTable1;
  798. cdsBills1.SetProvider(dspBills1);
  799. atDrawTable2.TableName := 'DrawingQuantity';
  800. dspDraw2.DataSet := atDrawTable2;
  801. cdsDraw2.SetProvider(dspDraw2);
  802. cdsDraw2.IndexFieldNames := sBillsID + ';' + sSerinalNo;
  803. atBillsTable2.TableName := 'Bills';
  804. dspBills2.DataSet := atBillsTable2;
  805. cdsBills2.SetProvider(dspBills2);
  806. atExprs.TableName := 'Exprs';
  807. dspExprs.DataSet := atExprs;
  808. cdsExprs.SetProvider(dspExprs);
  809. cdsExprs.IndexFieldNames := 'MajorID;MinorID;RecdID';
  810. arArchiver1 := TScProjectFileArchiver.Create;
  811. arArchiver2 := TScProjectFileArchiver.Create;
  812. BillsTree1 := nil;
  813. BillsTree2 := nil;
  814. end;
  815. procedure InnerFree;
  816. begin
  817. atDrawTable1.Free;
  818. atBillsTable1.Free;
  819. dspDraw1.Free;
  820. dspBills1.Free;
  821. cdsDraw1.Free;
  822. cdsBills1.Free;
  823. atDrawTable2.Free;
  824. atBillsTable2.Free;
  825. dspDraw2.Free;
  826. dspBills2.Free;
  827. cdsDraw2.Free;
  828. cdsBills2.Free;
  829. arArchiver1.Free;
  830. arArchiver2.Free;
  831. atExprs.Free;
  832. dspExprs.Free;
  833. cdsExprs.Free;
  834. end;
  835. procedure InnerOpen1(const AFileName: string);
  836. begin
  837. arArchiver1.FileName := AFileName;
  838. arArchiver1.OpenFile;
  839. UpdateDB(arArchiver1);
  840. atDrawTable1.Connection := arArchiver1.Connection;
  841. atBillsTable1.Connection := arArchiver1.Connection;
  842. atExprs.Connection := arArchiver1.Connection;
  843. cdsDraw1.Open;
  844. cdsBills1.Open;
  845. cdsExprs.SetProvider(dspExprs);
  846. cdsExprs.Open;
  847. BillsTree1 := TAdditinalTree.Create;
  848. BillsTree1.KeyFieldName := SID;
  849. BillsTree1.ParentFieldName := sParentID;
  850. BillsTree1.NextSiblingFieldName := sNextSiblingID;
  851. BillsTree1.DataSet := atBillsTable1;
  852. BillsTree1.Active := True;
  853. end;
  854. procedure InnerOpen2(const AFileName: string);
  855. begin
  856. if arArchiver2.IsOpened then
  857. arArchiver2.CloseFile;
  858. arArchiver2.FileName := AFileName;
  859. arArchiver2.OpenFile;
  860. UpdateDB(arArchiver2);
  861. atDrawTable2.Connection := arArchiver2.Connection;
  862. atBillsTable2.Connection := arArchiver2.Connection;
  863. atExprs.Connection := arArchiver2.Connection;
  864. cdsDraw2.Open;
  865. cdsBills2.Open;
  866. cdsExprs.SetProvider(dspExprs);
  867. cdsExprs.Open;
  868. BillsTree2 := TAdditinalTree.Create;
  869. BillsTree2.KeyFieldName := SID;
  870. BillsTree2.ParentFieldName := sParentID;
  871. BillsTree2.NextSiblingFieldName := sNextSiblingID;
  872. BillsTree2.DataSet := atBillsTable2;
  873. BillsTree2.Active := True;
  874. end;
  875. var
  876. I: Integer;
  877. iIdx: Integer;
  878. strFileName: string;
  879. begin
  880. InnerCreate;
  881. try
  882. CreateProgressForm(AProjList.Count, '正在合并树结构!');
  883. for I := 0 to AProjList.Count - 1 do
  884. begin
  885. //RefreshProgressForm(I + 1, '正在合并树结构…');
  886. strFileName := FFileDir + AProjList[I];
  887. RefreshProgressForm(I + 1, '正在处理 ' + strFileName + ' 文件');
  888. iIdx := FProjectMgr.CheckProjectExists(strFileName);
  889. cdsExprs.Close;
  890. if iIdx <> -1 then
  891. begin
  892. if BillsTree1 = nil then
  893. begin
  894. BillsTree1 := FProjectMgr.Projects[iIdx].BillsData.BillsTree;
  895. atDrawTable1.Connection := FProjectMgr.Projects[iIdx].Connection;
  896. cdsDraw1.Open;
  897. atExprs.Connection := FProjectMgr.Projects[iIdx].Connection;
  898. cdsExprs.SetProvider(dspExprs);
  899. cdsExprs.Open;
  900. FSrcTree.IsOpen1 := True;
  901. FSrcTree.CdsDraw1 := cdsDraw1;
  902. FSrcTree.CdsExprs := cdsExprs;
  903. FSrcTree.GatherBillsTree(BillsTree1);
  904. end
  905. else
  906. begin
  907. BillsTree2 := FProjectMgr.Projects[iIdx].BillsData.BillsTree;
  908. atDrawTable2.Connection := FProjectMgr.Projects[iIdx].Connection;
  909. atExprs.Connection := FProjectMgr.Projects[iIdx].Connection;
  910. cdsDraw2.Open;
  911. cdsExprs.SetProvider(dspExprs);
  912. cdsExprs.Open;
  913. FSrcTree.IsOpen2 := True;
  914. FSrcTree.CdsDraw2 := cdsDraw2;
  915. FSrcTree.CdsExprs := cdsExprs;
  916. FSrcTree.UpdateBillsTree(BillsTree2);
  917. end;
  918. end
  919. else
  920. begin
  921. if BillsTree1 = nil then
  922. begin
  923. InnerOpen1(strFileName);
  924. FSrcTree.IsOpen1 := False;
  925. FSrcTree.CdsDraw1 := cdsDraw1;
  926. FSrcTree.CdsExprs := cdsExprs;
  927. FSrcTree.GatherBillsTree(BillsTree1);
  928. BillsTree1.Free;
  929. end
  930. else
  931. begin
  932. InnerOpen2(strFileName);
  933. FSrcTree.IsOpen2 := False;
  934. FSrcTree.CdsDraw2 := cdsDraw2;
  935. FSrcTree.UpdateBillsTree(BillsTree2);
  936. BillsTree2.Free;
  937. end;
  938. end;
  939. end;
  940. CloseProgressForm;
  941. finally
  942. InnerFree;
  943. end;
  944. end;
  945. { TSplitThread }
  946. procedure TSplitThread.AddToList;
  947. var
  948. thrList: TList;
  949. begin
  950. thrList := FThreadList.LockList;
  951. try
  952. thrList.Add(Self);
  953. finally
  954. FThreadList.UnlockList;
  955. end;
  956. end;
  957. procedure TSplitThread.BeginExecute;
  958. begin
  959. Resume;
  960. end;
  961. constructor TSplitThread.Create(aThreadList: TThreadList; const aShortName, aFilePath: string);
  962. begin
  963. FThreadList := aThreadList;
  964. FBidShortName := aShortName;
  965. FBidFilePath := aFilePath;
  966. FGatherTree := TSplitGatherTree.Create;
  967. AddToList;
  968. if not OpenArchiverFile then Exit;
  969. FreeOnTerminate := True;
  970. inherited Create(True);
  971. end;
  972. procedure TSplitThread.DeleteAll;
  973. var
  974. acCommand: TADOCommand;
  975. begin
  976. if FBidArchiver = nil then Exit;
  977. acCommand := TADOCommand.Create(nil);
  978. try
  979. acCommand.Connection := FBidArchiver.Connection;
  980. acCommand.CommandText := 'Delete * From Bills';
  981. acCommand.Execute;
  982. acCommand.CommandText := 'Delete * From DrawingQuantity';
  983. acCommand.Execute;
  984. finally
  985. acCommand.Free;
  986. end;
  987. end;
  988. destructor TSplitThread.Destroy;
  989. begin
  990. if not FIsOpened then
  991. begin
  992. FBidArchiver.Free;
  993. FBidBillsTable.Free;
  994. FBidBillsDsp.Free;
  995. FBidBillsCds.Free;
  996. FBidDrawTable.Free;
  997. FBidDrawDsp.Free;
  998. FBidDrawCds.Free;
  999. end;
  1000. FGatherTree.Free;
  1001. RemoveFormList;
  1002. inherited;
  1003. end;
  1004. procedure TSplitThread.DoBeforeExecute;
  1005. begin
  1006. if (FBidBillsCds = nil) or (FBidDrawCds = nil) then
  1007. begin
  1008. { 打开加密文件只能在主线程里完成,否则会出错 }
  1009. {FBidArchiver := TScProjectFileArchiver.Create;
  1010. FBidArchiver.FileName := aFilePath;
  1011. if not FBidArchiver.OpenFile then begin Terminate; Exit; end;}
  1012. FBidBillsTable := TADOTable.Create(nil);
  1013. FBidBillsTable.Connection := FBidArchiver.Connection;
  1014. FBidBillsTable.TableName := 'Bills';
  1015. FBidBillsDsp := TDataSetProvider.Create(nil);
  1016. FBidBillsDsp.DataSet := FBidBillsTable;
  1017. FBidBillsCds := TClientDataSet.Create(nil);
  1018. FBidBillsCds.SetProvider(FBidBillsDsp);
  1019. // FBidBillsCds.Active := True;
  1020. FBidDrawTable := TADOTable.Create(nil);
  1021. FBidDrawTable.Connection := FBidArchiver.Connection;
  1022. FBidDrawTable.TableName := 'DrawingQuantity';
  1023. FBidDrawDsp := TDataSetProvider.Create(nil);
  1024. FBidDrawDsp.DataSet := FBidDrawTable;
  1025. FBidDrawCds := TClientDataSet.Create(nil);
  1026. FBidDrawCds.SetProvider(FBidDrawDsp);
  1027. // FBidDrawCds.Active := True;
  1028. end
  1029. else
  1030. FIsOpened := True;
  1031. end;
  1032. procedure TSplitThread.Execute;
  1033. begin
  1034. inherited;
  1035. DoBeforeExecute;
  1036. if Terminated then Exit;
  1037. { Split Tree }
  1038. FGatherTree.SplitBillsTree(FOwnerBillsTree, FOwnerDrawCds, FBidShortName);
  1039. { Write DB }
  1040. WriteGatherTreeToDB;
  1041. end;
  1042. function TSplitThread.OpenArchiverFile: Boolean;
  1043. begin
  1044. FBidArchiver := TScProjectFileArchiver.Create;
  1045. FBidArchiver.FileName := FBidFilePath;
  1046. Result := FBidArchiver.OpenFile;
  1047. UpdateDB(FBidArchiver);
  1048. end;
  1049. procedure TSplitThread.RemoveFormList;
  1050. var
  1051. thrList: TList;
  1052. begin
  1053. thrList := FThreadList.LockList;
  1054. try
  1055. thrList.Remove(Self);
  1056. if thrList.Count = 0 then FSplitOverEvt;
  1057. finally
  1058. FThreadList.UnlockList;
  1059. end;
  1060. end;
  1061. procedure TSplitThread.WriteGatherTreeToDB;
  1062. begin
  1063. FProjectIdx := FProjectMgr.CheckProjectExists(FBidFilePath);
  1064. if FProjectIdx <> -1 then
  1065. begin
  1066. FBeginSynchronize;
  1067. try
  1068. Synchronize(WriteGatherTreeToOpenedDB);
  1069. finally
  1070. FEndSynchronize;
  1071. end;
  1072. end
  1073. else
  1074. begin
  1075. DeleteAll;
  1076. FBidBillsCds.Active := True;
  1077. FBidDrawCds.Active := True;
  1078. FGatherTree.WriteTo(FBidBillsCds, FBidDrawCds, nil);
  1079. FBidBillsCds.ApplyUpdates(0);
  1080. FBidDrawCds.ApplyUpdates(0);
  1081. FBidArchiver.Save;
  1082. end;
  1083. end;
  1084. procedure TSplitThread.WriteGatherTreeToOpenedDB;
  1085. begin
  1086. FGatherTree.TraverseOwnerIntoDB(FProjectMgr.Projects[FProjectIdx]);
  1087. end;
  1088. end.