rpgGatherData.pas 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450
  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. ' Peg, StartDateTime, LxCode, LxTotalPrice, PfCode, PfTotalPrice, MemoStr' +
  187. ' From BGL In ''%s''';
  188. begin
  189. ExecuteSql(FConnection, Format(sCopyBGL, [AProjIndex, AProjType, AFileName]));
  190. end;
  191. procedure TrpgGatherData.LoadRelaData(AProjectID: Integer);
  192. const
  193. sCopyProperty = 'Select * Into r_ProjProperties'+
  194. ' From ProjProperties In ''%s''';
  195. var
  196. sFileName: string;
  197. vProjectData: TProjectData;
  198. begin
  199. vProjectData := OpenProjectManager.FindProjectData(AProjectID);
  200. if Assigned(vProjectData) then Exit;
  201. try
  202. sFileName := GetTempFileName;
  203. vProjectData.SaveTempDataBaseFile(sFileName);
  204. ExecuteSql(FConnection, Format(sCopyProperty, [sFileName]));
  205. finally
  206. if FileExists(sFileName) then
  207. DeleteFile(sFileName);
  208. end;
  209. end;
  210. procedure TrpgGatherData.SaveBills(ATree: TProjGatherTree);
  211. var
  212. vBillsData: TrpgBillsData;
  213. begin
  214. vBillsData := TrpgBillsData.Create(FConnection);
  215. try
  216. vBillsData.SaveDataTo(ATree, SBills);
  217. finally
  218. vBillsData.Free;
  219. end;
  220. end;
  221. procedure TrpgGatherData.SaveBillsGatherCalc(ATree: TProjGatherTree);
  222. var
  223. vBillsCalcData: TrpgBillsCalcData;
  224. begin
  225. vBillsCalcData := TrpgBillsCalcData.Create(FConnection);
  226. try
  227. vBillsCalcData.SaveGatherDataTo(ATree, SBills_Gather);
  228. finally
  229. vBillsCalcData.Free;
  230. end;
  231. end;
  232. procedure TrpgGatherData.SaveBillsProjCalc(ATree: TProjGatherTree;
  233. AProjIndex: Integer);
  234. var
  235. vBillsCalcData: TrpgBillsCalcData;
  236. begin
  237. vBillsCalcData := TrpgBillsCalcData.Create(FConnection);
  238. try
  239. vBillsCalcData.SaveProjDataTo(ATree, AProjIndex, SBills_Proj+IntToStr(AProjIndex+1));
  240. finally
  241. vBillsCalcData.Free;
  242. end;
  243. end;
  244. procedure TrpgGatherData.SaveBillsSpecialProjCalc(ATree: TProjGatherTree;
  245. AProjType: Integer);
  246. var
  247. vBillsCalcData: TrpgBillsCalcData;
  248. begin
  249. vBillsCalcData := TrpgBillsCalcData.Create(FConnection);
  250. try
  251. vBillsCalcData.SaveSpecialProjDataTo(ATree, AProjType, SBills_SProj+IntToStr(AProjType));
  252. finally
  253. vBillsCalcData.Free;
  254. end;
  255. end;
  256. procedure TrpgGatherData.SaveGatherData(AGather: TProjGather);
  257. const
  258. sInsert = 'Insert Into %s Select * From %s';
  259. var
  260. iProj: Integer;
  261. begin
  262. SaveGatherProjInfo(AGather.CommonProj, AGather.SpecialProj);
  263. SaveBills(AGather.Tree);
  264. SaveBillsGatherCalc(AGather.Tree);
  265. for iProj := 0 to AGather.CommonProj.Count - 1 do
  266. begin
  267. SaveBillsProjCalc(AGather.Tree, iProj);
  268. ExecuteSql(FConnection, Format(sInsert, [SBills_TransProj, SBills_Proj+IntToStr(iProj+1)]));
  269. CopyProjRelaGatherData(TGatherProjInfo(AGather.CommonProj.Items[iProj]), iProj);
  270. end;
  271. for iProj := 0 to AGather.Tree.SpecialProjCount - 1 do
  272. SaveBillsSpecialProjCalc(AGather.Tree, iProj+1);
  273. for iProj := 0 to AGather.SpecialProj.Count - 1 do
  274. CopyProjRelaGatherData(TGatherProjInfo(AGather.SpecialProj.Items[iProj]), -3);
  275. end;
  276. procedure TrpgGatherData.SaveGatherProjInfo(AProjs, ASProjs: TList);
  277. var
  278. vGatherInfoData: TrpgGatherProjData;
  279. begin
  280. vGatherInfoData := TrpgGatherProjData.Create(FConnection);
  281. try
  282. vGatherInfoData.SaveDataTo(AProjs, ASProjs, SGatherProj);
  283. finally
  284. vGatherInfoData.Free;
  285. end;
  286. end;
  287. procedure TrpgGatherData.TransposeProjCalc(AProjCount: Integer);
  288. const
  289. sInsert = 'Insert Into %s Select * From %s';
  290. var
  291. iProj: Integer;
  292. begin
  293. for iProj := 0 to AProjCount - 1 do
  294. ExecuteSql(FConnection, Format(sInsert, [SBills_TransProj, SBills_Proj+IntToStr(iProj+1)]));
  295. end;
  296. procedure TrpgGatherData.UpdateDataBase(ASpecialProjTypes: TStrings);
  297. const
  298. sUpdateSql = 'Insert Into %s (ID, ProjID, ProjType,' +
  299. ' OrgQuantity, OrgTotalPrice, OrgTotalPrice_Rc,' +
  300. ' MisQuantity, MisTotalPrice, MisTotalPrice_Rc,' +
  301. ' OthQuantity, OthTotalPrice, OthTotalPrice_Rc,' +
  302. ' Quantity, TotalPrice, TotalPrice_Rc,' +
  303. ' DgnQuantity1, DgnQuantity2, DgnQuantity,' +
  304. ' DgnPrice1, DgnPrice2, DgnPrice,' +
  305. ' DgnPrice1_Rc, DgnPrice2_Rc, DgnPrice_Rc,' +
  306. ' DealDgnQuantity1, DealDgnQuantity2, DealDgnQuantity,' +
  307. ' CDgnQuantity1, CDgnQuantity2, CDgnQuantity,' +
  308. ' FinalDgnQuantity1, FinalDgnQuantity2, FinalDgnQuantity,' +
  309. ' FinalDgnPrice1, FinalDgnPrice2, FinalDgnPrice,' +
  310. ' FinalDgnPrice1_Rc, FinalDgnPrice2_Rc, FinalDgnPrice_Rc,' +
  311. ' AddDealQuantity, AddDealTotalPrice, AddDealTotalPrice_Rc,' +
  312. ' AddQcQuantity, AddQcTotalPrice, AddQcTotalPrice_Rc,' +
  313. ' AddGatherQuantity, AddGatherTotalPrice, AddGatherTotalPrice_Rc,' +
  314. ' CurDealQuantity, CurDealTotalPrice, CurDealTotalPrice_Rc,' +
  315. ' CurQcQuantity, CurQcTotalPrice, CurQcTotalPrice_Rc,' +
  316. ' CurGatherQuantity, CurGatherTotalPrice, CurGatherTotalPrice_Rc,' +
  317. ' PreDealQuantity, PreDealTotalPrice, PreDealTotalPrice_Rc,' +
  318. ' PreQcQuantity, PreQcTotalPrice, PreQcTotalPrice_Rc,' +
  319. ' PreGatherQuantity, PreGatherTotalPrice, PreGatherTotalPrice_Rc,' +
  320. ' EndDealQuantity, EndDealTotalPrice, EndDealTotalPrice_Rc,' +
  321. ' EndQcQuantity, EndQcTotalPrice, EndQcTotalPrice_Rc,' +
  322. ' EndGatherQuantity, EndGatherTotalPrice, EndGatherTotalPrice_Rc)' +
  323. ' Select ID, %d, %d,'+
  324. ' 0, 0, 0,'+ // Org
  325. ' 0, 0, 0,'+ // Mis
  326. ' 0, 0, 0,'+ // Oth
  327. ' 0, 0, 0,'+ // 台账
  328. ' 0, 0, '''','+ // DgnQuantity
  329. ' 0, 0, '''','+ // DgnPrice
  330. ' 0, 0, '''','+ // DgnPrice_Rc
  331. ' 0, 0, '''','+ // DealDgnQuantity
  332. ' 0, 0, '''','+ // CDgnQuantity
  333. ' 0, 0, '''','+ // FinalDgnQuantity
  334. ' 0, 0, '''','+ // FinalDgnPrice
  335. ' 0, 0, '''','+ // FinalDgnPrice_Rc
  336. ' 0, 0, 0,'+ // AddDeal
  337. ' 0, 0, 0,'+ // AddQc
  338. ' 0, 0, 0,'+ // AddGather
  339. ' 0, 0, 0,'+ // CurDeal
  340. ' 0, 0, 0,'+ // CurQc
  341. ' 0, 0, 0,'+ // CurGather
  342. ' 0, 0, 0,'+ // PreDeal
  343. ' 0, 0, 0,'+ // PreQc
  344. ' 0, 0, 0,'+ // PreGather
  345. ' 0, 0, 0,'+ // EndDeal
  346. ' 0, 0, 0,'+ // EndQc
  347. ' 0, 0, 0'+ // EndGather
  348. ' From r_Bills';
  349. var
  350. Updater: TScUpdater;
  351. iProj, iSpecialProjCount: Integer;
  352. begin
  353. iSpecialProjCount := GetCurSpecialProjCount;
  354. if ASpecialProjTypes.Count > iSpecialProjCount then
  355. begin
  356. Updater := TScUpdater.Create;
  357. try
  358. Updater.ForceUpdate := True;
  359. Updater.Open('', FConnection, '', '');
  360. for iProj := iSpecialProjCount to ASpecialProjTypes.Count - 1 do
  361. Updater.AddTableDef(SBills_SProj+IntToStr(iProj+1), @tdBills_Calc, Length(tdBills_Calc), False, False);
  362. Updater.ExcuteUpdate;
  363. finally
  364. Updater.Free;
  365. end;
  366. for iProj := iSpecialProjCount to ASpecialProjTypes.Count - 1 do
  367. ExecuteSql(FConnection, Format(sUpdateSql, [SBills_SProj+IntToStr(iProj+1), -3, iProj+1]));
  368. end;
  369. end;
  370. procedure TrpgGatherData.WriteGatherData(AGather: TProjGather);
  371. begin
  372. ClearHistoryData;
  373. CreateDataTables(AGather.Tree.ProjCount, AGather.Tree.SpecialProjCount);
  374. SaveGatherData(AGather);
  375. CalcOtherData(AGather.Tree.ProjCount, AGather.Tree.SpecialProjCount);
  376. //CopyRelaGatherData(AGather);
  377. // 集中处理TranProj时,最后一个标段数据丢失
  378. //TransposeProjCalc(AGather.Tree.ProjCount);
  379. if _IsDebugView then
  380. CopyFileOrFolder(FGatherFile, GetAppFilePath+'CommonProjGather.dat');
  381. end;
  382. procedure TrpgGatherData.CopyRelaGatherData(AGather: TProjGather);
  383. var
  384. iProj: Integer;
  385. begin
  386. for iProj := 0 to AGather.CommonProj.Count - 1 do
  387. CopyProjRelaGatherData(TGatherProjInfo(AGather.CommonProj.Items[iProj]), iProj);
  388. for iProj := 0 to AGather.SpecialProj.Count - 1 do
  389. CopyProjRelaGatherData(TGatherProjInfo(AGather.SpecialProj.Items[iProj]), -3);
  390. end;
  391. function TrpgGatherData.GetCacheProjFile(AProj: TGatherProjInfo): string;
  392. var
  393. vProjData: TProjectData;
  394. begin
  395. Result := GetTempFileName;
  396. vProjData := OpenProjectManager.FindProjectData(AProj.ProjectID);
  397. if not Assigned(vProjData) then
  398. begin
  399. vProjData := TProjectData.Create;
  400. vProjData.SimpleOpen(GetMyProjectsFilePath + AProj.FileName);
  401. vProjData.SaveTempDataBaseFile(Result);
  402. vProjData.Free;
  403. end
  404. else
  405. vProjData.SaveTempDataBaseFile(Result);
  406. end;
  407. end.