ProjectManagerFme.pas 71 KB

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