rpgGatherData.pas 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449
  1. unit rpgGatherData;
  2. interface
  3. uses
  4. ADODB, ProjGather, rpgGatherProjDm, rpgBillsDm, rpgBillsCalcDm, Classes,
  5. ScAutoUpdateUnit, ProjGatherTree, GatherProjInfo;
  6. type
  7. TrpgGatherData = class
  8. private
  9. FGatherFile: string;
  10. FConnection: TADOConnection;
  11. procedure ClearHistoryData;
  12. procedure CreateDataTables(AProjCount, ASProjCount: Integer);
  13. procedure SaveGatherProjInfo(AProjs, ASProjs: TList);
  14. procedure SaveBills(ATree: TProjGatherTree);
  15. procedure SaveBillsGatherCalc(ATree: TProjGatherTree);
  16. procedure SaveBillsProjCalc(ATree: TProjGatherTree; AProjIndex: Integer);
  17. procedure SaveBillsSpecialProjCalc(ATree: TProjGatherTree; AProjType: Integer);
  18. procedure CalcDgnData(const ATableName: string);
  19. procedure CalcOtherData(AProjCount, ASProjCount: Integer);
  20. procedure TransposeProjCalc(AProjCount: Integer);
  21. function GetCacheProjFile(AProj: TGatherProjInfo): string;
  22. procedure CopyBGLData(const AFileName: string; AProjIndex, AProjType: Integer);
  23. procedure CopyProjRelaGatherData(AProj: TGatherProjInfo; AProjIndex: Integer);
  24. function GetCurSpecialProjCount: Integer;
  25. protected
  26. procedure AddTables(AProjCount, ASProjCount: Integer; AUpdater: TScUpdater); virtual;
  27. procedure SaveGatherData(AGather: TProjGather); virtual;
  28. procedure CopyRelaGatherData(AGather: TProjGather); virtual;
  29. public
  30. constructor Create;
  31. destructor Destroy; override;
  32. procedure WriteGatherData(AGather: TProjGather);
  33. procedure LoadRelaData(AProjectID: Integer);
  34. procedure UpdateDataBase(ASpecialProjTypes: TStrings);
  35. property GatherFile: string read FGatherFile;
  36. property Connection: TADOConnection read FConnection;
  37. end;
  38. implementation
  39. uses
  40. UtilMethods, SysUtils, Connections, ZhAPI, rProjGatherTables,
  41. ConditionalDefines, ProjectData, Globals;
  42. { TrpgGatherData }
  43. procedure TrpgGatherData.AddTables(AProjCount, ASProjCount: Integer;
  44. AUpdater: TScUpdater);
  45. var
  46. iProj: Integer;
  47. begin
  48. AUpdater.AddTableDef(SGatherProj, @tdGatherProj, Length(tdGatherProj), False, False);
  49. AUpdater.AddTableDef(SBills, @tdBills, Length(tdBills), False, False);
  50. AUpdater.AddTableDef(SBills_Gather, @tdBills_Calc, Length(tdBills_Calc), False, False);
  51. for iProj := 0 to AProjCount - 1 do
  52. AUpdater.AddTableDef(SBills_Proj+IntToStr(iProj+1), @tdBills_Calc, Length(tdBills_Calc), False, False);
  53. AUpdater.AddTableDef(SBills_TransProj, @tdBills_Calc, Length(tdBills_Calc), False, False);
  54. for iProj := 0 to ASProjCount - 1 do
  55. AUpdater.AddTableDef(SBills_SProj+IntToStr(iProj+1), @tdBills_Calc, Length(tdBills_Calc), False, False);
  56. AUpdater.AddTableDef(SBGL_TransProj, @tdBGL_TransProj, Length(tdBGL_TransProj), False, False);
  57. end;
  58. procedure TrpgGatherData.CalcDgnData(const ATableName: string);
  59. const
  60. sFinalDgn = 'Update %s Set'+
  61. ' FinalDgnQuantity1 = DealDgnQuantity1 + CDgnQuantity1,'+
  62. ' FinalDgnQuantity2 = DealDgnQuantity2 + CDgnQuantity2';
  63. sDgnPrice1_2 = 'Update %s Set'+
  64. ' DgnPrice1 = iif(DgnQuantity1 <> 0, TotalPrice/DgnQuantity1, 0),'+
  65. ' DgnPrice1_Rc = iif(DgnQuantity1 <> 0, TotalPrice_Rc/DgnQuantity1, 0),'+
  66. ' DgnPrice2 = iif(DgnQuantity2 <> 0, TotalPrice/DgnQuantity2, 0),'+
  67. ' DgnPrice2_Rc = iif(DgnQuantity2 <> 0, TotalPrice_Rc/DgnQuantity2, 0),'+
  68. ' FinalDgnPrice1 = iif(FinalDgnQuantity1 <> 0, AddGatherTotalPrice/FinalDgnQuantity1, 0),'+
  69. ' FinalDgnPrice1_Rc = iif(FinalDgnQuantity1 <> 0, AddGatherTotalPrice_Rc/FinalDgnQuantity1, 0),'+
  70. ' FinalDgnPrice2 = iif(FinalDgnQuantity2 <> 0, AddGatherTotalPrice/FinalDgnQuantity2, 0),'+
  71. ' FinalDgnPrice2_Rc = iif(FinalDgnQuantity2 <> 0, AddGatherTotalPrice_Rc/FinalDgnQuantity2, 0)';
  72. sDgn = 'Update %s Set'+
  73. ' DgnQuantity = iif(DgnQuantity1 <> 0, iif(DgnQuantity2 <> 0, DgnQuantity1&''/''&DgnQuantity2, DgnQuantity1), ''''),'+
  74. ' DgnPrice = iif(DgnPrice1 <> 0, iif(DgnPrice2 <> 0, DgnPrice1&''/''&DgnPrice2, DgnPrice1), ''''),'+
  75. ' DgnPrice_Rc = iif(DgnPrice1_Rc <> 0, iif(DgnPrice2_Rc <> 0, DgnPrice1_Rc&''/''&DgnPrice2_Rc, DgnPrice1_Rc), ''''),'+
  76. ' DealDgnQuantity = iif(DealDgnQuantity1 <> 0, iif(DealDgnQuantity2 <> 0, DealDgnQuantity1&''/''&DealDgnQuantity2, DealDgnQuantity1), ''''),'+
  77. ' CDgnQuantity = iif(CDgnQuantity1 <> 0, iif(CDgnQuantity2 <> 0, CDgnQuantity1&''/''&CDgnQuantity2, CDgnQuantity1), ''''),'+
  78. ' FinalDgnQuantity = iif(FinalDgnQuantity1 <> 0, iif(FinalDgnQuantity2 <> 0, FinalDgnQuantity1&''/''&FinalDgnQuantity2, FinalDgnQuantity1), ''''),'+
  79. ' FinalDgnPrice = iif(FinalDgnPrice1 <> 0, iif(FinalDgnPrice2 <> 0, FinalDgnPrice1&''/''&FinalDgnPrice2, FinalDgnPrice1), ''''),'+
  80. ' FinalDgnPrice_Rc = iif(FinalDgnPrice1_Rc <> 0, iif(FinalDgnPrice2_Rc <> 0, FinalDgnPrice1_Rc&''/''&FinalDgnPrice2_Rc, FinalDgnPrice1_Rc), '''')';
  81. begin
  82. ExecuteSql(FConnection, Format(sFinalDgn, [ATableName]));
  83. ExecuteSql(FConnection, Format(sDgnPrice1_2, [ATableName]));
  84. ExecuteSql(FConnection, Format(sDgn, [ATableName]));
  85. end;
  86. procedure TrpgGatherData.CalcOtherData(AProjCount, ASProjCount: Integer);
  87. var
  88. iProj: Integer;
  89. begin
  90. CalcDgnData(SBills_Gather);
  91. for iProj := 0 to AProjCount - 1 do
  92. CalcDgnData(SBills_Proj+IntToStr(iProj+1));
  93. CalcDgnData(SBills_TransProj);
  94. for iProj := 0 to ASProjCount - 1 do
  95. CalcDgnData(SBills_SProj+IntToStr(iProj+1));
  96. end;
  97. procedure TrpgGatherData.ClearHistoryData;
  98. var
  99. FTableList: TStringList;
  100. iIndex: Integer;
  101. sDeleteTableSql: String;
  102. begin
  103. FTableList := TStringList.Create;
  104. try
  105. FConnection.GetTableNames(FTableList);
  106. iIndex := 0;
  107. while iIndex < FTableList.Count do
  108. begin
  109. if Pos('r_', FTableList.Strings[iIndex]) = 1 then
  110. begin
  111. sDeleteTableSql := Format('Drop Table %s', [FTableList.Strings[iIndex]]);
  112. ExecuteSql(FConnection, sDeleteTableSql);
  113. end;
  114. Inc(iIndex);
  115. end;
  116. finally
  117. FTableList.Free;
  118. end;
  119. end;
  120. procedure TrpgGatherData.CopyProjRelaGatherData(AProj: TGatherProjInfo;
  121. AProjIndex: Integer);
  122. var
  123. sTempFile: string;
  124. begin
  125. try
  126. sTempFile := GetCacheProjFile(AProj);
  127. CopyBGLData(sTempFile, AProjIndex, AProj.ProjType);
  128. finally
  129. if FileExists(sTempFile) then
  130. DeleteFile(sTempFile);
  131. end;
  132. end;
  133. constructor TrpgGatherData.Create;
  134. begin
  135. FGatherFile := GetTempFileName;
  136. CopyFileOrFolder(GetEmptyDataBaseFileName, FGatherFile);
  137. FConnection := TADOConnection.Create(nil);
  138. FConnection.LoginPrompt := False;
  139. FConnection.ConnectionString := Format(SAdoConnectStr, [FGatherFile]);
  140. FConnection.Open;
  141. end;
  142. procedure TrpgGatherData.CreateDataTables(AProjCount, ASProjCount: Integer);
  143. var
  144. Updater: TScUpdater;
  145. begin
  146. Updater := TScUpdater.Create;
  147. try
  148. Updater.ForceUpdate := True;
  149. Updater.Open('', FConnection, '', '');
  150. AddTables(AProjCount, ASProjCount, Updater);
  151. Updater.ExcuteUpdate;
  152. finally
  153. Updater.Free;
  154. end;
  155. end;
  156. destructor TrpgGatherData.Destroy;
  157. begin
  158. FConnection.Free;
  159. if FileExists(FGatherFile) then
  160. DeleteFile(FGatherFile);
  161. inherited;
  162. end;
  163. function TrpgGatherData.GetCurSpecialProjCount: Integer;
  164. var
  165. sgsTables: TStringList;
  166. iTable: Integer;
  167. begin
  168. Result := 0;
  169. sgsTables := TStringList.Create;
  170. try
  171. FConnection.GetTableNames(sgsTables);
  172. for iTable := 0 to sgsTables.Count - 1 do
  173. begin
  174. if Pos(SBills_SProj, sgsTables.Strings[iTable]) > 0 then
  175. Inc(Result);
  176. end;
  177. finally
  178. sgsTables.Free;
  179. end;
  180. end;
  181. procedure TrpgGatherData.CopyBGLData(const AFileName: string; AProjIndex, AProjType: Integer);
  182. const
  183. sCopyBGL = 'Insert Into r_BGL_TransProj' +
  184. ' Select ID, %d As ProjID, %d As ProjType,' +
  185. ' Code, Name, TotalPrice, Pos_Reason, Direction, DrawingCode, ApprovalCode, BGLType' +
  186. ' From BGL In ''%s''';
  187. begin
  188. ExecuteSql(FConnection, Format(sCopyBGL, [AProjIndex, AProjType, AFileName]));
  189. end;
  190. procedure TrpgGatherData.LoadRelaData(AProjectID: Integer);
  191. const
  192. sCopyProperty = 'Select * Into r_ProjProperties'+
  193. ' From ProjProperties In ''%s''';
  194. var
  195. sFileName: string;
  196. vProjectData: TProjectData;
  197. begin
  198. vProjectData := OpenProjectManager.FindProjectData(AProjectID);
  199. if Assigned(vProjectData) then Exit;
  200. try
  201. sFileName := GetTempFileName;
  202. vProjectData.SaveTempDataBaseFile(sFileName);
  203. ExecuteSql(FConnection, Format(sCopyProperty, [sFileName]));
  204. finally
  205. if FileExists(sFileName) then
  206. DeleteFile(sFileName);
  207. end;
  208. end;
  209. procedure TrpgGatherData.SaveBills(ATree: TProjGatherTree);
  210. var
  211. vBillsData: TrpgBillsData;
  212. begin
  213. vBillsData := TrpgBillsData.Create(FConnection);
  214. try
  215. vBillsData.SaveDataTo(ATree, SBills);
  216. finally
  217. vBillsData.Free;
  218. end;
  219. end;
  220. procedure TrpgGatherData.SaveBillsGatherCalc(ATree: TProjGatherTree);
  221. var
  222. vBillsCalcData: TrpgBillsCalcData;
  223. begin
  224. vBillsCalcData := TrpgBillsCalcData.Create(FConnection);
  225. try
  226. vBillsCalcData.SaveGatherDataTo(ATree, SBills_Gather);
  227. finally
  228. vBillsCalcData.Free;
  229. end;
  230. end;
  231. procedure TrpgGatherData.SaveBillsProjCalc(ATree: TProjGatherTree;
  232. AProjIndex: Integer);
  233. var
  234. vBillsCalcData: TrpgBillsCalcData;
  235. begin
  236. vBillsCalcData := TrpgBillsCalcData.Create(FConnection);
  237. try
  238. vBillsCalcData.SaveProjDataTo(ATree, AProjIndex, SBills_Proj+IntToStr(AProjIndex+1));
  239. finally
  240. vBillsCalcData.Free;
  241. end;
  242. end;
  243. procedure TrpgGatherData.SaveBillsSpecialProjCalc(ATree: TProjGatherTree;
  244. AProjType: Integer);
  245. var
  246. vBillsCalcData: TrpgBillsCalcData;
  247. begin
  248. vBillsCalcData := TrpgBillsCalcData.Create(FConnection);
  249. try
  250. vBillsCalcData.SaveSpecialProjDataTo(ATree, AProjType, SBills_SProj+IntToStr(AProjType));
  251. finally
  252. vBillsCalcData.Free;
  253. end;
  254. end;
  255. procedure TrpgGatherData.SaveGatherData(AGather: TProjGather);
  256. const
  257. sInsert = 'Insert Into %s Select * From %s';
  258. var
  259. iProj: Integer;
  260. begin
  261. SaveGatherProjInfo(AGather.CommonProj, AGather.SpecialProj);
  262. SaveBills(AGather.Tree);
  263. SaveBillsGatherCalc(AGather.Tree);
  264. for iProj := 0 to AGather.CommonProj.Count - 1 do
  265. begin
  266. SaveBillsProjCalc(AGather.Tree, iProj);
  267. ExecuteSql(FConnection, Format(sInsert, [SBills_TransProj, SBills_Proj+IntToStr(iProj+1)]));
  268. CopyProjRelaGatherData(TGatherProjInfo(AGather.CommonProj.Items[iProj]), iProj);
  269. end;
  270. for iProj := 0 to AGather.Tree.SpecialProjCount - 1 do
  271. SaveBillsSpecialProjCalc(AGather.Tree, iProj+1);
  272. for iProj := 0 to AGather.SpecialProj.Count - 1 do
  273. CopyProjRelaGatherData(TGatherProjInfo(AGather.SpecialProj.Items[iProj]), -3);
  274. end;
  275. procedure TrpgGatherData.SaveGatherProjInfo(AProjs, ASProjs: TList);
  276. var
  277. vGatherInfoData: TrpgGatherProjData;
  278. begin
  279. vGatherInfoData := TrpgGatherProjData.Create(FConnection);
  280. try
  281. vGatherInfoData.SaveDataTo(AProjs, ASProjs, SGatherProj);
  282. finally
  283. vGatherInfoData.Free;
  284. end;
  285. end;
  286. procedure TrpgGatherData.TransposeProjCalc(AProjCount: Integer);
  287. const
  288. sInsert = 'Insert Into %s Select * From %s';
  289. var
  290. iProj: Integer;
  291. begin
  292. for iProj := 0 to AProjCount - 1 do
  293. ExecuteSql(FConnection, Format(sInsert, [SBills_TransProj, SBills_Proj+IntToStr(iProj+1)]));
  294. end;
  295. procedure TrpgGatherData.UpdateDataBase(ASpecialProjTypes: TStrings);
  296. const
  297. sUpdateSql = 'Insert Into %s (ID, ProjID, ProjType,' +
  298. ' OrgQuantity, OrgTotalPrice, OrgTotalPrice_Rc,' +
  299. ' MisQuantity, MisTotalPrice, MisTotalPrice_Rc,' +
  300. ' OthQuantity, OthTotalPrice, OthTotalPrice_Rc,' +
  301. ' Quantity, TotalPrice, TotalPrice_Rc,' +
  302. ' DgnQuantity1, DgnQuantity2, DgnQuantity,' +
  303. ' DgnPrice1, DgnPrice2, DgnPrice,' +
  304. ' DgnPrice1_Rc, DgnPrice2_Rc, DgnPrice_Rc,' +
  305. ' DealDgnQuantity1, DealDgnQuantity2, DealDgnQuantity,' +
  306. ' CDgnQuantity1, CDgnQuantity2, CDgnQuantity,' +
  307. ' FinalDgnQuantity1, FinalDgnQuantity2, FinalDgnQuantity,' +
  308. ' FinalDgnPrice1, FinalDgnPrice2, FinalDgnPrice,' +
  309. ' FinalDgnPrice1_Rc, FinalDgnPrice2_Rc, FinalDgnPrice_Rc,' +
  310. ' AddDealQuantity, AddDealTotalPrice, AddDealTotalPrice_Rc,' +
  311. ' AddQcQuantity, AddQcTotalPrice, AddQcTotalPrice_Rc,' +
  312. ' AddGatherQuantity, AddGatherTotalPrice, AddGatherTotalPrice_Rc,' +
  313. ' CurDealQuantity, CurDealTotalPrice, CurDealTotalPrice_Rc,' +
  314. ' CurQcQuantity, CurQcTotalPrice, CurQcTotalPrice_Rc,' +
  315. ' CurGatherQuantity, CurGatherTotalPrice, CurGatherTotalPrice_Rc,' +
  316. ' PreDealQuantity, PreDealTotalPrice, PreDealTotalPrice_Rc,' +
  317. ' PreQcQuantity, PreQcTotalPrice, PreQcTotalPrice_Rc,' +
  318. ' PreGatherQuantity, PreGatherTotalPrice, PreGatherTotalPrice_Rc,' +
  319. ' EndDealQuantity, EndDealTotalPrice, EndDealTotalPrice_Rc,' +
  320. ' EndQcQuantity, EndQcTotalPrice, EndQcTotalPrice_Rc,' +
  321. ' EndGatherQuantity, EndGatherTotalPrice, EndGatherTotalPrice_Rc)' +
  322. ' Select ID, %d, %d,'+
  323. ' 0, 0, 0,'+ // Org
  324. ' 0, 0, 0,'+ // Mis
  325. ' 0, 0, 0,'+ // Oth
  326. ' 0, 0, 0,'+ // 台账
  327. ' 0, 0, '''','+ // DgnQuantity
  328. ' 0, 0, '''','+ // DgnPrice
  329. ' 0, 0, '''','+ // DgnPrice_Rc
  330. ' 0, 0, '''','+ // DealDgnQuantity
  331. ' 0, 0, '''','+ // CDgnQuantity
  332. ' 0, 0, '''','+ // FinalDgnQuantity
  333. ' 0, 0, '''','+ // FinalDgnPrice
  334. ' 0, 0, '''','+ // FinalDgnPrice_Rc
  335. ' 0, 0, 0,'+ // AddDeal
  336. ' 0, 0, 0,'+ // AddQc
  337. ' 0, 0, 0,'+ // AddGather
  338. ' 0, 0, 0,'+ // CurDeal
  339. ' 0, 0, 0,'+ // CurQc
  340. ' 0, 0, 0,'+ // CurGather
  341. ' 0, 0, 0,'+ // PreDeal
  342. ' 0, 0, 0,'+ // PreQc
  343. ' 0, 0, 0,'+ // PreGather
  344. ' 0, 0, 0,'+ // EndDeal
  345. ' 0, 0, 0,'+ // EndQc
  346. ' 0, 0, 0'+ // EndGather
  347. ' From r_Bills';
  348. var
  349. Updater: TScUpdater;
  350. iProj, iSpecialProjCount: Integer;
  351. begin
  352. iSpecialProjCount := GetCurSpecialProjCount;
  353. if ASpecialProjTypes.Count > iSpecialProjCount then
  354. begin
  355. Updater := TScUpdater.Create;
  356. try
  357. Updater.ForceUpdate := True;
  358. Updater.Open('', FConnection, '', '');
  359. for iProj := iSpecialProjCount to ASpecialProjTypes.Count - 1 do
  360. Updater.AddTableDef(SBills_SProj+IntToStr(iProj+1), @tdBills_Calc, Length(tdBills_Calc), False, False);
  361. Updater.ExcuteUpdate;
  362. finally
  363. Updater.Free;
  364. end;
  365. for iProj := iSpecialProjCount to ASpecialProjTypes.Count - 1 do
  366. ExecuteSql(FConnection, Format(sUpdateSql, [SBills_SProj+IntToStr(iProj+1), -3, iProj+1]));
  367. end;
  368. end;
  369. procedure TrpgGatherData.WriteGatherData(AGather: TProjGather);
  370. begin
  371. ClearHistoryData;
  372. CreateDataTables(AGather.Tree.ProjCount, AGather.Tree.SpecialProjCount);
  373. SaveGatherData(AGather);
  374. CalcOtherData(AGather.Tree.ProjCount, AGather.Tree.SpecialProjCount);
  375. //CopyRelaGatherData(AGather);
  376. // 集中处理TranProj时,最后一个标段数据丢失
  377. //TransposeProjCalc(AGather.Tree.ProjCount);
  378. if _IsDebugView then
  379. CopyFileOrFolder(FGatherFile, GetAppFilePath+'CommonProjGather.dat');
  380. end;
  381. procedure TrpgGatherData.CopyRelaGatherData(AGather: TProjGather);
  382. var
  383. iProj: Integer;
  384. begin
  385. for iProj := 0 to AGather.CommonProj.Count - 1 do
  386. CopyProjRelaGatherData(TGatherProjInfo(AGather.CommonProj.Items[iProj]), iProj);
  387. for iProj := 0 to AGather.SpecialProj.Count - 1 do
  388. CopyProjRelaGatherData(TGatherProjInfo(AGather.SpecialProj.Items[iProj]), -3);
  389. end;
  390. function TrpgGatherData.GetCacheProjFile(AProj: TGatherProjInfo): string;
  391. var
  392. vProjData: TProjectData;
  393. begin
  394. Result := GetTempFileName;
  395. vProjData := OpenProjectManager.FindProjectData(AProj.ProjectID);
  396. if not Assigned(vProjData) then
  397. begin
  398. vProjData := TProjectData.Create;
  399. vProjData.SimpleOpen(GetMyProjectsFilePath + AProj.FileName);
  400. vProjData.SaveTempDataBaseFile(Result);
  401. vProjData.Free;
  402. end
  403. else
  404. vProjData.SaveTempDataBaseFile(Result);
  405. end;
  406. end.