ProjectManagerFme.pas 61 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005
  1. unit ProjectManagerFme;
  2. interface
  3. uses
  4. ProjectManagerDm, ZhAPI,
  5. NewProjectFrm,
  6. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7. Dialogs, ZjGridDBA, ZJGrid, ComCtrls, ToolWin, ActnList,
  8. dxBar, sdGridDBA, sdGridTreeDBA, sdIDTree, CslJson, ExtCtrls,
  9. StdCtrls, sdDB, CslButton, OrderCheckerFme, Contnrs;
  10. type
  11. TStrArr = array of string;
  12. TProjectManagerFrame = class(TFrame)
  13. ToolBar: TToolBar;
  14. tobtnOpen: TToolButton;
  15. zgProjects: TZJGrid;
  16. tobtnDelete: TToolButton;
  17. ActionList1: TActionList;
  18. actnOpen: TAction;
  19. actnDelete: TAction;
  20. dxpmProjectManager: TdxBarPopupMenu;
  21. actnReceiveProject: TAction;
  22. stdProjects: TsdGridTreeDBA;
  23. actnNewProject: TAction;
  24. actnNewSubProject: TAction;
  25. actnNewTender: TAction;
  26. pnlTenderProperty: TPanel;
  27. sdTenderProperty: TsdGridDBA;
  28. sprProperty: TSplitter;
  29. tobtnRenane: TToolButton;
  30. actnRename: TAction;
  31. tobtnImport: TToolButton;
  32. tobtnExport: TToolButton;
  33. actnImport: TAction;
  34. actnExport: TAction;
  35. tobtn1: TToolButton;
  36. pnlWeb: TPanel;
  37. pnlProject: TPanel;
  38. shp2: TShape;
  39. shp1: TShape;
  40. shp3: TShape;
  41. shp4: TShape;
  42. pnlTenderTitle: TPanel;
  43. lblBidName: TLabel;
  44. pnlShadow: TPanel;
  45. pnlProgress: TPanel;
  46. lblPeriodTotal: TLabel;
  47. lblPeriodState: TLabel;
  48. lblProgress: TLabel;
  49. lblPeriod: TLabel;
  50. pnlBelongProject: TPanel;
  51. lblBelongProject: TLabel;
  52. lblProjName: TLabel;
  53. lblLeftHalfBracket: TLabel;
  54. lblOnwerCompany: TLabel;
  55. lblOnwerName: TLabel;
  56. pnlProjectType: TPanel;
  57. lblProjectType: TLabel;
  58. lblWebProjCtgyName: TLabel;
  59. zgTenderProperty: TZJGrid;
  60. actnOpenBackupFolder: TAction;
  61. sbChecker: TScrollBox;
  62. actnSignOnline: TAction;
  63. actnGuest: TAction;
  64. actnEpure: TAction;
  65. procedure actnOpenExecute(Sender: TObject);
  66. procedure actnDeleteExecute(Sender: TObject);
  67. procedure zgProjectsMouseDown(Sender: TObject; Button: TMouseButton;
  68. Shift: TShiftState; X, Y: Integer);
  69. procedure actnReceiveProjectExecute(Sender: TObject);
  70. procedure actnNewProjectExecute(Sender: TObject);
  71. procedure actnNewSubProjectExecute(Sender: TObject);
  72. procedure actnNewTenderExecute(Sender: TObject);
  73. procedure zgProjectsDrawCellText(ACanvas: TCanvas; const ARect: TRect;
  74. const ACoord: TPoint; AGrid: TZJGrid; const Text: String;
  75. var ADefaultDraw: Boolean);
  76. procedure actnNewSubProjectUpdate(Sender: TObject);
  77. procedure actnNewTenderUpdate(Sender: TObject);
  78. procedure zgProjectsCurrentChanged(Sender: TObject; Col, Row: Integer);
  79. procedure actnSubmitProjectUpdate(Sender: TObject);
  80. procedure actnReplyProjectUpdate(Sender: TObject);
  81. procedure actnRenameExecute(Sender: TObject);
  82. procedure actnOpenUpdate(Sender: TObject);
  83. procedure actnImportExecute(Sender: TObject);
  84. procedure actnExportExecute(Sender: TObject);
  85. procedure actnDeleteUpdate(Sender: TObject);
  86. procedure actnOpenBackupFolderExecute(Sender: TObject);
  87. procedure actnRenameUpdate(Sender: TObject);
  88. procedure zgProjectsShowHint(var HintStr: String; var CanShow: Boolean;
  89. var HintInfo: THintInfo; const ACoord: TPoint);
  90. procedure actnExportUpdate(Sender: TObject);
  91. procedure actnOpenBackupFolderUpdate(Sender: TObject);
  92. procedure pnlProgressClick(Sender: TObject);
  93. procedure actnSignOnlineExecute(Sender: TObject);
  94. procedure actnSignOnlineUpdate(Sender: TObject);
  95. procedure actnGuestExecute(Sender: TObject);
  96. procedure actnGuestUpdate(Sender: TObject);
  97. procedure actnEpureExecute(Sender: TObject);
  98. private
  99. FProjectManagerData: TProjectManagerData;
  100. // Chenshilong,2016.03.24
  101. // 这部分线上和本地一致,无需区分
  102. FID: Integer; // 本地标段文件ID
  103. FWebID: Integer; // 关联服务器用的ID(服务器有自己的ID体系)
  104. FWebAuthorID: Integer; // 编制人
  105. FWebOwnerID: Integer; // 业主
  106. // 本地存储值、线上存储值。线上修改后,需要同步到本地
  107. FWebMD5_Local: string; // 本地存储的MD5
  108. FWebMD5_OnLine: string; // 线上存储的最新的MD5(下同)
  109. FWebBidName_Local: string; // 标段名 (当无法同线上取得联系时,本地需要用到该名称来提示)
  110. FWebBidName_OnLine: string;
  111. FWebFolder_OnLine: string; // 这个命名不妥,但很直观。线上的项目名称、项目类型概念跟本地颠倒,很混乱。
  112. FWebSubFolder_OnLine: string;
  113. FWebOwnerCompany: string;
  114. FWebOwnerRole: string;
  115. FWebOwnerName: string;
  116. FWebCheckStatusMy: TCheckStatus; // 登陆用户在当前项目中的工作状态。
  117. FWebCheckStatusProject: TCheckStatus; // 项目的审核状态。
  118. FOnLineCheckerBegin: Integer; // 线上审批的起始人。 010110111 起7止9。 0101101110 起0止0。
  119. FOnLineCheckerEnd: Integer; // 线上审批的截止人。
  120. FOnLineCheckerEndIsOwner: Boolean; // 终审是线上审批
  121. FPhaseTotal: Integer;
  122. FPhaseNo: Integer;
  123. FCurPos: Integer; // 用来控制审核人的添加位置
  124. FCheckers: TOVArr;
  125. FCheckerFrames: TObjectList;
  126. FSignOnlineSwitch: Integer;
  127. FEpureOnlineSwitch: Integer;
  128. function ReceiveFile(const AFileName: string; AIsReback: Boolean = False): Boolean;
  129. function ImportFile(const AFileName: string; AFileMD5: string = ''): Boolean;
  130. procedure ConnectButtonWithAction;
  131. function GetImportProjectName(const AFileName: string; AParent: TsdIDTreeNode): string;
  132. function IsProject(ANode: TsdIDTreeNode): Boolean;
  133. function IsLeafProject(ANode: TsdIDTreeNode): Boolean;
  134. function IsUnEmptyLeafProject(ANode: TsdIDTreeNode): Boolean;
  135. function CheckOpened(ANode: TsdIDTreeNode): Boolean;
  136. procedure SetPropertyVisible(AVisible: Boolean);
  137. procedure ShowProjectInfoTopAndCheckers;
  138. // 网络上的目录结构,本地有则定位,没有则创建。
  139. procedure CheckWebFolders(AFolderID, ASubFolderID: Integer;
  140. AFolderName, ASubFolderName: string);
  141. // ANewBidName: 项目的最新标段名(取自服务器,有人改名了,本地的就变成旧的)
  142. procedure CheckBidName(AID: Integer; ANewBidName: string); overload;
  143. procedure CheckBidName(AUserID, AWebID: Integer; ANewBidName: string); overload;
  144. procedure ClearLocalValues;
  145. procedure GetLocalValues(ARec: TsdDataRecord); overload;
  146. // 用户ID、网络标段ID、Type=1可以定位一个标段。
  147. procedure GetLocalValues(AUserID, AWebID: Integer); overload;
  148. // 1 等待我审核的标段文件; 2 我参与的全部标段文件
  149. procedure DoBatchReceiveOnline(ARequestType: Integer);
  150. function LocalMD5(AUserID, AWebID: Integer): string;
  151. procedure BubbleSortProjects;
  152. // AReceiveKind: 1 接收; 2 导入
  153. function FileDownAndReceive(ADownURL: string; AReceiveKind: Integer): Boolean;
  154. // 线上审批的起止人
  155. procedure OnLineChecker(AAr: TOVArr; var ABegin, AEnd: Integer; var AOnLineEndIsOwner: Boolean);
  156. procedure LoadSignOnlineSwitch;
  157. procedure LoadEpureOnlineSwitch;
  158. public
  159. constructor Create(AOwner: TComponent); override;
  160. destructor Destroy; override;
  161. procedure DoBatchReceiveAllOnline;
  162. // AType: -2 繁忙; -1 正常读取; 0 第0期; 1 第1期。
  163. procedure ShowProjectInfoTop(AType: Integer = -1);
  164. function Rec(AProjectID: Integer): TsdDataRecord;
  165. function CurRec: TsdDataRecord;
  166. function CurRecAttachmentPath: string;
  167. function AttachmentFileCountsWithoutManageFile(ANode: TsdIDTreeNode): Integer;
  168. function UserIsChecker(UserID: Integer): Boolean; // 判断指定ID的用户是否是参与人
  169. function IsGuest: Boolean;
  170. property ProjectCheckStatus: TCheckStatus read FWebCheckStatusProject;
  171. end;
  172. implementation
  173. uses
  174. MainFrm, UtilMethods, ProjectCommands, Globals, ConfigDoc, ConstUnit,
  175. WebNewTenderFrm, PHPWebDm, Math, mProgressFrm, ProgressHintFrm,
  176. ShellAPI, ProjectFme, SelectOnlineSignPhaseFrm, SignOnlineReportsFrm,
  177. ConditionalDefines, SetGuestFrm;
  178. {$R *.dfm}
  179. procedure TProjectManagerFrame.ConnectButtonWithAction;
  180. begin
  181. SetDxBtnAction(actnNewProject, MainForm.dxbtnNewProject);
  182. SetDxBtnAction(actnNewSubProject, MainForm.dxbtnNewSubProject);
  183. SetDxBtnAction(actnNewTender, MainForm.dxbtnNewTender);
  184. SetDxBtnAction(actnOpen, MainForm.dxbtnOpenProject);
  185. SetDxBtnAction(actnDelete, MainForm.dxbtnDeleteProject);
  186. SetDxBtnAction(actnReceiveProject, MainForm.dxbtnReceiveProject);
  187. SetDxBtnAction(actnOpenBackupFolder, MainForm.dxbtnOpenBackupFolder);
  188. SetDxBtnAction(actnRename, MainForm.dxbtnRename);
  189. SetDxBtnAction(actnSignOnline, MainForm.dxbtnSignOnline);
  190. SetDxBtnAction(actnGuest, MainForm.dxbtnGuest);
  191. SetDxBtnAction(actnEpure, MainForm.dxbtnEpure);
  192. end;
  193. constructor TProjectManagerFrame.Create(AOwner: TComponent);
  194. begin
  195. inherited;
  196. FCheckerFrames := TObjectList.Create;
  197. FProjectManagerData := ProjectManager;
  198. FProjectManagerData.Open;
  199. stdProjects.IDTree := FProjectManagerData.ProjectsTree;
  200. sdTenderProperty.DataView := FProjectManagerData.sdvTenderProperty;
  201. ConnectButtonWithAction;
  202. SetPropertyVisible(False);
  203. sbChecker.Height := 0;
  204. if G_IsCloud then
  205. begin
  206. Application.HintPause := 200;
  207. Application.HintHidePause := 60000;
  208. LoadSignOnlineSwitch;
  209. tobtnImport.Visible := False;
  210. stdProjects.TreeOptions := stdProjects.TreeOptions - [aoAllowUpLevel, aoAllowDownLevel];
  211. stdProjects.Options := stdProjects.Options - [aoAllowUpMove, aoAllowDownMove];
  212. CreateProgress('正在从云端下载新项目');
  213. try
  214. actnReceiveProject.Execute;
  215. finally
  216. CloseProgress;
  217. end;
  218. end;
  219. end;
  220. // 双击打开项目 TagB
  221. procedure TProjectManagerFrame.actnOpenExecute(Sender: TObject);
  222. var
  223. vSel: TsdIDTreeNode;
  224. vRec: TsdDataRecord;
  225. sHint: string;
  226. function SearchFileOnline(AURL: string; var ADownURL, AFolder, ASubFolder, ABidName, AMD5Web, AError: string; var AFolderID, ASubFolderID: Integer): Integer;
  227. var vArr: TOVArr;
  228. begin
  229. Result := PHPWeb.Search(AURL, [''], [''], vArr);
  230. AError := '';
  231. if Result = 1 then
  232. begin
  233. if High(vArr) >= 0 then
  234. begin
  235. ADownURL := vArr[0, 0];
  236. AFolder := vArr[0, 2];
  237. ASubFolder := vArr[0, 3];
  238. AMD5Web := vArr[0, 1];
  239. AFolderID := StrToInt(vArr[0, 4]);
  240. ASubFolderID := StrToInt(vArr[0, 5]);
  241. ABidName := vArr[0, 6];
  242. end
  243. else
  244. Result := 10; // 返回10,表示无记录。用这个数字代表是否觉得怪异?没办法,0被占用了。
  245. end
  246. else if Result = 0 then
  247. AError := PHPWeb.PageError('标段更新数据失败')
  248. else if Result = -1 then
  249. AError := PHPWeb.NetError('标段更新数据失败');
  250. end;
  251. function CanOpen: Boolean;
  252. var
  253. sSearchURL, sDownURL,
  254. sMD5_UnLock, sError, sLocalFile: string;
  255. iSearch, iFolderID, iSubFolderID: Integer;
  256. bLock, bCanImp: Boolean;
  257. vFileCheck: TTenderFileChecker;
  258. begin
  259. Result := False;
  260. // 先按正常接口找到最新的MD5码看是否需要更新
  261. sSearchURL := Format('%stender/get/%d/update', [PHPWeb.MeasureURL, FWebID]);
  262. iSearch := SearchFileOnline(sSearchURL, sDownURL, FWebFolder_OnLine, FWebSubFolder_OnLine, FWebBidName_OnLine, FWebMD5_OnLine, sError, iFolderID, iSubFolderID);
  263. if iSearch = 1 then
  264. begin
  265. try
  266. CheckWebFolders(iFolderID, iSubFolderID, FWebFolder_OnLine, FWebSubFolder_OnLine);
  267. CheckBidName(FID, FWebBidName_OnLine);
  268. finally
  269. if vSel <> nil then
  270. vSel.LocateInControl;
  271. end;
  272. // 打开前一定要先下载最新的标段文件(无论审核有没有通过)
  273. if FWebMD5_OnLine <> FWebMD5_Local then
  274. if not FileDownAndReceive(sDownURL, 1) then Exit;
  275. // 编制人且项目末通过
  276. if (FWebAuthorID = PHPWeb.UserID) and (FWebCheckStatusProject = csNotPass) then
  277. begin
  278. sHint := '本期计量审批不通过,你现在可以:' + #10#13 + '点击【是(Y)】重新开始本期计量,软件将打开本期上报时的数据,开始重新计量;' +
  279. #10#13 +'点击【否(N)】查看不通过计量,软件将打开本期最后审批的数据,重新打开标段' + '可再次打开本确认窗口。';
  280. if Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION) = ID_Yes then
  281. begin
  282. // 查找原报的文件
  283. sSearchURL := Format('%suser/get/%d/%d/report/file', [PHPWeb.MeasureURL, FWebID, FPhaseNo]);
  284. case SearchFileOnline(sSearchURL, sDownURL, FWebFolder_OnLine, FWebSubFolder_OnLine, FWebBidName_OnLine, sMD5_UnLock, sError, iFolderID, iSubFolderID) of
  285. 1: ; // 原报文件已正确找到
  286. 0, -1:
  287. begin
  288. sHint := sError + ' 因网络出错,无法连接到云端以获取本期原报上传的文件,无法重新开始本期,请重试。';
  289. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  290. Exit;
  291. end;
  292. end;
  293. if FileDownAndReceive(sDownURL, 2) then
  294. begin
  295. // 这里在线上创建新一期审批人列表、更改标段状态。不再使用同步更新等。
  296. sSearchURL := Format('%suser/create/%d/%d/new/audit', [PHPWeb.MeasureURL, FWebID, FPhaseNo]);
  297. case SearchFileOnline(sSearchURL, sDownURL, FWebFolder_OnLine, FWebSubFolder_OnLine, FWebBidName_OnLine, sMD5_UnLock, sError, iFolderID, iSubFolderID) of
  298. 1, 10: // 执行到这里线上审核人列表已创建完毕。无需返回记录值,所以返回值为10。1是为了兼容。
  299. begin
  300. sHint := '【十分重要】:本期计量已重新开始,原报在本次上报完成前,请勿删除该标段或更换电脑。';
  301. Application.MessageBox(PChar(sHint), '提示', MB_OK + MB_ICONINFORMATION);
  302. end;
  303. 0, -1:
  304. begin
  305. sHint := sError + ' 因网络出错,无法在线上创建新一期审批人列表、提交项目状态等,请重试。';
  306. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  307. Exit;
  308. end;
  309. end;
  310. end
  311. else
  312. Exit;
  313. end;
  314. end;
  315. end
  316. else if (iSearch = 10) then
  317. begin
  318. if not PHPWeb.ExistInServer(FWebID) then
  319. begin
  320. sHint :='该项目[' + FWebBidName_Local + ']在云端已被删除,点击"确定"后,可手动删除该项目。';
  321. Application.MessageBox(PChar(sHint), '提示', MB_OK + MB_ICONINFORMATION);
  322. Exit;
  323. end;
  324. end
  325. else if (iSearch = 0) or (iSearch = -1) then
  326. begin
  327. sHint := sError + '(因网络出错,无法检测[' + FWebBidName_Local + ']在云端是否有更新,本次操作已取消,请重试)。';
  328. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  329. Exit;
  330. end;
  331. Result := True;
  332. end;
  333. var
  334. CurProjectFme: TProjectFrame;
  335. begin
  336. // 打开前先下载更新
  337. Screen.Cursor := crHourGlass;
  338. try
  339. vSel := stdProjects.IDTree.Selected;
  340. vRec := vSel.Rec;
  341. if G_IsCloud then
  342. begin
  343. GetLocalValues(CurRec);
  344. // 以下这段已经包含在MainForm.OpenProject(vRec)中了,但在调用这句之前,网络版要提前用一下。
  345. if MainForm.HasOpened(FID) then
  346. begin
  347. MainForm.LocateProject(FID);
  348. Exit;
  349. end;
  350. if not CanOpen then
  351. Exit;
  352. end;
  353. CurProjectFme := MainForm.OpenProject(vRec);
  354. if G_IsCloud then
  355. begin
  356. // 云版,如果用户在打开项目的过程中,切换界面回项目管理,MainFrom.CurProjectFrame值为nil,后面的调用,包括MainForm.actnCloseProject.Execute都会出错
  357. // 其中由于前面调用的MainForm.LocateProject触发的一系列事件中,调用到了SetPropertyVisible,其中执行了Screen.Cursor := crDefault
  358. // 导致鼠标状态还原,用户可以点击,单机版下测试,属性状态为crHourGlass时,亦可以切换会项目管理
  359. // 按逻辑,CheckFileAndCloudCheckerList这种方法不应在界面,应在控制器,亦不可直接调用MainForm.actnCloseProject.Execute
  360. // 怕按逻辑改动引起更多Bug,故继续错下去,检查MainForm.CurProjectFrame是否正确,并再次禁用鼠标
  361. if CurProjectFme <> MainForm.CurProjectFrame then
  362. begin
  363. Screen.Cursor := crHourGlass;
  364. MainForm.LocateProject(CurProjectFme.ProjectData.ProjectID);
  365. end;
  366. if not MainForm.CurProjectFrame.CheckFileAndCloudChekerList then
  367. begin
  368. sHint := '“'+ FWebBidName_OnLine +'”无法打开,本地与云端审批人不一致。' + #10#13 +
  369. '1、如当前项目审批不通过并已重新开始计量:请回到原电脑操作;' + #10#13 +
  370. '2、审批中/审批完成项目:请删除本地项目重新从云端获取。' + #10#13 +
  371. '如仍然存在同样问题,请联系纵横服务人员。';
  372. Application.MessageBox(PChar(sHint), '文件错误', MB_OK +MB_ICONWARNING);
  373. MainForm.actnCloseProject.Execute;
  374. Exit;
  375. end;
  376. end;
  377. finally
  378. Screen.Cursor := crDefault;
  379. end;
  380. end;
  381. procedure TProjectManagerFrame.actnDeleteExecute(Sender: TObject);
  382. begin
  383. if stdProjects.IDTree.Count = 0 then Exit;
  384. with stdProjects.IDTree.Selected.Rec do
  385. if QuestMessage(Format('确定要删除[%s]吗?', [ValueByName('Name').AsString])) then
  386. begin
  387. Screen.Cursor := crHourGlass;
  388. try
  389. FProjectManagerData.Delete;
  390. finally
  391. Screen.Cursor := crDefault;
  392. end;
  393. end;
  394. end;
  395. procedure TProjectManagerFrame.zgProjectsMouseDown(Sender: TObject;
  396. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  397. begin
  398. if Button = mbRight then
  399. dxpmProjectManager.PopupFromCursorPos
  400. else if (zgProjects.CurCol = 1) and (Button = mbLeft) and (ssDouble in Shift)
  401. and Assigned(stdProjects.IDTree.Selected) then
  402. begin
  403. if IsProject(stdProjects.IDTree.Selected) then
  404. stdProjects.IDTree.Selected.Expand
  405. else
  406. actnOpen.Execute;
  407. end;
  408. end;
  409. function TProjectManagerFrame.ReceiveFile(const AFileName: string; AIsReback: Boolean): Boolean;
  410. var
  411. vRP: TReceiveProject;
  412. vNode: TsdIDTreeNode;
  413. begin
  414. Result := False;
  415. vRP := TReceiveProject.Create(stdProjects.IDTree.Selected);
  416. try
  417. ProjectManager.RefreshSeedID;
  418. if G_IsCloud then
  419. begin
  420. vRP.IsReback := AIsReback;
  421. vRP.Lock := (FWebAuthorID = PHPWeb.UserID) or
  422. ((FWebAuthorID <> PHPWeb.UserID) and (FWebCheckStatusMy <> csChecking));
  423. vNode := vRP.ReceiveForLost(AFileName, FOnLineCheckerBegin, FOnLineCheckerEnd, FOnLineCheckerEndIsOwner);
  424. if vNode <> nil then
  425. begin
  426. vNode.Rec.BeginUpdate;
  427. vNode.Rec.ValueByName('WebMD5').AsString := FWebMD5_OnLine;
  428. vNode.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID;
  429. vNode.Rec.EndUpdate;
  430. end;
  431. end
  432. else
  433. vNode := vRP.Receive(AFileName);
  434. finally
  435. case vRP.MessageID of
  436. 0: begin
  437. Result := True;
  438. vNode.LocateInControl;
  439. end;
  440. 1: ErrorMessage('当前标段处于打开状态,未能成功接收,请先关闭标段再次接收。');
  441. 2: ErrorMessage('下载数据与审批状态不一致,未能成功接收,请再次接收。');
  442. 3: ErrorMessage('升级数据失败,未能成功接收,请再次接收。');
  443. end;
  444. vRP.Free;
  445. FProjectManagerData.Save;
  446. end;
  447. end;
  448. // 登录后自动扫描等待我审核的项目 TagC
  449. procedure TProjectManagerFrame.actnReceiveProjectExecute(Sender: TObject);
  450. procedure DoReceiveLocal;
  451. var
  452. sFileName: string;
  453. begin
  454. if SelectFile(sFileName, '.rmf;*.arf') then
  455. begin
  456. ShowProgressHint('正在接收项目并升级数据');
  457. try
  458. ReceiveFile(sFileName);
  459. finally
  460. CloseProgressHint;
  461. end;
  462. end;
  463. end;
  464. var OnCC: TZjCellNotifyEvent;
  465. begin
  466. Screen.Cursor := crHourGlass;
  467. try
  468. if G_IsCloud then
  469. begin
  470. OnCC := zgProjects.OnCurrentChanged;
  471. try
  472. zgProjects.OnCurrentChanged := nil;
  473. DoBatchReceiveOnline(1);
  474. if stdProjects.IDTree.FirstNode <> nil then
  475. stdProjects.IDTree.FirstNode.LocateInControl;
  476. finally
  477. zgProjects.OnCurrentChanged := OnCC;
  478. end;
  479. end
  480. else
  481. DoReceiveLocal;
  482. finally
  483. Screen.Cursor := crDefault;
  484. end;
  485. end;
  486. function TProjectManagerFrame.GetImportProjectName(
  487. const AFileName: string; AParent: TsdIDTreeNode): string;
  488. begin
  489. Result := ExtractSimpleFileName(AFileName);
  490. while FProjectManagerData.ExistProject(Result, AParent) do
  491. if not InputNewProjectName(Result, '导入', AParent) then Abort;
  492. end;
  493. procedure TProjectManagerFrame.actnNewProjectExecute(Sender: TObject);
  494. var
  495. sName: string;
  496. begin
  497. if G_IsCloud then Exit; // 云版线上与本地要保持同步,不允许本地新建
  498. if InputNewProjectName(sName, '新建', stdProjects.IDTree.Selected) then
  499. FProjectManagerData.InsertProject(sName, stdProjects.IDTree.Selected);
  500. end;
  501. procedure TProjectManagerFrame.actnNewSubProjectExecute(Sender: TObject);
  502. var
  503. sName: string;
  504. begin
  505. if G_IsCloud then Exit;
  506. if InputNewProjectName(sName, '新建', stdProjects.IDTree.Selected) then
  507. FProjectManagerData.InsertSubProject(sName, stdProjects.IDTree.Selected);
  508. end;
  509. procedure TProjectManagerFrame.actnNewTenderExecute(Sender: TObject);
  510. function AddAndOpenTender(const ATenderName: string): TsdIDTreeNode;
  511. begin
  512. Result := FProjectManagerData.InsertTender(ATenderName, stdProjects.IDTree.Selected);
  513. MainForm.OpenProject(Result.Rec);
  514. end;
  515. // 网络版新建标段 TagD
  516. procedure NewProjectWithOnline;
  517. var
  518. WebNewTenderForm: TWebNewTenderForm;
  519. sName, sKey, sURL: string;
  520. stnNew: TsdIDTreeNode;
  521. iID, iFolderID, iSubFolderID: Integer;
  522. vRec: TsdDataRecord;
  523. vArr: array of string;
  524. begin
  525. WebNewTenderForm := TWebNewTenderForm.Create(nil);
  526. try
  527. WebNewTenderForm.ShowModal;
  528. if WebNewTenderForm.ModalResult = mrOK then
  529. begin
  530. sKey := WebNewTenderForm.edtKey.Text;
  531. sName := WebNewTenderForm.edtTenderName.Text;
  532. // 同服务器取得联系
  533. iID := -1;
  534. vArr := VarArrayOf(['catid', 'name', 'company', 'phone', 'mobile', 'qq',
  535. 'pname', 'ptype', 'jobs', 'avatar', 'ownuid', 'pnameid', 'ptypeid']);
  536. sURL := Format('%s%d/%s/%s/creatmeasure', [PHPWeb.MeasureURL, PHPWeb.UserID, sName, sKey]); // AnsiToUtf8(sName)
  537. case PHPWeb.Search(sURL, [], [], vArr) of
  538. 1:
  539. begin
  540. iID := StrToInt(vArr[0]);
  541. iFolderID := StrToInt(vArr[11]);
  542. iSubFolderID := StrToInt(vArr[12]);
  543. CheckWebFolders(iFolderID, iSubFolderID, vArr[6], vArr[7]);
  544. end;
  545. 0:
  546. begin
  547. Application.MessageBox(PChar(PHPWeb.PageError('创建标段失败' + '[' + vArr[0] + ']')),
  548. '警告', MB_OK + MB_ICONWARNING);
  549. Exit;
  550. end;
  551. -1:
  552. begin
  553. Application.MessageBox(PChar(PHPWeb.NetError('创建标段失败')),
  554. '警告', MB_OK + MB_ICONWARNING);
  555. Exit;
  556. end;
  557. end;
  558. // 本地创建
  559. stnNew := FProjectManagerData.InsertTender(sName, stdProjects.IDTree.Selected);
  560. // 这里把Web获取的信息存储到项目管理里面。
  561. vRec := stnNew.Rec;
  562. vRec.BeginUpdate;
  563. vRec.ValueByName('WebID').AsInteger := iID;
  564. vRec.ValueByName('WebOwnerID').AsInteger := StrToInt(vArr[10]); // 业主
  565. vRec.ValueByName('WebAuthorID').AsInteger := PHPWeb.UserID; // 编制人
  566. vRec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID; // 当前用户,用于只显示自己的项目
  567. vRec.ValueByName('WebKey').AsString := sKey;
  568. vRec.EndUpdate;
  569. GetLocalValues(vRec);
  570. FWebOwnerName := vArr[1];
  571. FWebOwnerCompany := vArr[2];
  572. FWebOwnerRole := vArr[8];
  573. FWebFolder_OnLine := vArr[6];
  574. FWebSubFolder_OnLine := vArr[7];
  575. // WebOwnerImage := vArr[9];
  576. // WebOwnerPhone := vArr[3];
  577. // WebOwnerMobile := vArr[4];
  578. // WebOwnerQQ := vArr[5];
  579. ShowProjectInfoTop(0);
  580. FProjectManagerData.Save;
  581. MainForm.OpenProject(vRec);
  582. end;
  583. finally
  584. WebNewTenderForm.Free;
  585. end;
  586. end;
  587. procedure NewProject;
  588. var
  589. sName: string;
  590. begin
  591. if InputNewProjectName(sName, '新建', stdProjects.IDTree.Selected) then
  592. AddAndOpenTender(sName);
  593. end;
  594. begin
  595. if G_IsCloud then
  596. NewProjectWithOnline
  597. else
  598. NewProject;
  599. end;
  600. procedure TProjectManagerFrame.zgProjectsDrawCellText(ACanvas: TCanvas;
  601. const ARect: TRect; const ACoord: TPoint; AGrid: TZJGrid;
  602. const Text: String; var ADefaultDraw: Boolean);
  603. procedure GetBitmap(AImage: TBitmap; ANode: TsdIDTreeNode);
  604. begin
  605. if Assigned(ANode) and Assigned(ANode.Rec) then
  606. begin
  607. if ANode.Rec.ValueByName('Type').AsInteger = 0 then
  608. if ANode.Expanded and ANode.HasChildren then
  609. MainForm.Images.GetBitmap(34, AImage)
  610. else
  611. MainForm.Images.GetBitmap(34, AImage)
  612. else
  613. MainForm.Images.GetBitmap(11, AImage);
  614. end
  615. else
  616. AImage := nil;
  617. end;
  618. const
  619. rIconWidth = 16;
  620. rIconHeight = 16;
  621. var
  622. Img: TBitmap;
  623. Cell: TZjCell;
  624. rImg: TRect;
  625. vNode: TsdIDTreeNode;
  626. begin
  627. if (ACoord.X = 1) and (ACoord.Y > zgProjects.FixedRowCount - 1) then
  628. begin
  629. Cell := zgProjects.Cells[ACoord.X, ACoord.Y];
  630. Img := TBitmap.Create;
  631. try
  632. vNode := stdProjects.IDTree.Items[ACoord.Y-zgProjects.FixedRowCount];
  633. GetBitmap(Img, vNode);
  634. case Cell.Align of
  635. gaTopLeft, gaTopCenter, gaTopRight:
  636. rImg := Rect(ARect.Left + 2, ARect.Top, ARect.Left + rIconWidth, ARect.Top + rIconHeight);
  637. gaCenterLeft, gaCenterCenter, gaCenterRight:
  638. rImg := Rect(ARect.Left + 2, ARect.Top + (ARect.Bottom - ARect.Top - rIconHeight) div 2, ARect.Left + rIconWidth, ARect.Bottom - (ARect.Bottom - ARect.Top - rIconHeight) div 2);
  639. gaBottomLeft, gaBottomCenter, gaBottomRight:
  640. rImg := Rect(ARect.Left + 2, ARect.Bottom - rIconHeight, ARect.Left + rIconWidth, ARect.Bottom);
  641. end;
  642. ACanvas.StretchDraw(rImg, Img);
  643. WriteText(ACanvas, Rect(ARect.Left + rIconWidth, ARect.Top, ARect.Right, ARect.Bottom)
  644. , 2, 2, Text, Cell.Align, False);
  645. ADefaultDraw := False;
  646. finally
  647. Img.Free;
  648. end;
  649. end;
  650. end;
  651. procedure TProjectManagerFrame.actnNewSubProjectUpdate(Sender: TObject);
  652. begin
  653. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)
  654. and IsProject(stdProjects.IDTree.Selected)
  655. and (not IsUnEmptyLeafProject(stdProjects.IDTree.Selected));
  656. end;
  657. procedure TProjectManagerFrame.actnNewTenderUpdate(Sender: TObject);
  658. var bCloud: Boolean;
  659. vNode: TsdIDTreeNode;
  660. begin
  661. bCloud := G_IsCloud;
  662. // 只有编制人才能创建新标段?逻辑先后有问题:编制人是在创建标段之后产生的。
  663. // 创建前,当前用户只是一个帐户,它是不是编制人末知,因为它还可以是其它角色。
  664. // 同一帐户在不同的标段可以作为不同的角色。
  665. if bCloud then
  666. begin
  667. TAction(Sender).Enabled := True;
  668. end
  669. else
  670. begin
  671. vNode := stdProjects.IDTree.Selected;
  672. TAction(Sender).Enabled := Assigned(vNode) and IsProject(vNode) and IsLeafProject(vNode);
  673. end;
  674. end;
  675. function TProjectManagerFrame.IsLeafProject(ANode: TsdIDTreeNode): Boolean;
  676. begin
  677. if ANode.HasChildren then
  678. Result := ANode.FirstChild.Rec.ValueByName('Type').AsInteger = 1
  679. else
  680. Result := ANode.Rec.ValueByName('Type').AsInteger = 0;
  681. end;
  682. function TProjectManagerFrame.IsProject(ANode: TsdIDTreeNode): Boolean;
  683. begin
  684. Result := ANode.Rec.ValueByName('Type').AsInteger = 0;
  685. end;
  686. function TProjectManagerFrame.IsUnEmptyLeafProject(
  687. ANode: TsdIDTreeNode): Boolean;
  688. begin
  689. Result := ANode.HasChildren and (ANode.Rec.ValueByName('Type').AsInteger = 1);
  690. end;
  691. procedure TProjectManagerFrame.SetPropertyVisible(AVisible: Boolean);
  692. begin
  693. // 单击刷新项目信息 TagA
  694. if G_IsCloud then
  695. begin
  696. if CurRec = nil then Exit;
  697. pnlTenderProperty.Visible := False;
  698. pnlWeb.Visible := AVisible;
  699. if AVisible then
  700. begin
  701. CreateProgress('云端读取项目信息');
  702. try
  703. ShowProjectInfoTopAndCheckers;
  704. finally
  705. CloseProgress;
  706. end;
  707. end;
  708. end
  709. else
  710. begin
  711. pnlWeb.Visible := False;
  712. pnlTenderProperty.Visible := AVisible;
  713. sprProperty.Visible := AVisible;
  714. end;
  715. end;
  716. procedure TProjectManagerFrame.zgProjectsCurrentChanged(Sender: TObject;
  717. Col, Row: Integer);
  718. begin
  719. if G_IsCloud then
  720. begin
  721. if CurRec <> nil then
  722. begin
  723. // 加这句后产生Bug:上报项目后,记录不曾移动,FID不变,不会刷新
  724. // if FID <> CurRec.ValueByName('ID').AsInteger then
  725. SetPropertyVisible(CurRec.ValueByName('Type').AsInteger = 1);
  726. // OnCurrentChanged取得的 CurRec.ValueByName() 值并不总是可靠,这里加保险。
  727. // 如调用locateInControl后,执行到这里取得的CurRec.ValueByName('ID')值还是上一条的。
  728. if (CurRec.ValueByName('Type').AsInteger = 1) and (not pnlWeb.Visible) then
  729. pnlWeb.Visible := True;
  730. end;
  731. end;
  732. end;
  733. procedure TProjectManagerFrame.actnSubmitProjectUpdate(Sender: TObject);
  734. begin
  735. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)
  736. and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1)
  737. and (stdProjects.IDTree.Selected.Rec.ValueByName('AuditStatus').AsInteger < iMaxStageCount-1);
  738. end;
  739. procedure TProjectManagerFrame.actnReplyProjectUpdate(Sender: TObject);
  740. begin
  741. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)
  742. and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1);
  743. end;
  744. procedure TProjectManagerFrame.actnRenameExecute(Sender: TObject);
  745. function CanRename(ARec: TsdDataRecord; const ANewName: string): Boolean;
  746. var
  747. sURL: string;
  748. iRename: Integer;
  749. vArr: array [0..0] of string;
  750. begin
  751. Result := True;
  752. if not G_IsCloud then Exit;
  753. // 云版 重命名须确保同步服务器
  754. sURL := Format('%stender/%d/%s/update', [PHPWeb.MeasureURL, ARec.ValueByName('WebID').AsInteger, ANewName]);
  755. iRename := PHPWeb.Search(sURL, [], [], vArr);
  756. Result := iRename = 1;
  757. case iRename of
  758. 1: ShowMessage('新的标段名称已同步到服务器!');
  759. 0: Application.MessageBox(PChar(PHPWeb.PageError('重命名同步到云端失败' + '[' + vArr[0] + ']')),
  760. '警告', MB_OK + MB_ICONWARNING);
  761. -1: Application.MessageBox(PChar(PHPWeb.NetError('重命名同步到云端失败')),
  762. '警告', MB_OK + MB_ICONWARNING);
  763. end;
  764. end;
  765. var
  766. stnNode: TsdIDTreeNode;
  767. sName: string;
  768. begin
  769. stnNode := stdProjects.IDTree.Selected;
  770. sName := stnNode.Rec.ValueByName('Name').AsString;
  771. if not Assigned(OpenProjectManager.FindProjectData(stnNode.ID)) then
  772. begin
  773. if InputNewProjectName(sName, '重命名', stnNode.Parent, stnNode.ID) then
  774. begin
  775. if (sName <> stnNode.Rec.ValueByName('Name').AsString) and CanRename(stnNode.Rec, sName) then
  776. begin
  777. stnNode.Rec.ValueByName('Name').AsString := sName;
  778. ProjectManager.Save;
  779. end;
  780. end;
  781. end
  782. else
  783. ErrorMessage(Format('项目[%s]已经打开,无法重命名!', [sName]));
  784. end;
  785. procedure TProjectManagerFrame.actnOpenUpdate(Sender: TObject);
  786. begin
  787. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)
  788. and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1);
  789. end;
  790. procedure TProjectManagerFrame.actnImportExecute(Sender: TObject);
  791. procedure ImportTender(const AFileName, AProjectName: string);
  792. var
  793. Importor: TTenderImport;
  794. begin
  795. Importor := TTenderImport.Create(stdProjects.IDTree.Selected,
  796. AProjectName, AFileName);
  797. try
  798. Importor.Execute;
  799. finally
  800. Importor.Free;
  801. end;
  802. end;
  803. procedure ImportProject(const AFileName, AProjectName: string);
  804. var
  805. Importor: TProjectImport;
  806. begin
  807. Importor := TProjectImport.Create(stdProjects.IDTree.Selected,
  808. AProjectName, AFileName);
  809. try
  810. Importor.Execute;
  811. finally
  812. Importor.Free;
  813. end;
  814. end;
  815. var
  816. sFileName, sProjectName: string;
  817. vCur: TsdIDTreeNode;
  818. begin
  819. if SelectFile(sFileName, '.mtf;*.mpf') then
  820. begin
  821. vCur := stdProjects.IDTree.Selected;
  822. if Assigned(vCur) then
  823. begin
  824. if SameText(ExtractFileExt(sFileName), '.mtf')
  825. and (vCur.Rec.ValueByName('Type').AsInteger = 0) then
  826. sProjectName := GetImportProjectName(sFileName, stdProjects.IDTree.Selected)
  827. else
  828. sProjectName := GetImportProjectName(sFileName, stdProjects.IDTree.Selected.Parent);
  829. end
  830. else
  831. sProjectName := GetImportProjectName(sFileName, vCur);
  832. Screen.Cursor := crHourGlass;
  833. try
  834. if SameText(ExtractFileExt(sFileName), '.mtf') then
  835. ImportTender(sFileName, sProjectName)
  836. else
  837. ImportProject(sFileName, sProjectName);
  838. finally
  839. Screen.Cursor := crDefault;
  840. end;
  841. end;
  842. FProjectManagerData.Save;
  843. end;
  844. procedure TProjectManagerFrame.actnExportExecute(Sender: TObject);
  845. procedure ExportTender(ANode: TsdIDTreeNode);
  846. var
  847. Exportor: TTenderExport;
  848. sFileName, sHint: string;
  849. bExpAtch: Boolean;
  850. iCount: Integer;
  851. begin
  852. bExpAtch := False;
  853. sFileName := SupportManager.ConfigInfo.OutputPath + ANode.Rec.ValueByName('Name').AsString + '.mtf';
  854. if SaveFile(sFileName, '.mtf') then
  855. begin
  856. if FileExists(sFileName) and not QuestMessage(Format('存在同名文件“%s”,是否替换?', [ExtractFileName(sFileName)])) then
  857. Exit;
  858. Screen.Cursor := crHourGlass;
  859. try
  860. Exportor := TTenderExport.Create(ANode.Rec, sFileName);
  861. try
  862. { if not G_IsCloud then
  863. begin
  864. iCount := FileCount(CurRecAttachmentPath);
  865. if iCount > 1 then // 排除管理文件库
  866. begin
  867. sHint := Format('本标段包含 %d 个附件,是否将附件一起导出?', [iCount - 1]);
  868. bExpAtch := Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = ID_Yes;
  869. end;
  870. end; } // FFFFF
  871. Exportor.Execute(bExpAtch);
  872. finally
  873. Exportor.Free;
  874. end;
  875. finally
  876. Screen.Cursor := crDefault;
  877. end;
  878. end;
  879. end;
  880. procedure ExportProject(ANode: TsdIDTreeNode);
  881. var
  882. Exportor: TProjectExport;
  883. sFileName, sHint: string;
  884. bExpAtch: Boolean;
  885. iCount: Integer;
  886. begin
  887. sFileName := SupportManager.ConfigInfo.OutputPath + ANode.Rec.ValueByName('Name').AsString + '.mpf';
  888. if SaveFile(sFileName, '.mpf') then
  889. begin
  890. if FileExists(sFileName) and not QuestMessage(Format('存在同名文件“%s”,是否替换?', [ExtractFileName(sFileName)])) then
  891. Exit;
  892. Screen.Cursor := crHourGlass;
  893. try
  894. bExpAtch := False;
  895. { if not G_IsCloud then
  896. begin
  897. iCount := AttachmentFileCountsWithoutManageFile(ANode);
  898. if iCount > 0 then
  899. begin
  900. sHint := Format('本建设项目共包含 %d 个附件,是否将附件一起导出?', [iCount]);
  901. bExpAtch := Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = ID_Yes;
  902. end;
  903. end; } // FFFFF
  904. Exportor := TProjectExport.Create(ANode, sFileName, bExpAtch);
  905. try
  906. Exportor.Execute;
  907. finally
  908. Exportor.Free;
  909. end;
  910. finally
  911. Screen.Cursor := crDefault;
  912. end;
  913. end;
  914. end;
  915. var
  916. stnNode: TsdIDTreeNode;
  917. begin
  918. stnNode := stdProjects.IDTree.Selected;
  919. if stnNode.Rec.ValueByName('Type').AsInteger = 1 then
  920. begin
  921. ExportTender(stnNode);
  922. end
  923. else
  924. ExportProject(stnNode);
  925. end;
  926. procedure TProjectManagerFrame.actnDeleteUpdate(Sender: TObject);
  927. begin
  928. if Assigned(stdProjects.IDTree.Selected) then
  929. TAction(Sender).Enabled := not CheckOpened(stdProjects.IDTree.Selected)
  930. else
  931. TAction(Sender).Enabled := False;
  932. end;
  933. function TProjectManagerFrame.CheckOpened(ANode: TsdIDTreeNode): Boolean;
  934. var
  935. iChild: Integer;
  936. begin
  937. Result := False;
  938. if ANode.Rec.ValueByName('Type').AsInteger = 1 then
  939. Result := OpenProjectManager.ProjectIndex(ANode.ID) > -1
  940. else
  941. begin
  942. if not ANode.HasChildren then
  943. Result := False
  944. else
  945. begin
  946. for iChild := 0 to ANode.ChildCount - 1 do
  947. Result := Result or CheckOpened(ANode.ChildNodes[iChild]);
  948. end
  949. end;
  950. end;
  951. procedure TProjectManagerFrame.ShowProjectInfoTopAndCheckers;
  952. var
  953. vPSArr: TStrArr;
  954. vCArr: TOVArr; // Checkers
  955. sPicPath, sURL: string;
  956. procedure ShowProjectCheckers;
  957. var i, j, k, n: Integer;
  958. vOwner: array of string; // 业主信息
  959. procedure AddCheckerFrame(AType: TCheckerFrameType; AArr: array of string);
  960. var vChecker: TOrderCheckerFrame;
  961. begin
  962. vChecker := TOrderCheckerFrame.Create(self);
  963. FCheckerFrames.Add(vChecker);
  964. vChecker.Owner := Self;
  965. sbChecker.VertScrollBar.Range := sbChecker.VertScrollBar.Range + vChecker.Height;
  966. sbChecker.Height := Min(sbChecker.Height + vChecker.Height, pnlWeb.Height - pnlProject.Height);
  967. vChecker.Parent := sbChecker;
  968. vChecker.Top := FCurPos;
  969. FCurPos := FCurPos + vChecker.Height;
  970. vChecker.Align := alTop;
  971. sPicPath := PHPWeb.UserPath + '1_' + AArr[0] + '.jpg';
  972. PHPWeb.DownFile(AArr[4], sPicPath);
  973. vChecker.Init(AType, StrToInt(AArr[0]), AArr[1], AArr[3],
  974. AArr[2], sPicPath, AArr[6], TCheckStatus(StrToInt(AArr[5])-1), AArr[8], StrToInt(AArr[7]));
  975. vChecker.Name := 'ProjectOrderFrame' + AArr[0];
  976. end;
  977. begin
  978. sbChecker.Height := 0;
  979. FCurPos := 0;
  980. n := Length(vCArr[Low(vCArr)]);
  981. SetLength(vOwner, n);
  982. sbChecker.VertScrollBar.Range := 0;
  983. for i := Low(vCArr) to High(vCArr) do
  984. begin
  985. if StrToInt(vCArr[i, 0]) = PHPWeb.UserID then
  986. FWebCheckStatusMy := TCheckStatus(StrToInt(vCArr[i, 5])-1);
  987. if StrToInt(vCArr[i, 0]) = FWebOwnerID then
  988. begin
  989. for j := 0 to n - 1 do
  990. vOwner[j] := vCArr[i, j];
  991. Continue;
  992. end;
  993. AddCheckerFrame(cftChecker, vCArr[i]);
  994. end;
  995. if vOwner[0] <> '' then
  996. AddCheckerFrame(cftOwner, vOwner);
  997. for k := 0 to sbChecker.ControlCount - 1 do
  998. TOrderCheckerFrame(sbChecker.Controls[k]).Order := k + 1;
  999. OnLineChecker(vCArr, FOnLineCheckerBegin, FOnLineCheckerEnd, FOnLineCheckerEndIsOwner);
  1000. end;
  1001. begin
  1002. FCheckerFrames.Clear;
  1003. GetLocalValues(CurRec);
  1004. if FWebID = 0 then Exit;
  1005. SetLength(vPSArr, 8);
  1006. sURL := Format('%smeasure/status/%d/get', [PHPWeb.MeasureURL, FWebID]);
  1007. SetLength(FCheckers, 0);
  1008. if PHPWeb.Search(sURL, [''], [''], 3, vPSArr, vCArr) = 1 then
  1009. begin
  1010. FCheckers := vCArr;
  1011. LockWindowUpdate(pnlWeb.Handle);
  1012. try
  1013. FPhaseNo := StrToInt(vPSArr[0]);
  1014. FWebCheckStatusProject := TCheckStatus(StrToInt(vPSArr[1])-1);
  1015. FPhaseTotal := StrToInt(vPSArr[2]);
  1016. FWebFolder_OnLine := vPSArr[3];
  1017. FWebSubFolder_OnLine := vPSArr[4];
  1018. FWebOwnerName := vPSArr[5];
  1019. FWebOwnerCompany := vPSArr[6];
  1020. FWebOwnerRole := vPSArr[7];
  1021. ShowProjectInfoTop;
  1022. ShowProjectCheckers;
  1023. finally
  1024. LockWindowUpdate(0);
  1025. end;
  1026. end
  1027. else
  1028. begin
  1029. FPhaseNo := 0;
  1030. FWebCheckStatusProject := csNotBegin;
  1031. FPhaseTotal := 0;
  1032. FWebFolder_OnLine := '';
  1033. FWebSubFolder_OnLine := '';
  1034. FWebOwnerName := '';
  1035. FWebOwnerCompany := '';
  1036. FWebOwnerRole := '';
  1037. ShowProjectInfoTop;
  1038. sbChecker.Height := 0;
  1039. end;
  1040. end;
  1041. procedure TProjectManagerFrame.ShowProjectInfoTop(AType: Integer);
  1042. procedure ShowOwner;
  1043. begin
  1044. lblBidName.Caption := FWebBidName_Local;
  1045. lblBidName.Update;
  1046. lblProjName.Caption := FWebFolder_OnLine;
  1047. lblProjName.Update;
  1048. lblWebProjCtgyName.Caption := FWebSubFolder_OnLine;
  1049. lblWebProjCtgyName.Update;
  1050. lblOnwerName.Caption := FWebOwnerName;
  1051. lblOnwerName.Update;
  1052. lblOnwerCompany.Caption := Format('-%s)', [FWebOwnerCompany]);
  1053. lblOnwerCompany.Update;
  1054. lblOnwerCompany.Left := lblOnwerName.Left + lblOnwerName.Width;
  1055. end;
  1056. procedure ShowStatus(ANo: Integer; AState: TCheckStatus);
  1057. begin
  1058. lblPeriod.Caption := Format('第%d期', [ANo]);
  1059. lblPeriod.Update;
  1060. lblPeriodState.Caption := CheckStatusNames[AState];
  1061. lblPeriodState.Font.Color := CheckStatusColors[AState];
  1062. lblPeriodState.Update;
  1063. lblPeriodState.Left := lblPeriod.Left + lblPeriod.Width + 5;
  1064. lblPeriodTotal.Caption := Format('(共%d期)', [ANo]);
  1065. lblPeriodTotal.Update;
  1066. lblPeriodTotal.Left := lblPeriodState.Left + lblPeriodState.Width + 3;
  1067. end;
  1068. begin
  1069. GetLocalValues(CurRec);
  1070. case AType of
  1071. -2:
  1072. begin
  1073. lblPeriod.Caption := '正在从云端读取状态信息...';
  1074. lblPeriod.Update;
  1075. end;
  1076. -1:
  1077. begin
  1078. ShowOwner;
  1079. ShowStatus(FPhaseNo, FWebCheckStatusProject);
  1080. end;
  1081. 0:
  1082. begin
  1083. ShowOwner;
  1084. ShowStatus(0, csNotBegin);
  1085. end;
  1086. end;
  1087. end;
  1088. // 检查后,应该定位到最后一层目录,不应该回到原先的选择节点。否则从网络拉下来的项目无法组织正确的树结构。
  1089. procedure TProjectManagerFrame.CheckWebFolders(AFolderID, ASubFolderID: Integer;
  1090. AFolderName, ASubFolderName: string);
  1091. var
  1092. vTree: TsdIDTree;
  1093. vNode, vSubNode: TsdIDTreeNode;
  1094. i: Integer;
  1095. sName: string;
  1096. iUserID, iWebID, iWebFolderLevel: Integer;
  1097. bExist, bSubExist, bModified: Boolean;
  1098. begin
  1099. bExist := False;
  1100. bSubExist := False;
  1101. bModified := False;
  1102. vTree := stdProjects.IDTree;
  1103. for i := 0 to vTree.Count - 1 do
  1104. begin
  1105. vNode := vTree.Items[i];
  1106. sName := vNode.Rec.ValueByName('Name').AsString;
  1107. iUserID := vNode.Rec.ValueByName('WebUserID').AsInteger;
  1108. iWebID := vNode.Rec.ValueByName('WebID').AsInteger;
  1109. iWebFolderLevel := vNode.Rec.ValueByName('WebFolderLevel').AsInteger;
  1110. if (iWebID = AFolderID) and (iWebFolderLevel = G_WFL_ProjName) and (iUserID = PHPWeb.UserID) then
  1111. begin
  1112. bExist := True;
  1113. vNode.LocateInControl;
  1114. if not SameText(sName, AFolderName) then
  1115. begin
  1116. vNode.Rec.ValueByName('Name').AsString := AFolderName;
  1117. bModified := True;
  1118. end;
  1119. Break;
  1120. end;
  1121. end;
  1122. if not bExist then
  1123. begin
  1124. vNode := vTree.Items[0];
  1125. if Assigned(vNode) then
  1126. vNode.LocateInControl;
  1127. vNode := FProjectManagerData.InsertProject(AFolderName, stdProjects.IDTree.Selected, AFolderID, G_WFL_ProjName);
  1128. vNode.LocateInControl;
  1129. end;
  1130. for i := 0 to vNode.ChildCount - 1 do
  1131. begin
  1132. vSubNode := vNode.ChildNodes[i];
  1133. sName := vSubNode.Rec.ValueByName('Name').AsString;
  1134. iUserID := vSubNode.Rec.ValueByName('WebUserID').AsInteger;
  1135. iWebID := vSubNode.Rec.ValueByName('WebID').AsInteger;
  1136. iWebFolderLevel := vSubNode.Rec.ValueByName('WebFolderLevel').AsInteger;
  1137. if (iWebID = ASubFolderID) and (iWebFolderLevel = G_WFL_BidType) and (iUserID = PHPWeb.UserID) then
  1138. begin
  1139. bSubExist := True;
  1140. vSubNode.LocateInControl;
  1141. if not SameText(sName, ASubFolderName) then
  1142. begin
  1143. vSubNode.Rec.ValueByName('Name').AsString := ASubFolderName;
  1144. bModified := True;
  1145. end;
  1146. Break;
  1147. end;
  1148. end;
  1149. if not bSubExist then
  1150. begin
  1151. vNode.LocateInControl;
  1152. vNode := FProjectManagerData.InsertSubProject(ASubFolderName, stdProjects.IDTree.Selected, ASubFolderID, G_WFL_BidType);
  1153. vNode.LocateInControl;
  1154. end;
  1155. if bModified then
  1156. ProjectManager.Save;
  1157. end;
  1158. function TProjectManagerFrame.Rec(AProjectID: Integer): TsdDataRecord;
  1159. var i: Integer;
  1160. vTree: TsdIDTree;
  1161. begin
  1162. vTree := stdProjects.IDTree;
  1163. if vTree.Selected.Rec.ValueByName('ID').AsInteger = AProjectID then
  1164. begin
  1165. Result := stdProjects.IDTree.Selected.Rec;
  1166. Exit;
  1167. end;
  1168. for i := 0 to vTree.Count - 1 do
  1169. begin
  1170. if vTree.Items[i].Rec.ValueByName('ID').AsInteger = AProjectID then
  1171. begin
  1172. Result := vTree.Items[i].Rec;
  1173. vTree.Items[i].LocateInControl;
  1174. Break;
  1175. end;
  1176. end;
  1177. end;
  1178. destructor TProjectManagerFrame.Destroy;
  1179. begin
  1180. FCheckerFrames.Free;
  1181. inherited;
  1182. end;
  1183. procedure TProjectManagerFrame.DoBatchReceiveOnline(ARequestType: Integer);
  1184. var
  1185. sURL, sCheckersURL, sHint: string;
  1186. vArr: TOVArr;
  1187. i, iFolderID, iSubFolderID: Integer;
  1188. vPSArr: TStrArr;
  1189. vCArr: TOVArr; // Checkers
  1190. begin
  1191. // 查询等待我审核的标段文件,杰哥说分三种:①业主未审核 ②业主审核中 ③审核人审核中 (为什么加①?问杰哥)
  1192. case PHPWeb.Search(PHPWeb.MeasureURL + 'user/get/audit/project', ['audituid', 'RequestType'],
  1193. [IntToStr(PHPWeb.UserID), IntToStr(ARequestType)], vArr) of
  1194. 1:
  1195. begin
  1196. CreateProgress('正在从云端下载新项目');
  1197. try
  1198. for i := Low(vArr) to High(vArr) do
  1199. begin
  1200. sURL := vArr[i, 0];
  1201. FWebFolder_OnLine := vArr[i, 1];
  1202. FWebSubFolder_OnLine := vArr[i, 2];
  1203. FWebMD5_OnLine := vArr[i, 3];
  1204. FWebID := StrToInt(vArr[i, 5]);
  1205. iFolderID := StrToInt(vArr[i, 6]);
  1206. iSubFolderID := StrToInt(vArr[i, 7]);
  1207. FWebCheckStatusMy := TCheckStatus(StrToInt(vArr[i, 8])-1); // vArr[i, 4]项目审核状态;vArr[i, 8]当前登陆用户的审核状态
  1208. FWebAuthorID := StrToInt(vArr[i, 9]);
  1209. FWebBidName_OnLine := vArr[i, 10];
  1210. FWebMD5_Local := LocalMD5(PHPWeb.UserID, FWebID);
  1211. CheckWebFolders(iFolderID, iSubFolderID, FWebFolder_OnLine, FWebSubFolder_OnLine);
  1212. CheckBidName(PHPWeb.UserID, FWebID, FWebBidName_OnLine);
  1213. if FWebMD5_OnLine <> FWebMD5_Local then
  1214. begin
  1215. sCheckersURL := Format('%smeasure/status/%d/get', [PHPWeb.MeasureURL, FWebID]);
  1216. if PHPWeb.Search(sCheckersURL, [''], [''], 3, vPSArr, vCArr) = 1 then
  1217. OnLineChecker(vCArr, FOnLineCheckerBegin, FOnLineCheckerEnd, FOnLineCheckerEndIsOwner)
  1218. else
  1219. begin
  1220. FOnLineCheckerBegin := 0;
  1221. FOnLineCheckerEnd := 0;
  1222. end;
  1223. if not FileDownAndReceive(sURL, 1) then Exit;
  1224. end;
  1225. end;
  1226. BubbleSortProjects;
  1227. finally
  1228. CloseProgress;
  1229. end;
  1230. end;
  1231. 0:
  1232. begin
  1233. sHint := 'Web页返回错误(000J),无法查询云端项目的更新情况,请重试!';
  1234. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  1235. Exit;
  1236. end;
  1237. -1:
  1238. begin
  1239. sHint := '网络较差,服务器断开连接,无法查询云端项目的更新情况,请重试!';
  1240. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  1241. Exit;
  1242. end;
  1243. end;
  1244. end;
  1245. function TProjectManagerFrame.ImportFile(const AFileName: string; AFileMD5: string): Boolean;
  1246. var
  1247. vImport: TTenderImport;
  1248. vNode: TsdIDTreeNode;
  1249. begin
  1250. Result := False;
  1251. vNode := stdProjects.IDTree.Selected;
  1252. vImport := TTenderImport.Create(vNode, '', AFileName);
  1253. try
  1254. try
  1255. vImport.ImportToSelect;
  1256. vNode.LocateInControl;
  1257. Result := True;
  1258. except
  1259. Result := False;
  1260. end;
  1261. finally
  1262. vImport.Free;
  1263. vNode.Rec.BeginUpdate;
  1264. vNode.Rec.ValueByName('WebMD5').AsString := AFileMD5;
  1265. vNode.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID;
  1266. vNode.Rec.EndUpdate;
  1267. FProjectManagerData.Save;
  1268. end;
  1269. end;
  1270. procedure TProjectManagerFrame.actnOpenBackupFolderExecute(
  1271. Sender: TObject);
  1272. var
  1273. stnNode: TsdIDTreeNode;
  1274. begin
  1275. stnNode := stdProjects.IDTree.Selected;
  1276. if stnNode.Rec.ValueByName('BackupFolder').AsString = '' then
  1277. TipMessage('该项目暂无备份数据!')
  1278. else
  1279. ShellExecute(Handle, 'open', 'Explorer.exe',
  1280. PChar(FProjectManagerData.BackupPath(stnNode.ID)), nil, 1);
  1281. end;
  1282. procedure TProjectManagerFrame.actnRenameUpdate(Sender: TObject);
  1283. var
  1284. Rec: TsdDataRecord;
  1285. bNet, bEnabled: Boolean;
  1286. begin
  1287. if Assigned(stdProjects.IDTree.Selected) and Assigned(stdProjects.IDTree.Selected.Rec) then
  1288. begin
  1289. bEnabled := True;
  1290. Rec := stdProjects.IDTree.Selected.Rec;
  1291. bNet := G_IsCloud;
  1292. if bNet then
  1293. begin
  1294. bEnabled := (Rec.ValueByName('Type').AsInteger = 1) and
  1295. (Rec.ValueByName('WebAuthorID').AsInteger = PHPWeb.UserID);
  1296. end;
  1297. end
  1298. else
  1299. bEnabled := False;
  1300. if bEnabled <> TAction(Sender).Enabled then
  1301. TAction(Sender).Enabled := bEnabled;
  1302. end;
  1303. procedure TProjectManagerFrame.CheckBidName(AID: Integer; ANewBidName: string);
  1304. var vNode: TsdIDTreeNode;
  1305. begin
  1306. vNode := stdProjects.IDTree.FindNode(AID);
  1307. if vNode = nil then Exit;
  1308. if vNode.Rec.ValueByName('Name').AsString <> ANewBidName then
  1309. begin
  1310. vNode.Rec.ValueByName('Name').AsString := ANewBidName;
  1311. ProjectManager.Save;
  1312. end;
  1313. end;
  1314. procedure TProjectManagerFrame.DoBatchReceiveAllOnline;
  1315. var
  1316. OnCC: TZjCellNotifyEvent;
  1317. begin
  1318. OnCC := zgProjects.OnCurrentChanged;
  1319. try
  1320. zgProjects.OnCurrentChanged := nil;
  1321. DoBatchReceiveOnline(2);
  1322. if stdProjects.IDTree.FirstNode <> nil then
  1323. stdProjects.IDTree.FirstNode.LocateInControl;
  1324. finally
  1325. zgProjects.OnCurrentChanged := OnCC;
  1326. end;
  1327. end;
  1328. procedure TProjectManagerFrame.GetLocalValues(ARec: TsdDataRecord);
  1329. begin
  1330. if not Assigned(ARec) then
  1331. begin
  1332. ClearLocalValues;
  1333. Exit;
  1334. end;
  1335. // 加这句后产生Bug:上报项目后,记录不曾移动,FID不变,不会刷新
  1336. // if ARec.ValueByName('ID').AsInteger <> FID then
  1337. begin
  1338. FID := ARec.ValueByName('ID').AsInteger;
  1339. FWebID := ARec.ValueByName('WebID').AsInteger;
  1340. FWebAuthorID := ARec.ValueByName('WebAuthorID').AsInteger;
  1341. FWebOwnerID := ARec.ValueByName('WebOwnerID').AsInteger;
  1342. FWebMD5_Local := ARec.ValueByName('WebMD5').AsString;
  1343. FWebBidName_Local := ARec.ValueByName('Name').AsString;
  1344. end;
  1345. end;
  1346. procedure TProjectManagerFrame.GetLocalValues(AUserID, AWebID: Integer);
  1347. var i: Integer;
  1348. vTree: TsdIDTree;
  1349. vRec: TsdDataRecord;
  1350. begin
  1351. ClearLocalValues; // 先清空,以防没找到。
  1352. if (CurRec <> nil) and
  1353. (CurRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1354. (CurRec.ValueByName('WebID').AsInteger = AWebID) and
  1355. (CurRec.ValueByName('Type').AsInteger = 1) then
  1356. begin
  1357. GetLocalValues(CurRec);
  1358. Exit;
  1359. end;
  1360. vTree := stdProjects.IDTree;
  1361. for i := 0 to vTree.Count - 1 do
  1362. begin
  1363. vRec := vTree.Items[i].Rec;
  1364. if (vRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1365. (vRec.ValueByName('WebID').AsInteger = AWebID) and
  1366. (vRec.ValueByName('Type').AsInteger = 1) then
  1367. begin
  1368. GetLocalValues(vRec);
  1369. Break;
  1370. end;
  1371. end;
  1372. end;
  1373. procedure TProjectManagerFrame.ClearLocalValues;
  1374. begin
  1375. FID := -1;
  1376. FWebID := -1;
  1377. FWebAuthorID := -1;
  1378. FWebOwnerID := -1;
  1379. FWebMD5_Local := '';
  1380. FWebBidName_Local := '';
  1381. end;
  1382. function TProjectManagerFrame.LocalMD5(AUserID, AWebID: Integer): string;
  1383. var i: Integer;
  1384. vTree: TsdIDTree;
  1385. vRec: TsdDataRecord;
  1386. begin
  1387. Result := '本地无MD5码';
  1388. if (CurRec <> nil) and
  1389. (CurRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1390. (CurRec.ValueByName('WebID').AsInteger = AWebID) and
  1391. (CurRec.ValueByName('Type').AsInteger = 1) then
  1392. begin
  1393. Result := CurRec.ValueByName('WebMD5').AsString;
  1394. Exit;
  1395. end;
  1396. vTree := stdProjects.IDTree;
  1397. for i := 0 to vTree.Count - 1 do
  1398. begin
  1399. vRec := vTree.Items[i].Rec;
  1400. if (vRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1401. (vRec.ValueByName('WebID').AsInteger = AWebID) and
  1402. (vRec.ValueByName('Type').AsInteger = 1) then
  1403. begin
  1404. Result := vRec.ValueByName('WebMD5').AsString;
  1405. Break;
  1406. end;
  1407. end;
  1408. end;
  1409. function TProjectManagerFrame.CurRec: TsdDataRecord;
  1410. begin
  1411. if stdProjects.IDTree.Selected = nil then
  1412. Result := nil
  1413. else
  1414. Result := stdProjects.IDTree.Selected.Rec;
  1415. end;
  1416. procedure TProjectManagerFrame.CheckBidName(AUserID, AWebID: Integer;
  1417. ANewBidName: string);
  1418. var i: Integer;
  1419. vTree: TsdIDTree;
  1420. vRec: TsdDataRecord;
  1421. begin
  1422. if (CurRec <> nil) and
  1423. (CurRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1424. (CurRec.ValueByName('WebID').AsInteger = AWebID) and
  1425. (CurRec.ValueByName('Type').AsInteger = 1) then
  1426. begin
  1427. if (CurRec.ValueByName('Name').AsString <> ANewBidName) then
  1428. begin
  1429. CurRec.ValueByName('Name').AsString := ANewBidName;
  1430. ProjectManager.Save;
  1431. end;
  1432. Exit;
  1433. end;
  1434. vTree := stdProjects.IDTree;
  1435. for i := 0 to vTree.Count - 1 do
  1436. begin
  1437. vRec := vTree.Items[i].Rec;
  1438. if (vRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1439. (vRec.ValueByName('WebID').AsInteger = AWebID) and
  1440. (vRec.ValueByName('Type').AsInteger = 1) then
  1441. begin
  1442. if vRec.ValueByName('Name').AsString <> ANewBidName then
  1443. begin
  1444. vRec.ValueByName('Name').AsString := ANewBidName;
  1445. ProjectManager.Save;
  1446. end;
  1447. Break;
  1448. end;
  1449. end;
  1450. end;
  1451. function TProjectManagerFrame.CurRecAttachmentPath: string;
  1452. begin
  1453. if G_IsCloud then
  1454. Result := PHPWeb.WebPath + 'Projects\' + CurRec.ValueByName('WebID').AsString + '\Attachment\'
  1455. else
  1456. Result := GetMyProjectsFilePath + 'Attachment\' + CurRec.ValueByName('FileName').AsString + '\';
  1457. end;
  1458. function TProjectManagerFrame.AttachmentFileCountsWithoutManageFile(ANode: TsdIDTreeNode): Integer;
  1459. function GetCount(ANode: TsdIDTreeNode): Integer;
  1460. var sPath: string;
  1461. begin
  1462. if not Assigned(ANode) then Exit;
  1463. Result := 0;
  1464. if ANode.Rec.ValueByName('Type').AsInteger = 0 then
  1465. Result := Result + 0
  1466. else
  1467. begin
  1468. sPath := GetMyProjectsFilePath + 'Attachment\' + ANode.Rec.ValueByName('FileName').AsString + '\';
  1469. Result := Result + FileCount(sPath) - 1;
  1470. end;
  1471. if Assigned(ANode.FirstChild) then
  1472. Result := Result + GetCount(ANode.FirstChild);
  1473. if Assigned(ANode.NextSibling) then
  1474. Result := Result + GetCount(ANode.NextSibling);
  1475. end;
  1476. begin
  1477. if not Assigned(ANode) then Exit;
  1478. if Assigned(ANode.FirstChild) then
  1479. Result := GetCount(ANode.FirstChild)
  1480. else
  1481. Result := 0;
  1482. end;
  1483. procedure TProjectManagerFrame.BubbleSortProjects;
  1484. // 不能排最顶层
  1485. procedure BubbleSort(ANode: TsdIDTreeNode);
  1486. var n, t, c, temp: Integer;
  1487. bSwap: Boolean;
  1488. vNode1, vNode2, vTempNode: TsdIDTreeNode;
  1489. begin
  1490. if ANode = nil then Exit;
  1491. // if ANode.Rec.ValueByName('WebFolderLevel').AsInteger = G_WFL_ProjName then Exit;
  1492. n := ANode.ChildCount;
  1493. for t := 1 to n - 1 do
  1494. begin
  1495. bSwap := False;
  1496. for c := 1 to (n - t) do
  1497. begin
  1498. vNode1 := ANode.ChildNodes[c - 1];
  1499. vNode2 := ANode.ChildNodes[c];
  1500. if AnsiCompareStr(vNode1.Rec.ValueByName('Name').AsString,
  1501. vNode2.Rec.ValueByName('Name').AsString) = 1 then
  1502. begin
  1503. vNode1.DownMove;
  1504. bSwap := True;
  1505. end;
  1506. end;
  1507. if bSwap = False then Break;
  1508. end;
  1509. if Assigned(ANode.FirstChild) then
  1510. BubbleSort(ANode.FirstChild);
  1511. if Assigned(ANode.NextSibling) then
  1512. BubbleSort(ANode.NextSibling);
  1513. end;
  1514. begin
  1515. BubbleSort(stdProjects.IDTree.FirstNode);
  1516. end;
  1517. procedure TProjectManagerFrame.zgProjectsShowHint(var HintStr: String;
  1518. var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint);
  1519. var
  1520. vCell: TZjCell;
  1521. vNode: TsdIDTreeNode;
  1522. iLevelWidth: Integer;
  1523. rText: TRect;
  1524. procedure CalcTextRect(var R: TRect);
  1525. var
  1526. DC: HDC;
  1527. iTextHeight: Integer;
  1528. begin
  1529. DC := CreateCompatibleDC(0);
  1530. try
  1531. SelectObject(DC, vCell.Font.Handle);
  1532. iTextHeight := DrawText(DC, PChar(vCell.Text), Length(vCell.Text), R, DT_SINGLELINE or DT_VCenter
  1533. or DT_NOCLIP or DT_CALCRECT);
  1534. finally
  1535. DeleteDC(DC);
  1536. end;
  1537. end;
  1538. begin
  1539. if (ACoord.Y < 1) and (ACoord.X <> 1) then Exit;
  1540. vCell := zgProjects.Cells[ACoord.X, ACoord.Y];
  1541. with HintInfo do
  1542. begin
  1543. vNode := stdProjects.IDTree.Items[ACoord.Y - 1];
  1544. if not Assigned(vNode) then Exit;
  1545. iLevelWidth := (vNode.Level + 1) * 20 + 16;
  1546. rText := CursorRect;
  1547. CalcTextRect(rText);
  1548. if (rText.Right - rText.Left + iLevelWidth > CursorRect.Right - CursorRect.Left) or
  1549. (rText.Right > ClientWidth) then
  1550. begin
  1551. CanShow := True;
  1552. HintStr := vCell.Text;
  1553. GetCursorPos(HintPos);
  1554. end;
  1555. end;
  1556. end;
  1557. function TProjectManagerFrame.FileDownAndReceive(ADownURL: string; AReceiveKind: Integer): Boolean;
  1558. var sLocalFile, sHint: string;
  1559. bCanImp: Boolean;
  1560. vFileCheck: TTenderFileChecker;
  1561. begin
  1562. Result := False;
  1563. // 下载
  1564. sLocalFile := PHPWeb.UserPath + ExtractFileName(ADownURL);
  1565. if not PHPWeb.DownFile(ADownURL, sLocalFile) then
  1566. begin
  1567. sHint := Format('云端已找到 [%s] 的新文件,但由于网络原因下载失败!请重试!', [FWebBidName_Local]);
  1568. Application.MessageBox(PChar(sHint), '系统提醒', MB_OK + MB_ICONWARNING);
  1569. Exit;
  1570. end;
  1571. // 接收前先检验原报文件是否正确(审核不通过打回)
  1572. if AReceiveKind = 2 then
  1573. begin
  1574. // 有时原报文件出错:包含了1审2审的数据。
  1575. vFileCheck := TTenderFileChecker.Create;
  1576. try
  1577. // 有一期以上数据,且最新期数据审核状态为原报
  1578. bCanImp := vFileCheck.CheckFileValid(sLocalFile) and (vFileCheck.PhaseCount > 0) and (vFileCheck.AuditStatus = 0);
  1579. if not bCanImp then
  1580. begin
  1581. Application.MessageBox(PChar('已从云端下载原报文件到本地,但文件有错误(包含1审数据)禁止接收!请致电纵横服务人员以获取帮助。'),
  1582. '警告', MB_OK + MB_ICONWARNING);
  1583. Exit;
  1584. end;
  1585. finally
  1586. vFileCheck.Free;
  1587. end;
  1588. {注意: 审核末通过的导入更新,这里的MD5码应取最终审核不通过项目的,否则会带来下载循环问题。
  1589. 问题描述:
  1590. ①编制人运行软件,双击项目,发现审核不通过,自动下载无锁文件,开始新一期,保存关闭。
  1591. ②编制人再次运行软件,双击项目,MD5码不同,自动下载旧的审核不通过文件,覆盖本地。
  1592. ③编制人再次运行软件,双击项目,发现审核不通过,重复①,循环....
  1593. 问:①那里下载无锁文件后不能改成新的MD5码吗?
  1594. 答:不能,因为审核人的项目会变成无锁文件,看不到不通过项目。MD5码只能在上传后更新。
  1595. 且编制人有个交互界面2种选择:a.下载更新不通过项目查看;b.下载更新无锁文件开始新一期。}
  1596. end;
  1597. // 接收更新
  1598. if not ReceiveFile(sLocalFile, (AReceiveKind = 2)) then
  1599. begin
  1600. sHint := Format('已从云端下载新的 [%s] 到本地 [%s],但接收失败,请删除该项目然后重新从云端获取!', [FWebBidName_OnLine, sLocalFile]);
  1601. Application.MessageBox(PChar(sHint), '系统提醒', MB_OK + MB_ICONWARNING);
  1602. Exit;
  1603. end;
  1604. if FileExists(sLocalFile) then
  1605. DeleteFile(sLocalFile);
  1606. Result := True;
  1607. end;
  1608. // 为了跟PHP的数组兼容,这里限制数组的第一个元素是A[0](不能是A[1])
  1609. procedure TProjectManagerFrame.OnLineChecker(AAr: TOVArr; var ABegin,
  1610. AEnd: Integer; var AOnLineEndIsOwner: Boolean);
  1611. var i, j: Integer;
  1612. vCS: TCheckStatus;
  1613. begin
  1614. i := 0;
  1615. j := 0;
  1616. ABegin := 0;
  1617. AEnd := 0;
  1618. AOnLineEndIsOwner := AAr[High(AAr), 7] = '1'; // 接口返回的第7列是线上审批标记
  1619. // 数组必须在位置n处截断,后面的部分作废。n的取值情况:
  1620. // ①轮到工作中的那个人的前一个人 ②审核不通过的那个人 ③ 审核通过的人是业主
  1621. if AOnLineEndIsOwner then
  1622. AEnd := High(AAr) + 1
  1623. else
  1624. begin
  1625. for i := High(AAr) downto 0 do
  1626. begin
  1627. vCS := TCheckStatus(StrToInt(AAr[i, 5]) - 1);
  1628. if vCS = csChecking then
  1629. begin
  1630. if (i > 0) and (AAr[i - 1, 7] = '1') then // 前一个人且不是第一个人
  1631. AEnd := i;
  1632. Break;
  1633. end
  1634. else if vCS = csNotPass then
  1635. begin
  1636. if AAr[i, 7] = '1' then
  1637. AEnd := i + 1;
  1638. Break;
  1639. end;
  1640. end;
  1641. end;
  1642. if AEnd = 0 then Exit;
  1643. if AEnd = 1 then
  1644. begin
  1645. ABegin := 1;
  1646. Exit;
  1647. end;
  1648. for j := AEnd -2 downto 0 do
  1649. begin
  1650. if AAr[j, 7] = '0' then
  1651. begin
  1652. ABegin := j + 2;
  1653. Break;
  1654. end
  1655. else
  1656. begin
  1657. if j = 0 then
  1658. ABegin := 1;
  1659. end;
  1660. end;
  1661. end;
  1662. procedure TProjectManagerFrame.actnExportUpdate(Sender: TObject);
  1663. begin
  1664. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected);
  1665. end;
  1666. procedure TProjectManagerFrame.actnOpenBackupFolderUpdate(Sender: TObject);
  1667. begin
  1668. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected) and
  1669. (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1);
  1670. end;
  1671. procedure TProjectManagerFrame.pnlProgressClick(Sender: TObject);
  1672. var s: string;
  1673. begin
  1674. if (GetKeyState(VK_LSHIFT) < 0) and (GetKeyState(VK_LCONTROL) < 0) then
  1675. begin
  1676. s := Format('%d, %d, %s', [FOnLineCheckerBegin, FOnLineCheckerEnd, BoolToStr(FOnLineCheckerEndIsOwner)]);
  1677. Application.MessageBox(Pchar(s), 'Hint');
  1678. end;
  1679. end;
  1680. procedure TProjectManagerFrame.actnSignOnlineExecute(Sender: TObject);
  1681. var
  1682. iPhase: Integer;
  1683. begin
  1684. LoadSignOnlineSwitch;
  1685. if (FSignOnlineSwitch = 0) then
  1686. WarningMessage('云端未开启在线签署功能。')
  1687. else if SelectOnlineSignPhase(iPhase, stdProjects.IDTree.Selected.Rec) then
  1688. SignOnline(stdProjects.IDTree.Selected, iPhase);
  1689. end;
  1690. procedure TProjectManagerFrame.actnSignOnlineUpdate(Sender: TObject);
  1691. function HasCompletePhase(ARec: TsdDataRecord): Boolean;
  1692. begin
  1693. if (ARec.ValueByName('PhaseCount').AsInteger > 1) then
  1694. Result := True
  1695. else if (ARec.ValueByName('PhaseCount').AsInteger < 1) then
  1696. Result := False
  1697. else
  1698. Result := ARec.ValueByName('AuditStatus').AsInteger = -1;
  1699. end;
  1700. begin
  1701. TAction(Sender).Visible := G_IsCloud and (not IsGuest);
  1702. TAction(Sender).Enabled := (FSignOnlineSwitch = 1) and
  1703. Assigned(stdProjects.IDTree.Selected) and
  1704. (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1) and
  1705. HasCompletePhase(stdProjects.IDTree.Selected.Rec);
  1706. end;
  1707. procedure TProjectManagerFrame.LoadSignOnlineSwitch;
  1708. var
  1709. iResult: Integer;
  1710. sResult: string;
  1711. begin
  1712. FSignOnlineSwitch := 0;
  1713. iResult := PHPWeb.UrlGet(PhPWeb.MeasureURL + 'sign/switch', nil, sResult);
  1714. case iResult of
  1715. 1: FSignOnlineSwitch := StrToIntDef(sResult, 0);
  1716. 0: WarningMessage('网络错误:' + sResult);
  1717. -1: WarningMessage('网络错误:无法连接到云端');
  1718. end;
  1719. end;
  1720. procedure TProjectManagerFrame.actnGuestExecute(Sender: TObject);
  1721. var
  1722. SetGuestForm: TSetGuestForm;
  1723. begin
  1724. CreateProgress('云端取最新审核人列表');
  1725. try
  1726. ShowProjectInfoTopAndCheckers;
  1727. finally
  1728. CloseProgress;
  1729. end;
  1730. SetGuestForm := TSetGuestForm.Create(CurRec.ValueByName('WebID').AsInteger);
  1731. SetGuestForm.Owner := Self;
  1732. try
  1733. SetGuestForm.ShowModal;
  1734. finally
  1735. SetGuestForm.Free;
  1736. end;
  1737. end;
  1738. procedure TProjectManagerFrame.actnGuestUpdate(Sender: TObject);
  1739. begin
  1740. TAction(Sender).Visible := G_IsCloud and (not IsGuest);
  1741. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected) and
  1742. (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1);
  1743. end;
  1744. function TProjectManagerFrame.UserIsChecker(UserID: Integer): Boolean;
  1745. var i: Integer;
  1746. begin
  1747. Result := False;
  1748. if FWebAuthorID = UserID then
  1749. begin
  1750. Result := True;
  1751. Exit;
  1752. end;
  1753. for i := Low(FCheckers) to High(FCheckers) do
  1754. begin
  1755. if StrToInt(FCheckers[i, 0]) = UserID then
  1756. begin
  1757. Result := True;
  1758. Break;
  1759. end;
  1760. end;
  1761. end;
  1762. function TProjectManagerFrame.IsGuest: Boolean;
  1763. begin
  1764. Result := not UserIsChecker(PHPWeb.UserID);
  1765. end;
  1766. procedure TProjectManagerFrame.actnEpureExecute(Sender: TObject);
  1767. var
  1768. iPhase: Integer;
  1769. begin
  1770. LoadEpureOnlineSwitch;
  1771. if (FEpureOnlineSwitch = 0) then
  1772. WarningMessage('云端未开启在线签署功能。')
  1773. else if SelectOnlineSignPhase(iPhase, stdProjects.IDTree.Selected.Rec) then
  1774. EpureOnline(stdProjects.IDTree.Selected, iPhase);
  1775. end;
  1776. procedure TProjectManagerFrame.LoadEpureOnlineSwitch;
  1777. var
  1778. iResult: Integer;
  1779. sResult: string;
  1780. begin
  1781. FEpureOnlineSwitch := 0;
  1782. iResult := PHPWeb.UrlGet(PhPWeb.MeasureURL + 'intermediate/switch', nil, sResult);
  1783. case iResult of
  1784. 1: FEpureOnlineSwitch := StrToIntDef(sResult, 0);
  1785. 0: WarningMessage('网络错误:' + sResult);
  1786. -1: WarningMessage('网络错误:无法连接到云端');
  1787. end;
  1788. end;
  1789. end.