| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276 | unit ProjectManagerFme;interfaceuses  ProjectManagerDm, ZhAPI,  NewProjectFrm,  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, ZjGridDBA, ZJGrid, ComCtrls, ToolWin, ActnList,  dxBar, sdGridDBA, sdGridTreeDBA, sdIDTree, CslJson, ExtCtrls,  StdCtrls, sdDB, CslButton, OrderCheckerFme, Contnrs;type  TStrArr = array of string;  TProjectManagerFrame = class(TFrame)    ToolBar: TToolBar;    tobtnOpen: TToolButton;    zgProjects: TZJGrid;    tobtnDelete: TToolButton;    ActionList1: TActionList;    actnOpen: TAction;    actnDelete: TAction;    dxpmProjectManager: TdxBarPopupMenu;    actnReceiveProject: TAction;    stdProjects: TsdGridTreeDBA;    actnNewProject: TAction;    actnNewSubProject: TAction;    actnNewTender: TAction;    pnlTenderProperty: TPanel;    sdTenderProperty: TsdGridDBA;    sprProperty: TSplitter;    tobtnRenane: TToolButton;    actnRename: TAction;    tobtnImport: TToolButton;    tobtnExport: TToolButton;    actnImport: TAction;    actnExport: TAction;    tobtn1: TToolButton;    pnlWeb: TPanel;    pnlProject: TPanel;    shp2: TShape;    shp1: TShape;    shp3: TShape;    shp4: TShape;    pnlTenderTitle: TPanel;    lblBidName: TLabel;    pnlShadow: TPanel;    pnlProgress: TPanel;    lblPeriodTotal: TLabel;    lblPeriodState: TLabel;    lblProgress: TLabel;    lblPeriod: TLabel;    pnlBelongProject: TPanel;    lblBelongProject: TLabel;    lblProjName: TLabel;    lblLeftHalfBracket: TLabel;    lblOnwerCompany: TLabel;    lblOnwerName: TLabel;    pnlProjectType: TPanel;    lblProjectType: TLabel;    lblWebProjCtgyName: TLabel;    zgTenderProperty: TZJGrid;    actnOpenBackupFolder: TAction;    sbChecker: TScrollBox;    actnSignOnline: TAction;    actnGuest: TAction;    actnEpure: TAction;    procedure actnOpenExecute(Sender: TObject);    procedure actnDeleteExecute(Sender: TObject);    procedure zgProjectsMouseDown(Sender: TObject; Button: TMouseButton;      Shift: TShiftState; X, Y: Integer);    procedure actnReceiveProjectExecute(Sender: TObject);    procedure actnNewProjectExecute(Sender: TObject);    procedure actnNewSubProjectExecute(Sender: TObject);    procedure actnNewTenderExecute(Sender: TObject);    procedure zgProjectsDrawCellText(ACanvas: TCanvas; const ARect: TRect;      const ACoord: TPoint; AGrid: TZJGrid; const Text: String;      var ADefaultDraw: Boolean);    procedure actnNewSubProjectUpdate(Sender: TObject);    procedure actnNewTenderUpdate(Sender: TObject);    procedure zgProjectsCurrentChanged(Sender: TObject; Col, Row: Integer);    procedure actnSubmitProjectUpdate(Sender: TObject);    procedure actnReplyProjectUpdate(Sender: TObject);    procedure actnRenameExecute(Sender: TObject);    procedure actnOpenUpdate(Sender: TObject);    procedure actnImportExecute(Sender: TObject);    procedure actnExportExecute(Sender: TObject);    procedure actnDeleteUpdate(Sender: TObject);    procedure actnOpenBackupFolderExecute(Sender: TObject);    procedure actnRenameUpdate(Sender: TObject);    procedure zgProjectsShowHint(var HintStr: String; var CanShow: Boolean;      var HintInfo: THintInfo; const ACoord: TPoint);    procedure actnExportUpdate(Sender: TObject);    procedure actnOpenBackupFolderUpdate(Sender: TObject);    procedure pnlProgressClick(Sender: TObject);    procedure actnSignOnlineExecute(Sender: TObject);    procedure actnSignOnlineUpdate(Sender: TObject);    procedure actnGuestExecute(Sender: TObject);    procedure actnGuestUpdate(Sender: TObject);    procedure actnEpureExecute(Sender: TObject);    procedure actnEpureUpdate(Sender: TObject);    procedure zgProjectsCellGetColor(Sender: TObject; ACoord: TPoint;      var AColor: TColor);    procedure zgProjectsCellGetFont(Sender: TObject; ACoord: TPoint;      AFont: TFont);  private    FProjectManagerData: TProjectManagerData;                                             // Chenshilong,2016.03.24                                             // 这部分线上和本地一致,无需区分    FID: Integer;                            // 本地标段文件ID    FWebID: Integer;                         // 关联服务器用的ID(服务器有自己的ID体系)    FWebAuthorID: Integer;                   // 编制人    FWebOwnerID: Integer;                    // 业主                                             // 本地存储值、线上存储值。线上修改后,需要同步到本地    FWebMD5_Local: string;                   // 本地存储的MD5    FWebMD5_OnLine: string;                  // 线上存储的最新的MD5(下同)    FWebBidName_Local: string;               // 标段名 (当无法同线上取得联系时,本地需要用到该名称来提示)    FWebBidName_OnLine: string;    FWebFolder_OnLine: string;               // 这个命名不妥,但很直观。线上的项目名称、项目类型概念跟本地颠倒,很混乱。    FWebSubFolder_OnLine: string;    FWebOwnerCompany: string;    FWebOwnerRole: string;    FWebOwnerName: string;    FWebCheckStatusMy: TCheckStatus;          // 登陆用户在当前项目中的工作状态。    FWebCheckStatusProject: TCheckStatus;     // 项目的审核状态。    FOnLineCheckerBegin: Integer;               // 线上审批的起始人。 010110111 起7止9。 0101101110 起0止0。    FOnLineCheckerEnd: Integer;                 // 线上审批的截止人。    FOnLineCheckerEndIsOwner: Boolean;          // 终审是线上审批    FPhaseTotal: Integer;    FPhaseNo: Integer;    FCurPos: Integer;                         // 用来控制审核人的添加位置    FCheckers: TOVArr;    FCheckerFrames: TObjectList;    FSignOnlineSwitch: Integer;    FEpureOnlineSwitch: Integer;    function ReceiveFile(const AFileName: string; AIsReback: Boolean = False; AWorking: Boolean = False): Boolean;    function ImportFile(const AFileName: string; AFileMD5: string = ''): Boolean;    procedure ConnectButtonWithAction;    function GetImportProjectName(const AFileName: string; AParent: TsdIDTreeNode): string;    function IsProject(ANode: TsdIDTreeNode): Boolean;    function IsLeafProject(ANode: TsdIDTreeNode): Boolean;    function IsUnEmptyLeafProject(ANode: TsdIDTreeNode): Boolean;    function CheckOpened(ANode: TsdIDTreeNode): Boolean;    procedure SetPropertyVisible(AVisible: Boolean);    procedure ShowProjectInfoTopAndCheckers;    // 网络上的目录结构,本地有则定位,没有则创建。    procedure CheckWebFolders(AFolderID, ASubFolderID: Integer;      AFolderName, ASubFolderName: string);    // ANewBidName: 项目的最新标段名(取自服务器,有人改名了,本地的就变成旧的)    procedure CheckBidName(AID: Integer; ANewBidName: string);    procedure CheckLocalProperties(AUserID, AWebID: Integer; ANewBidName, ANewCheckStatus: string);    procedure ClearLocalValues;    procedure GetLocalValues(ARec: TsdDataRecord); overload;    // 用户ID、网络标段ID、Type=1可以定位一个标段。    procedure GetLocalValues(AUserID, AWebID: Integer); overload;    // 1 等待我审核的标段文件; 2 我参与的全部标段文件    procedure DoBatchReceiveOnline(ARequestType: Integer);    function LocalMD5(AUserID, AWebID: Integer): string;    procedure BubbleSortProjects;    // AReceiveKind: 1 接收; 2 导入    function FileDownAndReceive(ADownURL: string; AReceiveKind: Integer; AWorking: Boolean = false): Boolean;    // 线上审批的起止人    procedure OnLineChecker(AAr: TOVArr; var ABegin, AEnd: Integer; var AOnLineEndIsOwner: Boolean);    procedure LoadSignOnlineSwitch;    procedure LoadEpureOnlineSwitch;    procedure LoadOnlineInfo;    procedure CheckOnlineSignStatusAndUpdate(ARec: TsdDataRecord);  public    constructor Create(AOwner: TComponent); override;    destructor Destroy; override;    procedure DoBatchReceiveAllOnline;    // AType: -2 繁忙; -1 正常读取; 0 第0期; 1 第1期。    procedure ShowProjectInfoTop(AType: Integer = -1);    function Rec(AProjectID: Integer): TsdDataRecord;    function RecByWebID(AWebID: Integer): TsdDataRecord;    function HighlightProject(AWebID: Integer): Boolean;    function CurRec: TsdDataRecord;    function CurRecAttachmentPath: string;    function AttachmentFileCountsWithoutManageFile(ANode: TsdIDTreeNode): Integer;    function UserIsChecker(UserID: Integer): Boolean; // 判断指定ID的用户是否是参与人    function IsGuest: Boolean;    property ProjectCheckStatus: TCheckStatus read FWebCheckStatusProject;  end;implementationuses  MainFrm, UtilMethods, ProjectCommands, Globals, ConfigDoc, ConstUnit,  WebNewTenderFrm, PHPWebDm, Math, mProgressFrm, ProgressHintFrm,  ShellAPI, ProjectFme, SelectOnlineSignPhaseFrm, SignOnlineReportsFrm,  ConditionalDefines, SetGuestFrm;{$R *.dfm}procedure TProjectManagerFrame.ConnectButtonWithAction;begin  SetDxBtnAction(actnNewProject, MainForm.dxbtnNewProject);  SetDxBtnAction(actnNewSubProject, MainForm.dxbtnNewSubProject);  SetDxBtnAction(actnNewTender, MainForm.dxbtnNewTender);  SetDxBtnAction(actnOpen, MainForm.dxbtnOpenProject);  SetDxBtnAction(actnDelete, MainForm.dxbtnDeleteProject);  SetDxBtnAction(actnReceiveProject, MainForm.dxbtnReceiveProject);  SetDxBtnAction(actnOpenBackupFolder, MainForm.dxbtnOpenBackupFolder);  SetDxBtnAction(actnRename, MainForm.dxbtnRename);  SetDxBtnAction(actnSignOnline, MainForm.dxbtnSignOnline);  SetDxBtnAction(actnGuest, MainForm.dxbtnGuest);  SetDxBtnAction(actnEpure, MainForm.dxbtnEpure);end;constructor TProjectManagerFrame.Create(AOwner: TComponent);begin  inherited;  FCheckerFrames := TObjectList.Create;  FProjectManagerData := ProjectManager;  FProjectManagerData.Open;  stdProjects.IDTree := FProjectManagerData.ProjectsTree;  sdTenderProperty.DataView := FProjectManagerData.sdvTenderProperty;  ConnectButtonWithAction;  SetPropertyVisible(False);  sbChecker.Height := 0;  if G_IsCloud then  begin    Application.HintPause := 200;    Application.HintHidePause := 60000;    LoadSignOnlineSwitch;    LoadEpureOnlineSwitch;    tobtnImport.Visible := False;    stdProjects.TreeOptions := stdProjects.TreeOptions - [aoAllowUpLevel, aoAllowDownLevel];    stdProjects.Options := stdProjects.Options - [aoAllowUpMove, aoAllowDownMove];    CreateProgress('正在从云端下载新项目');    try      actnReceiveProject.Execute;    finally      CloseProgress;    end;  end;end;// 双击打开项目 TagBprocedure TProjectManagerFrame.actnOpenExecute(Sender: TObject);var  vSel: TsdIDTreeNode;  vRec: TsdDataRecord;  sHint: string;  function SearchFileOnline(AURL: string; var ADownURL, AFolder, ASubFolder, ABidName, AMD5Web, AError: string; var AFolderID, ASubFolderID: Integer): Integer;  var vArr: TOVArr;  begin    Result := PHPWeb.Search(AURL, [''], [''], vArr);    AError := '';    if Result = 1 then    begin      if High(vArr) >= 0 then      begin        ADownURL := vArr[0, 0];        AFolder := vArr[0, 2];        ASubFolder := vArr[0, 3];        AMD5Web := vArr[0, 1];        AFolderID := StrToInt(vArr[0, 4]);        ASubFolderID := StrToInt(vArr[0, 5]);        ABidName := vArr[0, 6];      end      else        Result := 10;      // 返回10,表示无记录。用这个数字代表是否觉得怪异?没办法,0被占用了。    end    else if Result = 0 then      AError := PHPWeb.PageError('标段更新数据失败')    else if Result = -1 then      AError := PHPWeb.NetError('标段更新数据失败');  end;  function CanOpen: Boolean;  var    sSearchURL, sDownURL,    sMD5_UnLock, sError, sLocalFile: string;    iSearch, iFolderID, iSubFolderID: Integer;    bLock, bCanImp: Boolean;    vFileCheck: TTenderFileChecker;  begin    Result := False;    // 先按正常接口找到最新的MD5码看是否需要更新    sSearchURL := Format('%stender/get/%d/update', [PHPWeb.MeasureURL, FWebID]);    iSearch := SearchFileOnline(sSearchURL, sDownURL, FWebFolder_OnLine, FWebSubFolder_OnLine, FWebBidName_OnLine, FWebMD5_OnLine, sError, iFolderID, iSubFolderID);    if iSearch = 1 then    begin      try        CheckWebFolders(iFolderID, iSubFolderID, FWebFolder_OnLine, FWebSubFolder_OnLine);        CheckBidName(FID, FWebBidName_OnLine);      finally        if vSel <> nil then          vSel.LocateInControl;      end;      // 打开前一定要先下载最新的标段文件(无论审核有没有通过)      if FWebMD5_OnLine <> FWebMD5_Local then        if not FileDownAndReceive(sDownURL, 1) then Exit;      // 编制人且项目末通过      if (FWebAuthorID = PHPWeb.UserID) and (FWebCheckStatusProject = csNotPass) then      begin        sHint := '本期计量审批不通过,你现在可以:' + #10#13 + '点击【是(Y)】重新开始本期计量,软件将打开本期上报时的数据,开始重新计量;' +          #10#13 +'点击【否(N)】查看不通过计量,软件将打开本期最后审批的数据,重新打开标段' + '可再次打开本确认窗口。';        if Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION) = ID_Yes then        begin          // 查找原报的文件          sSearchURL := Format('%suser/get/%d/%d/report/file', [PHPWeb.MeasureURL, FWebID, FPhaseNo]);          case SearchFileOnline(sSearchURL, sDownURL, FWebFolder_OnLine, FWebSubFolder_OnLine, FWebBidName_OnLine, sMD5_UnLock, sError, iFolderID, iSubFolderID) of            1: ; // 原报文件已正确找到            0, -1:            begin              sHint := sError + ' 因网络出错,无法连接到云端以获取本期原报上传的文件,无法重新开始本期,请重试。';              Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);              Exit;            end;          end;          if FileDownAndReceive(sDownURL, 2) then          begin            // 这里在线上创建新一期审批人列表、更改标段状态。不再使用同步更新等。            sSearchURL := Format('%suser/create/%d/%d/new/audit', [PHPWeb.MeasureURL, FWebID, FPhaseNo]);            case SearchFileOnline(sSearchURL, sDownURL, FWebFolder_OnLine, FWebSubFolder_OnLine, FWebBidName_OnLine, sMD5_UnLock, sError, iFolderID, iSubFolderID) of              1, 10:    // 执行到这里线上审核人列表已创建完毕。无需返回记录值,所以返回值为10。1是为了兼容。              begin                sHint := '【十分重要】:本期计量已重新开始,原报在本次上报完成前,请勿删除该标段或更换电脑。';                Application.MessageBox(PChar(sHint), '提示', MB_OK + MB_ICONINFORMATION);              end;              0, -1:              begin                sHint := sError + ' 因网络出错,无法在线上创建新一期审批人列表、提交项目状态等,请重试。';                Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);                Exit;              end;            end;          end          else            Exit;        end;      end;    end    else if (iSearch = 10) then    begin      if not PHPWeb.ExistInServer(FWebID) then      begin        sHint :='该项目[' + FWebBidName_Local + ']在云端已被删除,点击"确定"后,可手动删除该项目。';        Application.MessageBox(PChar(sHint), '提示', MB_OK + MB_ICONINFORMATION);        Exit;      end;    end    else if (iSearch = 0) or (iSearch = -1) then    begin      sHint := sError + '(因网络出错,无法检测[' + FWebBidName_Local + ']在云端是否有更新,本次操作已取消,请重试)。';      Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);      Exit;    end;    Result := True;  end;var  CurProjectFme: TProjectFrame;begin  // 打开前先下载更新  Screen.Cursor := crHourGlass;  try    vSel := stdProjects.IDTree.Selected;    vRec := vSel.Rec;    if G_IsCloud then    begin      GetLocalValues(CurRec);      // 以下这段已经包含在MainForm.OpenProject(vRec)中了,但在调用这句之前,网络版要提前用一下。      if MainForm.HasOpened(FID) then      begin        MainForm.LocateProject(FID);        Exit;      end;      if not CanOpen then        Exit;    end;    CurProjectFme := MainForm.OpenProject(vRec);    if G_IsCloud then    begin      // 云版,如果用户在打开项目的过程中,切换界面回项目管理,MainFrom.CurProjectFrame值为nil,后面的调用,包括MainForm.actnCloseProject.Execute都会出错      // 其中由于前面调用的MainForm.LocateProject触发的一系列事件中,调用到了SetPropertyVisible,其中执行了Screen.Cursor := crDefault      // 导致鼠标状态还原,用户可以点击,单机版下测试,属性状态为crHourGlass时,亦可以切换会项目管理      // 按逻辑,CheckFileAndCloudCheckerList这种方法不应在界面,应在控制器,亦不可直接调用MainForm.actnCloseProject.Execute      // 怕按逻辑改动引起更多Bug,故继续错下去,检查MainForm.CurProjectFrame是否正确,并再次禁用鼠标      if CurProjectFme <> MainForm.CurProjectFrame then      begin        Screen.Cursor := crHourGlass;        MainForm.LocateProject(CurProjectFme.ProjectData.ProjectID);      end;      if not MainForm.CurProjectFrame.CheckFileAndCloudChekerList then      begin        sHint := '“'+ FWebBidName_OnLine +'”无法打开,本地与云端审批人不一致。' + #10#13 +          '1、如当前项目审批不通过并已重新开始计量:请回到原电脑操作;' + #10#13 +          '2、审批中/审批完成项目:请删除本地项目重新从云端获取。' + #10#13 +          '如仍然存在同样问题,请联系纵横服务人员。';        Application.MessageBox(PChar(sHint), '文件错误', MB_OK +MB_ICONWARNING);        MainForm.actnCloseProject.Execute;        Exit;      end;    end;  finally    Screen.Cursor := crDefault;  end;end;procedure TProjectManagerFrame.actnDeleteExecute(Sender: TObject);begin  if stdProjects.IDTree.Count = 0 then Exit;  with stdProjects.IDTree.Selected.Rec do    if QuestMessage(Format('确定要删除[%s]吗?', [ValueByName('Name').AsString])) then    begin      Screen.Cursor := crHourGlass;      try        FProjectManagerData.Delete;      finally        Screen.Cursor := crDefault;      end;    end;end;procedure TProjectManagerFrame.zgProjectsMouseDown(Sender: TObject;  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);begin  if Button = mbRight then    dxpmProjectManager.PopupFromCursorPos  else if (zgProjects.CurCol = 1) and (Button = mbLeft) and (ssDouble in Shift)    and Assigned(stdProjects.IDTree.Selected) then  begin    if IsProject(stdProjects.IDTree.Selected) then      stdProjects.IDTree.Selected.Expand    else      actnOpen.Execute;  end;end;function TProjectManagerFrame.ReceiveFile(const AFileName: string; AIsReback: Boolean; AWorking: Boolean): Boolean;var  vRP: TReceiveProject;  vNode: TsdIDTreeNode;begin  Result := False;  vRP := TReceiveProject.Create(stdProjects.IDTree.Selected);  try    ProjectManager.RefreshSeedID;    if G_IsCloud then    begin      vRP.IsReback := AIsReback;      vRP.Lock := (FWebAuthorID = PHPWeb.UserID) or           ((FWebAuthorID <> PHPWeb.UserID) and (FWebCheckStatusMy <> csChecking));      vRP.WebBidName := FWebBidName_OnLine;      vNode := vRP.ReceiveForLost(AFileName, FOnLineCheckerBegin, FOnLineCheckerEnd, FOnLineCheckerEndIsOwner);      if vNode <> nil then      begin        vNode.Rec.BeginUpdate;        vNode.Rec.ValueByName('WebMD5').AsString := FWebMD5_OnLine;        vNode.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID;        vNode.Rec.ValueByName('WebMeWorking').AsBoolean := AWorking;        vNode.Rec.EndUpdate;      end;    end    else      vNode := vRP.Receive(AFileName);  finally    case vRP.MessageID of      0: begin           Result := True;           vNode.LocateInControl;         end;      1: ErrorMessage('当前标段处于打开状态,未能成功接收,请先关闭标段再次接收。');      2: ErrorMessage('下载数据与审批状态不一致,未能成功接收,请再次接收。');      3: ErrorMessage('升级数据失败,未能成功接收,请再次接收。');    end;    vRP.Free;    FProjectManagerData.Save;  end;end;// 登录后自动扫描等待我审核的项目 TagCprocedure TProjectManagerFrame.actnReceiveProjectExecute(Sender: TObject);  procedure DoReceiveLocal;  var    sFileName: string;  begin    if SelectFile(sFileName, '.rmf;*.arf') then    begin      ShowProgressHint('正在接收项目并升级数据');      try        ReceiveFile(sFileName);      finally        CloseProgressHint;      end;    end;  end;var OnCC: TZjCellNotifyEvent;begin  Screen.Cursor := crHourGlass;  try    if G_IsCloud then    begin      OnCC := zgProjects.OnCurrentChanged;      try        zgProjects.OnCurrentChanged := nil;        DoBatchReceiveOnline(1);        if stdProjects.IDTree.FirstNode <> nil then          stdProjects.IDTree.FirstNode.LocateInControl;      finally        zgProjects.OnCurrentChanged := OnCC;      end;    end    else      DoReceiveLocal;  finally    Screen.Cursor := crDefault;  end;end;function TProjectManagerFrame.GetImportProjectName(  const AFileName: string; AParent: TsdIDTreeNode): string;begin  Result := ExtractSimpleFileName(AFileName);  while FProjectManagerData.ExistProject(Result, AParent) do    if not InputNewProjectName(Result, '导入', AParent) then Abort;end;procedure TProjectManagerFrame.actnNewProjectExecute(Sender: TObject);var  sName: string;begin  if G_IsCloud then Exit;    // 云版线上与本地要保持同步,不允许本地新建  if InputNewProjectName(sName, '新建', stdProjects.IDTree.Selected) then    FProjectManagerData.InsertProject(sName, stdProjects.IDTree.Selected);end;procedure TProjectManagerFrame.actnNewSubProjectExecute(Sender: TObject);var  sName: string;begin  if G_IsCloud then Exit;  if InputNewProjectName(sName, '新建', stdProjects.IDTree.Selected) then    FProjectManagerData.InsertSubProject(sName, stdProjects.IDTree.Selected);end;procedure TProjectManagerFrame.actnNewTenderExecute(Sender: TObject);  function AddAndOpenTender(const ATenderName: string): TsdIDTreeNode;  begin    Result := FProjectManagerData.InsertTender(ATenderName, stdProjects.IDTree.Selected);    MainForm.OpenProject(Result.Rec);  end;  // 网络版新建标段 TagD  procedure NewProjectWithOnline;  var    WebNewTenderForm: TWebNewTenderForm;    sName, sKey, sURL: string;    stnNew: TsdIDTreeNode;    iID, iFolderID, iSubFolderID: Integer;    vRec: TsdDataRecord;    vArr: array of string;  begin    WebNewTenderForm := TWebNewTenderForm.Create(nil);    try      WebNewTenderForm.ShowModal;      if WebNewTenderForm.ModalResult = mrOK then      begin        sKey := WebNewTenderForm.edtKey.Text;        sName := WebNewTenderForm.edtTenderName.Text;        // 同服务器取得联系        iID := -1;        vArr := VarArrayOf(['catid', 'name', 'company', 'phone', 'mobile', 'qq',         'pname', 'ptype', 'jobs', 'avatar', 'ownuid', 'pnameid', 'ptypeid']);        sURL := Format('%s%d/%s/%s/creatmeasure', [PHPWeb.MeasureURL, PHPWeb.UserID, sName, sKey]);     // AnsiToUtf8(sName)        case PHPWeb.Search(sURL, [], [], vArr) of          1:          begin            iID := StrToInt(vArr[0]);            iFolderID := StrToInt(vArr[11]);            iSubFolderID := StrToInt(vArr[12]);            CheckWebFolders(iFolderID, iSubFolderID, vArr[6], vArr[7]);          end;          0:          begin            Application.MessageBox(PChar(PHPWeb.PageError('创建标段失败' + '[' + vArr[0] + ']')),              '警告', MB_OK + MB_ICONWARNING);            Exit;          end;          -1:          begin            Application.MessageBox(PChar(PHPWeb.NetError('创建标段失败')),              '警告', MB_OK + MB_ICONWARNING);            Exit;          end;        end;        // 本地创建        stnNew := FProjectManagerData.InsertTender(sName, stdProjects.IDTree.Selected);        // 这里把Web获取的信息存储到项目管理里面。        vRec := stnNew.Rec;        vRec.BeginUpdate;        vRec.ValueByName('WebID').AsInteger := iID;        vRec.ValueByName('WebOwnerID').AsInteger := StrToInt(vArr[10]);       // 业主        vRec.ValueByName('WebAuthorID').AsInteger := PHPWeb.UserID;   // 编制人        vRec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID;  // 当前用户,用于只显示自己的项目        vRec.ValueByName('WebKey').AsString := sKey;        vRec.ValueByName('WebMeWorking').AsBoolean := True;        vRec.EndUpdate;        GetLocalValues(vRec);        FWebOwnerName := vArr[1];        FWebOwnerCompany := vArr[2];        FWebOwnerRole := vArr[8];        FWebFolder_OnLine := vArr[6];        FWebSubFolder_OnLine := vArr[7];//          WebOwnerImage := vArr[9];//          WebOwnerPhone := vArr[3];//          WebOwnerMobile := vArr[4];//          WebOwnerQQ := vArr[5];        ShowProjectInfoTop(0);        FProjectManagerData.Save;        MainForm.OpenProject(vRec);      end;    finally      WebNewTenderForm.Free;    end;  end;  procedure NewProject;  var    sName: string;  begin    if InputNewProjectName(sName, '新建', stdProjects.IDTree.Selected) then      AddAndOpenTender(sName);  end;begin  if G_IsCloud then    NewProjectWithOnline  else    NewProject;end;procedure TProjectManagerFrame.zgProjectsDrawCellText(ACanvas: TCanvas;  const ARect: TRect; const ACoord: TPoint; AGrid: TZJGrid;  const Text: String; var ADefaultDraw: Boolean);  procedure GetBitmap(AImage: TBitmap; ANode: TsdIDTreeNode);  begin    if Assigned(ANode) and Assigned(ANode.Rec) then    begin      if ANode.Rec.ValueByName('Type').AsInteger = 0 then        if ANode.Expanded and ANode.HasChildren then          MainForm.Images.GetBitmap(34, AImage)        else          MainForm.Images.GetBitmap(34, AImage)      else        MainForm.Images.GetBitmap(11, AImage);    end    else      AImage := nil;  end;const  rIconWidth = 16;  rIconHeight = 16;var  Img: TBitmap;  Cell: TZjCell;  rImg: TRect;  vNode: TsdIDTreeNode;begin  if (ACoord.X = 1) and (ACoord.Y > zgProjects.FixedRowCount - 1) then  begin    Cell := zgProjects.Cells[ACoord.X, ACoord.Y];    Img := TBitmap.Create;    try      vNode := stdProjects.IDTree.Items[ACoord.Y-zgProjects.FixedRowCount];      GetBitmap(Img, vNode);      case Cell.Align of        gaTopLeft, gaTopCenter, gaTopRight:          rImg := Rect(ARect.Left + 2, ARect.Top, ARect.Left + rIconWidth, ARect.Top + rIconHeight);        gaCenterLeft, gaCenterCenter, gaCenterRight:          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);        gaBottomLeft, gaBottomCenter, gaBottomRight:          rImg := Rect(ARect.Left + 2, ARect.Bottom - rIconHeight, ARect.Left + rIconWidth, ARect.Bottom);      end;      ACanvas.StretchDraw(rImg, Img);      WriteText(ACanvas, Rect(ARect.Left + rIconWidth, ARect.Top, ARect.Right, ARect.Bottom)        , 2, 2, Text, Cell.Align, False);      ADefaultDraw := False;    finally      Img.Free;    end;  end;end;procedure TProjectManagerFrame.actnNewSubProjectUpdate(Sender: TObject);begin  TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)    and IsProject(stdProjects.IDTree.Selected)    and (not IsUnEmptyLeafProject(stdProjects.IDTree.Selected));end;procedure TProjectManagerFrame.actnNewTenderUpdate(Sender: TObject);var bCloud: Boolean;  vNode: TsdIDTreeNode;begin  bCloud := G_IsCloud;  // 只有编制人才能创建新标段?逻辑先后有问题:编制人是在创建标段之后产生的。  // 创建前,当前用户只是一个帐户,它是不是编制人末知,因为它还可以是其它角色。  // 同一帐户在不同的标段可以作为不同的角色。  if bCloud then  begin    TAction(Sender).Enabled := True;  end  else  begin    vNode := stdProjects.IDTree.Selected;    TAction(Sender).Enabled := Assigned(vNode) and IsProject(vNode) and IsLeafProject(vNode);  end;end;function TProjectManagerFrame.IsLeafProject(ANode: TsdIDTreeNode): Boolean;begin  if ANode.HasChildren then    Result := ANode.FirstChild.Rec.ValueByName('Type').AsInteger = 1  else    Result := ANode.Rec.ValueByName('Type').AsInteger = 0;end;function TProjectManagerFrame.IsProject(ANode: TsdIDTreeNode): Boolean;begin  Result := ANode.Rec.ValueByName('Type').AsInteger = 0;end;function TProjectManagerFrame.IsUnEmptyLeafProject(  ANode: TsdIDTreeNode): Boolean;begin  Result := ANode.HasChildren and (ANode.Rec.ValueByName('Type').AsInteger = 1);end;procedure TProjectManagerFrame.SetPropertyVisible(AVisible: Boolean);begin  // 单击刷新项目信息 TagA  if G_IsCloud then  begin    if CurRec = nil then Exit;    pnlTenderProperty.Visible := False;    pnlWeb.Visible := AVisible;    if AVisible then    begin      CreateProgress('云端读取项目信息');      try        ShowProjectInfoTopAndCheckers;      finally        CloseProgress;      end;    end;  end  else  begin    pnlWeb.Visible := False;    pnlTenderProperty.Visible := AVisible;    sprProperty.Visible := AVisible;  end;end;procedure TProjectManagerFrame.zgProjectsCurrentChanged(Sender: TObject;  Col, Row: Integer);begin  if G_IsCloud then  begin    if CurRec <> nil then    begin      // 加这句后产生Bug:上报项目后,记录不曾移动,FID不变,不会刷新//      if FID <> CurRec.ValueByName('ID').AsInteger then        SetPropertyVisible(CurRec.ValueByName('Type').AsInteger = 1);      // OnCurrentChanged取得的 CurRec.ValueByName() 值并不总是可靠,这里加保险。      // 如调用locateInControl后,执行到这里取得的CurRec.ValueByName('ID')值还是上一条的。      if (CurRec.ValueByName('Type').AsInteger = 1) and (not pnlWeb.Visible) then        pnlWeb.Visible := True;    end;  end;end;procedure TProjectManagerFrame.actnSubmitProjectUpdate(Sender: TObject);begin  TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)    and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1)    and (stdProjects.IDTree.Selected.Rec.ValueByName('AuditStatus').AsInteger < iMaxStageCount-1);end;procedure TProjectManagerFrame.actnReplyProjectUpdate(Sender: TObject);begin  TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)    and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1);end;procedure TProjectManagerFrame.actnRenameExecute(Sender: TObject);  function CanRename(ARec: TsdDataRecord; const ANewName: string): Boolean;  var    sURL: string;    iRename: Integer;    vArr: array [0..0] of string;  begin    Result := True;    if not G_IsCloud then Exit;    // 云版 重命名须确保同步服务器    sURL := Format('%stender/%d/%s/update', [PHPWeb.MeasureURL, ARec.ValueByName('WebID').AsInteger, ANewName]);    iRename := PHPWeb.Search(sURL, [], [], vArr);    Result := iRename = 1;    case iRename of      1: ShowMessage('新的标段名称已同步到服务器!');      0: Application.MessageBox(PChar(PHPWeb.PageError('重命名同步到云端失败' + '[' + vArr[0] + ']')),          '警告', MB_OK + MB_ICONWARNING);     -1: Application.MessageBox(PChar(PHPWeb.NetError('重命名同步到云端失败')),          '警告', MB_OK + MB_ICONWARNING);    end;  end;var  stnNode: TsdIDTreeNode;  sName: string;begin  stnNode := stdProjects.IDTree.Selected;  sName := stnNode.Rec.ValueByName('Name').AsString;  if not Assigned(OpenProjectManager.FindProjectData(stnNode.ID)) then  begin    if InputNewProjectName(sName, '重命名', stnNode.Parent, stnNode.ID) then    begin      if (sName <> stnNode.Rec.ValueByName('Name').AsString) and CanRename(stnNode.Rec, sName) then      begin        stnNode.Rec.ValueByName('Name').AsString := sName;        ProjectManager.Save;      end;    end;  end  else    ErrorMessage(Format('项目[%s]已经打开,无法重命名!', [sName]));end;procedure TProjectManagerFrame.actnOpenUpdate(Sender: TObject);begin  TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)      and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1);end;procedure TProjectManagerFrame.actnImportExecute(Sender: TObject);  procedure ImportTender(const AFileName, AProjectName: string);  var    Importor: TTenderImport;  begin    Importor := TTenderImport.Create(stdProjects.IDTree.Selected,      AProjectName, AFileName);    try      Importor.Execute;    finally      Importor.Free;    end;  end;  procedure ImportProject(const AFileName, AProjectName: string);  var    Importor: TProjectImport;  begin    Importor := TProjectImport.Create(stdProjects.IDTree.Selected,      AProjectName, AFileName);    try      Importor.Execute;    finally      Importor.Free;    end;  end;var  sFileName, sProjectName: string;  vCur: TsdIDTreeNode;begin  if SelectFile(sFileName, '.mtf;*.mpf') then  begin    vCur := stdProjects.IDTree.Selected;    if Assigned(vCur) then    begin      if SameText(ExtractFileExt(sFileName), '.mtf')        and (vCur.Rec.ValueByName('Type').AsInteger = 0) then        sProjectName := GetImportProjectName(sFileName, stdProjects.IDTree.Selected)      else        sProjectName := GetImportProjectName(sFileName, stdProjects.IDTree.Selected.Parent);    end    else      sProjectName := GetImportProjectName(sFileName, vCur);    Screen.Cursor := crHourGlass;    try      if SameText(ExtractFileExt(sFileName), '.mtf') then        ImportTender(sFileName, sProjectName)      else        ImportProject(sFileName, sProjectName);    finally      Screen.Cursor := crDefault;    end;  end;  FProjectManagerData.Save;end;procedure TProjectManagerFrame.actnExportExecute(Sender: TObject);  procedure ExportTender(ANode: TsdIDTreeNode);  var    Exportor: TTenderExport;    sFileName, sHint: string;    bExpAtch: Boolean;    iCount: Integer;  begin    bExpAtch := False;    sFileName := SupportManager.ConfigInfo.OutputPath + ANode.Rec.ValueByName('Name').AsString + '.mtf';    if SaveFile(sFileName, '.mtf') then    begin      if FileExists(sFileName) and not QuestMessage(Format('存在同名文件“%s”,是否替换?', [ExtractFileName(sFileName)])) then        Exit;      Screen.Cursor := crHourGlass;      try        Exportor := TTenderExport.Create(ANode.Rec, sFileName);        try         { if not G_IsCloud then          begin            iCount := FileCount(CurRecAttachmentPath);            if iCount > 1 then        // 排除管理文件库            begin              sHint := Format('本标段包含 %d 个附件,是否将附件一起导出?', [iCount - 1]);              bExpAtch := Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = ID_Yes;            end;          end;   }   // FFFFF          Exportor.Execute(bExpAtch);        finally          Exportor.Free;        end;      finally        Screen.Cursor := crDefault;      end;    end;  end;  procedure ExportProject(ANode: TsdIDTreeNode);  var    Exportor: TProjectExport;    sFileName, sHint: string;    bExpAtch: Boolean;    iCount: Integer;  begin    sFileName := SupportManager.ConfigInfo.OutputPath + ANode.Rec.ValueByName('Name').AsString + '.mpf';    if SaveFile(sFileName, '.mpf') then    begin      if FileExists(sFileName) and not QuestMessage(Format('存在同名文件“%s”,是否替换?', [ExtractFileName(sFileName)])) then        Exit;      Screen.Cursor := crHourGlass;      try        bExpAtch := False;       { if not G_IsCloud then        begin          iCount := AttachmentFileCountsWithoutManageFile(ANode);          if iCount > 0 then          begin            sHint := Format('本建设项目共包含 %d 个附件,是否将附件一起导出?', [iCount]);            bExpAtch := Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = ID_Yes;          end;        end;  }    // FFFFF        Exportor := TProjectExport.Create(ANode, sFileName, bExpAtch);        try          Exportor.Execute;        finally          Exportor.Free;        end;      finally        Screen.Cursor := crDefault;      end;    end;  end;var  stnNode: TsdIDTreeNode;begin  stnNode := stdProjects.IDTree.Selected;  if stnNode.Rec.ValueByName('Type').AsInteger = 1 then  begin    ExportTender(stnNode);  end  else    ExportProject(stnNode);end;procedure TProjectManagerFrame.actnDeleteUpdate(Sender: TObject);begin  if Assigned(stdProjects.IDTree.Selected) then    TAction(Sender).Enabled := not CheckOpened(stdProjects.IDTree.Selected)  else    TAction(Sender).Enabled := False;end;function TProjectManagerFrame.CheckOpened(ANode: TsdIDTreeNode): Boolean;var  iChild: Integer;begin  Result := False;  if ANode.Rec.ValueByName('Type').AsInteger = 1 then    Result := OpenProjectManager.ProjectIndex(ANode.ID) > -1  else  begin    if not ANode.HasChildren then      Result := False    else    begin      for iChild := 0 to ANode.ChildCount - 1 do        Result := Result or CheckOpened(ANode.ChildNodes[iChild]);    end  end;end;procedure TProjectManagerFrame.ShowProjectInfoTopAndCheckers;var  vPSArr: TStrArr;  vCArr: TOVArr;    // Checkers  sPicPath, sURL: string;    procedure ShowProjectCheckers;    var i, j, k, n: Integer;    vOwner: array of string;  // 业主信息        procedure AddCheckerFrame(AType: TCheckerFrameType; AArr: array of string);        var vChecker: TOrderCheckerFrame;        begin          vChecker := TOrderCheckerFrame.Create(self);          FCheckerFrames.Add(vChecker);          vChecker.Owner := Self;          sbChecker.VertScrollBar.Range := sbChecker.VertScrollBar.Range + vChecker.Height;          sbChecker.Height := Min(sbChecker.Height + vChecker.Height, pnlWeb.Height - pnlProject.Height);          vChecker.Parent := sbChecker;          vChecker.Top := FCurPos;          FCurPos := FCurPos + vChecker.Height;          vChecker.Align := alTop;          sPicPath := PHPWeb.UserPath + '1_' + AArr[0] + '.jpg';          PHPWeb.DownFile(AArr[4], sPicPath);          vChecker.Init(AType, StrToInt(AArr[0]), AArr[1], AArr[3],            AArr[2], sPicPath, AArr[6], TCheckStatus(StrToInt(AArr[5])-1), AArr[8], StrToInt(AArr[7]));          vChecker.Name := 'ProjectOrderFrame' + AArr[0];        end;    begin      sbChecker.Height := 0;      FCurPos := 0;      n := Length(vCArr[Low(vCArr)]);      SetLength(vOwner, n);      sbChecker.VertScrollBar.Range := 0;      for i := Low(vCArr) to High(vCArr) do      begin        if StrToInt(vCArr[i, 0]) = PHPWeb.UserID then          FWebCheckStatusMy := TCheckStatus(StrToInt(vCArr[i, 5])-1);        if StrToInt(vCArr[i, 0]) = FWebOwnerID then        begin          for j := 0 to n - 1 do            vOwner[j] := vCArr[i, j];          Continue;        end;        AddCheckerFrame(cftChecker, vCArr[i]);      end;      if vOwner[0] <> '' then        AddCheckerFrame(cftOwner, vOwner);      for k := 0 to sbChecker.ControlCount - 1 do        TOrderCheckerFrame(sbChecker.Controls[k]).Order := k + 1;      OnLineChecker(vCArr, FOnLineCheckerBegin, FOnLineCheckerEnd, FOnLineCheckerEndIsOwner);    end;begin  FCheckerFrames.Clear;  GetLocalValues(CurRec);  if FWebID = 0 then Exit;  SetLength(vPSArr, 8);  sURL := Format('%smeasure/status/%d/get', [PHPWeb.MeasureURL, FWebID]);  SetLength(FCheckers, 0);  if PHPWeb.Search(sURL, [''], [''], 3, vPSArr, vCArr) = 1 then  begin    FCheckers := vCArr;    LockWindowUpdate(pnlWeb.Handle);    try      FPhaseNo := StrToInt(vPSArr[0]);      FWebCheckStatusProject := TCheckStatus(StrToInt(vPSArr[1])-1);      FPhaseTotal := StrToInt(vPSArr[2]);      FWebFolder_OnLine := vPSArr[3];      FWebSubFolder_OnLine := vPSArr[4];      FWebOwnerName := vPSArr[5];      FWebOwnerCompany := vPSArr[6];      FWebOwnerRole := vPSArr[7];      ShowProjectInfoTop;      ShowProjectCheckers;    finally      LockWindowUpdate(0);    end;  end  else  begin    FPhaseNo := 0;    FWebCheckStatusProject := csNotBegin;    FPhaseTotal := 0;    FWebFolder_OnLine := '';    FWebSubFolder_OnLine := '';    FWebOwnerName := '';    FWebOwnerCompany := '';    FWebOwnerRole := '';    ShowProjectInfoTop;    sbChecker.Height := 0;  end;end;procedure TProjectManagerFrame.ShowProjectInfoTop(AType: Integer);    procedure ShowOwner;    begin      lblBidName.Caption := FWebBidName_Local;      lblBidName.Update;      lblProjName.Caption := FWebFolder_OnLine;      lblProjName.Update;      lblWebProjCtgyName.Caption := FWebSubFolder_OnLine;      lblWebProjCtgyName.Update;      lblOnwerName.Caption := FWebOwnerName;      lblOnwerName.Update;      lblOnwerCompany.Caption := Format('-%s)', [FWebOwnerCompany]);      lblOnwerCompany.Update;      lblOnwerCompany.Left := lblOnwerName.Left + lblOnwerName.Width;    end;    procedure ShowStatus(ANo: Integer; AState: TCheckStatus);    begin      lblPeriod.Caption := Format('第%d期', [ANo]);      lblPeriod.Update;      lblPeriodState.Caption := CheckStatusNames[AState];      lblPeriodState.Font.Color := CheckStatusColors[AState];      lblPeriodState.Update;      lblPeriodState.Left := lblPeriod.Left + lblPeriod.Width + 5;      lblPeriodTotal.Caption := Format('(共%d期)', [ANo]);      lblPeriodTotal.Update;      lblPeriodTotal.Left := lblPeriodState.Left + lblPeriodState.Width + 3;    end;begin  GetLocalValues(CurRec);  case AType of    -2:    begin      lblPeriod.Caption := '正在从云端读取状态信息...';      lblPeriod.Update;    end;    -1:    begin      ShowOwner;      ShowStatus(FPhaseNo, FWebCheckStatusProject);    end;    0:    begin      ShowOwner;      ShowStatus(0, csNotBegin);    end;  end;end;// 检查后,应该定位到最后一层目录,不应该回到原先的选择节点。否则从网络拉下来的项目无法组织正确的树结构。procedure TProjectManagerFrame.CheckWebFolders(AFolderID, ASubFolderID: Integer;  AFolderName, ASubFolderName: string);var  vTree: TsdIDTree;  vNode, vSubNode: TsdIDTreeNode;  i: Integer;  sName: string;  iUserID, iWebID, iWebFolderLevel: Integer;  bExist, bSubExist, bModified: Boolean;begin  bExist := False;  bSubExist := False;  bModified := False;  vTree := stdProjects.IDTree;  for i := 0 to vTree.Count - 1 do  begin    vNode := vTree.Items[i];    sName := vNode.Rec.ValueByName('Name').AsString;    iUserID := vNode.Rec.ValueByName('WebUserID').AsInteger;    iWebID := vNode.Rec.ValueByName('WebID').AsInteger;    iWebFolderLevel := vNode.Rec.ValueByName('WebFolderLevel').AsInteger;    if (iWebID = AFolderID) and (iWebFolderLevel = G_WFL_ProjName) and (iUserID = PHPWeb.UserID) then    begin      bExist := True;      vNode.LocateInControl;      if not SameText(sName, AFolderName) then      begin        vNode.Rec.ValueByName('Name').AsString := AFolderName;        bModified := True;      end;      Break;    end;  end;  if not bExist then  begin    vNode := vTree.Items[0];    if Assigned(vNode) then      vNode.LocateInControl;    vNode := FProjectManagerData.InsertProject(AFolderName, stdProjects.IDTree.Selected, AFolderID, G_WFL_ProjName);    vNode.LocateInControl;  end;  for i := 0 to vNode.ChildCount - 1 do  begin    vSubNode := vNode.ChildNodes[i];    sName := vSubNode.Rec.ValueByName('Name').AsString;    iUserID := vSubNode.Rec.ValueByName('WebUserID').AsInteger;    iWebID := vSubNode.Rec.ValueByName('WebID').AsInteger;    iWebFolderLevel := vSubNode.Rec.ValueByName('WebFolderLevel').AsInteger;    if (iWebID = ASubFolderID) and (iWebFolderLevel = G_WFL_BidType) and (iUserID = PHPWeb.UserID) then    begin      bSubExist := True;      vSubNode.LocateInControl;      if not SameText(sName, ASubFolderName) then      begin        vSubNode.Rec.ValueByName('Name').AsString := ASubFolderName;        bModified := True;      end;      Break;    end;  end;  if not bSubExist then  begin    vNode.LocateInControl;    vNode := FProjectManagerData.InsertSubProject(ASubFolderName, stdProjects.IDTree.Selected, ASubFolderID, G_WFL_BidType);    vNode.LocateInControl;  end;  if bModified then    ProjectManager.Save;end;function TProjectManagerFrame.Rec(AProjectID: Integer): TsdDataRecord;var i: Integer;  vTree: TsdIDTree;begin  vTree := stdProjects.IDTree;  if vTree.Selected.Rec.ValueByName('ID').AsInteger = AProjectID then  begin    Result := stdProjects.IDTree.Selected.Rec;    Exit;  end;  for i := 0 to vTree.Count - 1 do  begin    if vTree.Items[i].Rec.ValueByName('ID').AsInteger = AProjectID then    begin      Result := vTree.Items[i].Rec;      vTree.Items[i].LocateInControl;      Break;    end;  end;end;destructor TProjectManagerFrame.Destroy;begin  FCheckerFrames.Free;  inherited;end;procedure TProjectManagerFrame.DoBatchReceiveOnline(ARequestType: Integer);var  sURL, sCheckersURL, sHint: string;  vArr: TOVArr;  i, iFolderID, iSubFolderID: Integer;  vPSArr: TStrArr;  vCArr: TOVArr;    // Checkersbegin  // 查询等待我审核的标段文件,杰哥说分三种:①业主未审核 ②业主审核中 ③审核人审核中 (为什么加①?问杰哥)  case PHPWeb.Search(PHPWeb.MeasureURL + 'user/get/audit/project', ['audituid', 'RequestType'],    [IntToStr(PHPWeb.UserID), IntToStr(ARequestType)], vArr) of    1:    begin      CreateProgress('正在从云端下载新项目');      try        for i := Low(vArr) to High(vArr) do        begin          sURL := vArr[i, 0];          FWebFolder_OnLine := vArr[i, 1];          FWebSubFolder_OnLine := vArr[i, 2];          FWebMD5_OnLine := vArr[i, 3];          FWebID := StrToInt(vArr[i, 5]);          iFolderID := StrToInt(vArr[i, 6]);          iSubFolderID := StrToInt(vArr[i, 7]);          FWebCheckStatusMy := TCheckStatus(StrToInt(vArr[i, 8])-1);      // vArr[i, 4]项目审核状态;vArr[i, 8]当前登陆用户的审核状态          FWebAuthorID := StrToInt(vArr[i, 9]);          FWebBidName_OnLine := vArr[i, 10];          FWebMD5_Local := LocalMD5(PHPWeb.UserID, FWebID);          CheckWebFolders(iFolderID, iSubFolderID, FWebFolder_OnLine, FWebSubFolder_OnLine);          CheckLocalProperties(PHPWeb.UserID, FWebID, FWebBidName_OnLine, vArr[i, 4]);          if FWebMD5_OnLine <> FWebMD5_Local then          begin            sCheckersURL := Format('%smeasure/status/%d/get', [PHPWeb.MeasureURL, FWebID]);            if PHPWeb.Search(sCheckersURL, [''], [''], 3, vPSArr, vCArr) = 1 then              OnLineChecker(vCArr, FOnLineCheckerBegin, FOnLineCheckerEnd, FOnLineCheckerEndIsOwner)            else            begin              FOnLineCheckerBegin := 0;              FOnLineCheckerEnd := 0;            end;            if not FileDownAndReceive(sURL, 1, (FWebCheckStatusMy = csChecking)) then Exit;          end          else      //   上个人没改数据直接审批通过,文件没变,下个人本地文件跟线上文件完全一样,不下载不更新,不会高显示。这里强制高亮          begin            if (FWebCheckStatusMy = csChecking) then              HighlightProject(FWebID);          end;        end;        BubbleSortProjects;      finally        CloseProgress;      end;    end;    0:    begin      sHint := 'Web页返回错误(000J),无法查询云端项目的更新情况,请重试!';      Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);      Exit;    end;    -1:    begin      sHint := '网络较差,服务器断开连接,无法查询云端项目的更新情况,请重试!';      Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);      Exit;    end;  end;end;function TProjectManagerFrame.ImportFile(const AFileName: string; AFileMD5: string): Boolean;var  vImport: TTenderImport;  vNode: TsdIDTreeNode;begin  Result := False;  vNode := stdProjects.IDTree.Selected;  vImport := TTenderImport.Create(vNode, '', AFileName);  try    try      vImport.ImportToSelect;      vNode.LocateInControl;      Result := True;    except      Result := False;    end;  finally    vImport.Free;    vNode.Rec.BeginUpdate;    vNode.Rec.ValueByName('WebMD5').AsString := AFileMD5;    vNode.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID;//    vNode.Rec.ValueByName('WebMeWorking').AsBoolean := True;    vNode.Rec.EndUpdate;    FProjectManagerData.Save;  end;end;procedure TProjectManagerFrame.actnOpenBackupFolderExecute(  Sender: TObject);var  stnNode: TsdIDTreeNode;begin  stnNode := stdProjects.IDTree.Selected;  if stnNode.Rec.ValueByName('BackupFolder').AsString = '' then    TipMessage('该项目暂无备份数据!')  else    ShellExecute(Handle, 'open', 'Explorer.exe',      PChar(FProjectManagerData.BackupPath(stnNode.ID)), nil, 1);end;procedure TProjectManagerFrame.actnRenameUpdate(Sender: TObject);var  Rec: TsdDataRecord;  bNet, bEnabled: Boolean;begin  if Assigned(stdProjects.IDTree.Selected) and Assigned(stdProjects.IDTree.Selected.Rec) then  begin    bEnabled := True;    Rec := stdProjects.IDTree.Selected.Rec;    bNet := G_IsCloud;    if bNet then    begin      bEnabled := (Rec.ValueByName('Type').AsInteger = 1) and        (Rec.ValueByName('WebAuthorID').AsInteger = PHPWeb.UserID);    end;  end  else    bEnabled := False;  if bEnabled <> TAction(Sender).Enabled then    TAction(Sender).Enabled := bEnabled;end;procedure TProjectManagerFrame.CheckBidName(AID: Integer; ANewBidName: string);var vNode: TsdIDTreeNode;begin  vNode := stdProjects.IDTree.FindNode(AID);  if vNode = nil then Exit;    if vNode.Rec.ValueByName('Name').AsString <> ANewBidName then  begin    vNode.Rec.ValueByName('Name').AsString := ANewBidName;    ProjectManager.Save;  end;end;procedure TProjectManagerFrame.DoBatchReceiveAllOnline;var  OnCC: TZjCellNotifyEvent;begin  OnCC := zgProjects.OnCurrentChanged;  try    zgProjects.OnCurrentChanged := nil;    DoBatchReceiveOnline(2);    if stdProjects.IDTree.FirstNode <> nil then      stdProjects.IDTree.FirstNode.LocateInControl;  finally    zgProjects.OnCurrentChanged := OnCC;  end;end;procedure TProjectManagerFrame.GetLocalValues(ARec: TsdDataRecord);begin  if not Assigned(ARec) then  begin    ClearLocalValues;    Exit;  end;  // 加这句后产生Bug:上报项目后,记录不曾移动,FID不变,不会刷新//  if ARec.ValueByName('ID').AsInteger <> FID then  begin    FID := ARec.ValueByName('ID').AsInteger;    FWebID := ARec.ValueByName('WebID').AsInteger;    FWebAuthorID := ARec.ValueByName('WebAuthorID').AsInteger;    FWebOwnerID := ARec.ValueByName('WebOwnerID').AsInteger;    FWebMD5_Local := ARec.ValueByName('WebMD5').AsString;    FWebBidName_Local := ARec.ValueByName('Name').AsString;  end;end;procedure TProjectManagerFrame.GetLocalValues(AUserID, AWebID: Integer);var i: Integer;  vTree: TsdIDTree;  vRec: TsdDataRecord;begin  ClearLocalValues;      // 先清空,以防没找到。  if (CurRec <> nil) and    (CurRec.ValueByName('WebUserID').AsInteger = AUserID) and    (CurRec.ValueByName('WebID').AsInteger = AWebID) and    (CurRec.ValueByName('Type').AsInteger = 1) then  begin    GetLocalValues(CurRec);    Exit;  end;  vTree := stdProjects.IDTree;  for i := 0 to vTree.Count - 1 do  begin    vRec := vTree.Items[i].Rec;    if (vRec.ValueByName('WebUserID').AsInteger = AUserID) and      (vRec.ValueByName('WebID').AsInteger = AWebID) and      (vRec.ValueByName('Type').AsInteger = 1) then    begin      GetLocalValues(vRec);      Break;    end;  end;end;procedure TProjectManagerFrame.ClearLocalValues;begin  FID := -1;  FWebID := -1;  FWebAuthorID := -1;  FWebOwnerID := -1;  FWebMD5_Local := '';  FWebBidName_Local := '';end;function TProjectManagerFrame.LocalMD5(AUserID, AWebID: Integer): string;var i: Integer;  vTree: TsdIDTree;  vRec: TsdDataRecord;begin  Result := '本地无MD5码';  if (CurRec <> nil) and    (CurRec.ValueByName('WebUserID').AsInteger = AUserID) and    (CurRec.ValueByName('WebID').AsInteger = AWebID) and    (CurRec.ValueByName('Type').AsInteger = 1) then  begin    Result := CurRec.ValueByName('WebMD5').AsString;    Exit;  end;  vTree := stdProjects.IDTree;  for i := 0 to vTree.Count - 1 do  begin    vRec := vTree.Items[i].Rec;    if (vRec.ValueByName('WebUserID').AsInteger = AUserID) and      (vRec.ValueByName('WebID').AsInteger = AWebID) and      (vRec.ValueByName('Type').AsInteger = 1) then    begin      Result := vRec.ValueByName('WebMD5').AsString;      Break;    end;  end;end;function TProjectManagerFrame.CurRec: TsdDataRecord;begin  if stdProjects.IDTree.Selected = nil then    Result := nil  else    Result := stdProjects.IDTree.Selected.Rec;end;procedure TProjectManagerFrame.CheckLocalProperties(AUserID, AWebID: Integer; ANewBidName, ANewCheckStatus: string);var i: Integer;  vTree: TsdIDTree;  vRec: TsdDataRecord;begin  if (CurRec <> nil) and    (CurRec.ValueByName('WebUserID').AsInteger = AUserID) and    (CurRec.ValueByName('WebID').AsInteger = AWebID) and    (CurRec.ValueByName('Type').AsInteger = 1) then  begin    if (CurRec.ValueByName('Name').AsString <> ANewBidName) then      CurRec.ValueByName('Name').AsString := ANewBidName;//    if (CurRec.ValueByName('AuditStatus').AsString <> ANewCheckStatus) then//      CurRec.ValueByName('AuditStatus').AsString := ANewCheckStatus;    ProjectManager.Save;    Exit;  end;  vTree := stdProjects.IDTree;  for i := 0 to vTree.Count - 1 do  begin    vRec := vTree.Items[i].Rec;    if (vRec.ValueByName('WebUserID').AsInteger = AUserID) and      (vRec.ValueByName('WebID').AsInteger = AWebID) and      (vRec.ValueByName('Type').AsInteger = 1) then    begin      if vRec.ValueByName('Name').AsString <> ANewBidName then        vRec.ValueByName('Name').AsString := ANewBidName;//      if (vRec.ValueByName('AuditStatus').AsString <> ANewCheckStatus) then//         vRec.ValueByName('AuditStatus').AsString := ANewCheckStatus;      ProjectManager.Save;      Break;    end;  end;end;function TProjectManagerFrame.CurRecAttachmentPath: string;begin  if G_IsCloud then    Result := PHPWeb.WebPath + 'Projects\' + CurRec.ValueByName('WebID').AsString + '\Attachment\'  else    Result := GetMyProjectsFilePath + 'Attachment\' + CurRec.ValueByName('FileName').AsString + '\';end;function TProjectManagerFrame.AttachmentFileCountsWithoutManageFile(ANode: TsdIDTreeNode): Integer;  function GetCount(ANode: TsdIDTreeNode): Integer;  var sPath: string;  begin    if not Assigned(ANode) then Exit;    Result := 0;    if ANode.Rec.ValueByName('Type').AsInteger = 0 then      Result := Result + 0    else    begin      sPath := GetMyProjectsFilePath + 'Attachment\' + ANode.Rec.ValueByName('FileName').AsString + '\';      Result := Result + FileCount(sPath, '.*') - 1;    end;    if Assigned(ANode.FirstChild) then      Result := Result + GetCount(ANode.FirstChild);    if Assigned(ANode.NextSibling) then      Result := Result + GetCount(ANode.NextSibling);  end;begin  if not Assigned(ANode) then Exit;  if Assigned(ANode.FirstChild) then    Result := GetCount(ANode.FirstChild)  else    Result := 0;end;procedure TProjectManagerFrame.BubbleSortProjects;  // 不能排最顶层  procedure BubbleSort(ANode: TsdIDTreeNode);    var n, t, c, temp: Integer;      bSwap: Boolean;      vNode1, vNode2, vTempNode: TsdIDTreeNode;  begin    if ANode = nil then Exit;//    if ANode.Rec.ValueByName('WebFolderLevel').AsInteger = G_WFL_ProjName then Exit;    n := ANode.ChildCount;    for t := 1 to n - 1 do    begin      bSwap := False;      for c := 1 to (n - t) do      begin        vNode1 := ANode.ChildNodes[c - 1];        vNode2 := ANode.ChildNodes[c];        if AnsiCompareStr(vNode1.Rec.ValueByName('Name').AsString,          vNode2.Rec.ValueByName('Name').AsString) = 1 then        begin          vNode1.DownMove;          bSwap := True;        end;      end;      if bSwap = False then Break;    end;    if Assigned(ANode.FirstChild) then      BubbleSort(ANode.FirstChild);    if Assigned(ANode.NextSibling) then      BubbleSort(ANode.NextSibling);  end;begin  BubbleSort(stdProjects.IDTree.FirstNode);end;procedure TProjectManagerFrame.zgProjectsShowHint(var HintStr: String;  var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint);var  vCell: TZjCell;  vNode: TsdIDTreeNode;  iLevelWidth: Integer;  rText: TRect;  procedure CalcTextRect(var R: TRect);  var    DC: HDC;    iTextHeight: Integer;  begin    DC := CreateCompatibleDC(0);    try      SelectObject(DC, vCell.Font.Handle);      iTextHeight := DrawText(DC, PChar(vCell.Text), Length(vCell.Text), R, DT_SINGLELINE or DT_VCenter        or DT_NOCLIP or DT_CALCRECT);    finally      DeleteDC(DC);    end;  end;begin  if (ACoord.Y < 1) and (ACoord.X <> 1) then Exit;    vCell := zgProjects.Cells[ACoord.X, ACoord.Y];  with HintInfo do  begin    vNode := stdProjects.IDTree.Items[ACoord.Y - 1];    if not Assigned(vNode) then Exit;    iLevelWidth := (vNode.Level + 1) * 20 + 16;    rText := CursorRect;    CalcTextRect(rText);    if (rText.Right - rText.Left + iLevelWidth > CursorRect.Right - CursorRect.Left) or      (rText.Right > ClientWidth) then    begin      CanShow := True;      HintStr := vCell.Text;      GetCursorPos(HintPos);    end;  end;end;function TProjectManagerFrame.FileDownAndReceive(ADownURL: string; AReceiveKind: Integer; AWorking: Boolean): Boolean;var sLocalFile, sHint: string;  bCanImp: Boolean;  vFileCheck: TTenderFileChecker;begin  Result := False;  // 下载  sLocalFile := PHPWeb.UserPath + ExtractFileName(ADownURL);  if not PHPWeb.DownFile(ADownURL, sLocalFile) then  begin    sHint := Format('云端已找到 [%s] 的新文件,但由于网络原因下载失败!请重试!', [FWebBidName_Local]);    Application.MessageBox(PChar(sHint), '系统提醒', MB_OK + MB_ICONWARNING);    Exit;  end;  // 接收前先检验原报文件是否正确(审核不通过打回)  if AReceiveKind = 2 then  begin    // 有时原报文件出错:包含了1审2审的数据。    vFileCheck := TTenderFileChecker.Create;    try      // 有一期以上数据,且最新期数据审核状态为原报      bCanImp := vFileCheck.CheckFileValid(sLocalFile) and (vFileCheck.PhaseCount > 0) and (vFileCheck.AuditStatus = 0);      if not bCanImp then      begin        Application.MessageBox(PChar('已从云端下载原报文件到本地,但文件有错误(包含1审数据)禁止接收!请致电纵横服务人员以获取帮助。'),          '警告', MB_OK + MB_ICONWARNING);        Exit;      end;    finally      vFileCheck.Free;    end;    {注意: 审核末通过的导入更新,这里的MD5码应取最终审核不通过项目的,否则会带来下载循环问题。    问题描述:    ①编制人运行软件,双击项目,发现审核不通过,自动下载无锁文件,开始新一期,保存关闭。    ②编制人再次运行软件,双击项目,MD5码不同,自动下载旧的审核不通过文件,覆盖本地。    ③编制人再次运行软件,双击项目,发现审核不通过,重复①,循环....    问:①那里下载无锁文件后不能改成新的MD5码吗?    答:不能,因为审核人的项目会变成无锁文件,看不到不通过项目。MD5码只能在上传后更新。    且编制人有个交互界面2种选择:a.下载更新不通过项目查看;b.下载更新无锁文件开始新一期。}  end;  // 接收更新  if not ReceiveFile(sLocalFile, (AReceiveKind = 2), AWorking) then  begin    sHint := Format('已从云端下载新的 [%s] 到本地 [%s],但接收失败,请删除该项目然后重新从云端获取!', [FWebBidName_OnLine, sLocalFile]);    Application.MessageBox(PChar(sHint), '系统提醒', MB_OK + MB_ICONWARNING);    Exit;  end;  if FileExists(sLocalFile) then    DeleteFile(sLocalFile);  Result := True;end;// 为了跟PHP的数组兼容,这里限制数组的第一个元素是A[0](不能是A[1])procedure TProjectManagerFrame.OnLineChecker(AAr: TOVArr; var ABegin,  AEnd: Integer; var AOnLineEndIsOwner: Boolean);var i, j: Integer;  vCS: TCheckStatus;begin  i := 0;  j := 0;  ABegin := 0;  AEnd := 0;  AOnLineEndIsOwner := AAr[High(AAr), 7] = '1';       // 接口返回的第7列是线上审批标记  //  数组必须在位置n处截断,后面的部分作废。n的取值情况:  //  ①轮到工作中的那个人的前一个人 ②审核不通过的那个人 ③ 审核通过的人是业主  if AOnLineEndIsOwner then    AEnd := High(AAr) + 1  else  begin    for i := High(AAr) downto 0 do    begin      vCS := TCheckStatus(StrToInt(AAr[i, 5]) - 1);      if vCS = csChecking then      begin        if (i > 0) and (AAr[i - 1, 7] = '1') then   // 前一个人且不是第一个人          AEnd := i;        Break;      end      else if vCS = csNotPass then      begin        if AAr[i, 7] = '1' then          AEnd := i + 1;        Break;      end;    end;  end;  if AEnd = 0 then Exit;  if AEnd = 1 then  begin    ABegin := 1;    Exit;  end;  for j := AEnd -2 downto 0 do  begin    if AAr[j, 7] = '0' then    begin      ABegin := j + 2;      Break;    end    else    begin      if j = 0 then        ABegin := 1;    end;  end;end;procedure TProjectManagerFrame.actnExportUpdate(Sender: TObject);begin  TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected);end;procedure TProjectManagerFrame.actnOpenBackupFolderUpdate(Sender: TObject);begin  TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected) and    (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1);end;procedure TProjectManagerFrame.pnlProgressClick(Sender: TObject);var s: string;begin  if (GetKeyState(VK_LSHIFT) < 0) and (GetKeyState(VK_LCONTROL) < 0) then  begin    s := Format('%d, %d, %s', [FOnLineCheckerBegin, FOnLineCheckerEnd, BoolToStr(FOnLineCheckerEndIsOwner)]);    Application.MessageBox(Pchar(s), 'Hint');  end;end;procedure TProjectManagerFrame.actnSignOnlineExecute(Sender: TObject);var  iPhase: Integer;begin  LoadSignOnlineSwitch;  if (FSignOnlineSwitch = 0) then    WarningMessage('云端未开启在线签署功能。')  else  begin    CheckOnlineSignStatusAndUpdate(stdProjects.IDTree.Selected.Rec);    if SelectOnlineSignPhase(iPhase, stdProjects.IDTree.Selected.Rec) then      SignOnline(stdProjects.IDTree.Selected, iPhase);  end;end;procedure TProjectManagerFrame.actnSignOnlineUpdate(Sender: TObject);  function HasCompletePhase(ARec: TsdDataRecord): Boolean;  begin    if (ARec.ValueByName('PhaseCount').AsInteger > 1) then      Result := True    else if (ARec.ValueByName('PhaseCount').AsInteger < 1) then      Result := False    else      Result := ARec.ValueByName('AuditStatus').AsInteger = -1;  end;begin  TAction(Sender).Visible := G_IsCloud and (not IsGuest);  TAction(Sender).Enabled := (FSignOnlineSwitch = 1) and       Assigned(stdProjects.IDTree.Selected) and      (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1) and      HasCompletePhase(stdProjects.IDTree.Selected.Rec);end;procedure TProjectManagerFrame.LoadSignOnlineSwitch;var  iResult: Integer;  sResult: string;begin  FSignOnlineSwitch := 0;  iResult := PHPWeb.UrlGet(PhPWeb.MeasureURL + 'sign/switch', nil, sResult);  case iResult of    1: FSignOnlineSwitch := StrToIntDef(sResult, 0);    0: WarningMessage('网络错误:' + sResult);    -1: WarningMessage('网络错误:无法连接到云端');  end;end;procedure TProjectManagerFrame.actnGuestExecute(Sender: TObject);var  SetGuestForm: TSetGuestForm;begin  CreateProgress('云端取最新审核人列表');  try    ShowProjectInfoTopAndCheckers;  finally    CloseProgress;  end;  SetGuestForm := TSetGuestForm.Create(CurRec.ValueByName('WebID').AsInteger);  SetGuestForm.Owner := Self;  try    SetGuestForm.ShowModal;  finally    SetGuestForm.Free;  end;end;procedure TProjectManagerFrame.actnGuestUpdate(Sender: TObject);begin  TAction(Sender).Visible := G_IsCloud and (not IsGuest);  TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected) and    (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1);end;function TProjectManagerFrame.UserIsChecker(UserID: Integer): Boolean;var i: Integer;begin  Result := False;  if FWebAuthorID = UserID then  begin    Result := True;    Exit;  end;  for i := Low(FCheckers) to High(FCheckers) do  begin    if StrToInt(FCheckers[i, 0]) = UserID then    begin       Result := True;       Break;    end;  end;end;function TProjectManagerFrame.IsGuest: Boolean;begin  Result := not UserIsChecker(PHPWeb.UserID);end;procedure TProjectManagerFrame.actnEpureExecute(Sender: TObject);var  iPhase: Integer;begin  LoadEpureOnlineSwitch;  if (FEpureOnlineSwitch = 0) then    WarningMessage('云端未开启插入计量草图功能。')  else if SelectEpurePhase(iPhase, stdProjects.IDTree.Selected.Rec) then    EpureOnline(stdProjects.IDTree.Selected, iPhase);end;procedure TProjectManagerFrame.LoadEpureOnlineSwitch;var  iResult: Integer;  sResult: string;begin  FEpureOnlineSwitch := 0;  iResult := PHPWeb.UrlGet(PhPWeb.MeasureURL + 'intermediate/switch', nil, sResult);  case iResult of    1: FEpureOnlineSwitch := StrToIntDef(sResult, 0);    0: WarningMessage('网络错误:' + sResult);    -1: WarningMessage('网络错误:无法连接到云端');  end;end;procedure TProjectManagerFrame.actnEpureUpdate(Sender: TObject);  function HasCompletePhase(ARec: TsdDataRecord): Boolean;  begin    if (ARec.ValueByName('PhaseCount').AsInteger > 1) then      Result := True    else if (ARec.ValueByName('PhaseCount').AsInteger < 1) then      Result := False    else      Result := ARec.ValueByName('AuditStatus').AsInteger = -1;  end;begin  TAction(Sender).Visible := G_IsCloud and (not IsGuest) and (stdProjects.IDTree.Selected.Rec.ValueByName('WebAuthorID').AsInteger = PHPWeb.UserID);  TAction(Sender).Enabled := (FEpureOnlineSwitch = 1) and       Assigned(stdProjects.IDTree.Selected) and      (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1) and      HasCompletePhase(stdProjects.IDTree.Selected.Rec);end;procedure TProjectManagerFrame.zgProjectsCellGetColor(Sender: TObject;  ACoord: TPoint; var AColor: TColor);var  vItem: TsdIDTreeNode;  value: String;  pc: Integer;begin  vItem := stdProjects.IDTree.Items[ACoord.Y - zgProjects.FixedRowCount];  if Assigned(vItem.Rec) then  begin    if ACoord.X = 11 then    begin      value := vItem.Rec.ValueByName('AuditStatus').asString;      pc := vItem.Rec.ValueByName('PhaseCount').AsInteger;      if (value = '-1') and (pc <> 0) then        AColor := TColor($00daedd4);    end;    if vItem.Rec.ValueByName('WebMeWorking').AsBoolean then    begin      AColor := TColor($000099FF);    end;  end;end;procedure TProjectManagerFrame.zgProjectsCellGetFont(Sender: TObject;  ACoord: TPoint; AFont: TFont);//var//  vItem: TsdIDTreeNode;//  value: String;begin//  if ACoord.X = 11 then//  begin//    vItem := stdProjects.IDTree.Items[ACoord.Y - zgProjects.FixedRowCount];//    value := vItem.Rec.ValueByName('AuditStatus').asString;////    if (value = '-1') then//      AFont.Color := TColor($00daedd4);////  end;end;function TProjectManagerFrame.RecByWebID(AWebID: Integer): TsdDataRecord;var i: Integer;  vTree: TsdIDTree;  vRec: TsdDataRecord;begin  Result := nil;  if (CurRec <> nil) and    (CurRec.ValueByName('WebUserID').AsInteger = PHPWeb.UserID) and    (CurRec.ValueByName('WebID').AsInteger = AWebID) and    (CurRec.ValueByName('Type').AsInteger = 1) then  begin    Result := CurRec;    Exit;  end;  vTree := stdProjects.IDTree;  for i := 0 to vTree.Count - 1 do  begin    vRec := vTree.Items[i].Rec;    if (vRec.ValueByName('WebUserID').AsInteger = PHPWeb.UserID) and      (vRec.ValueByName('WebID').AsInteger = AWebID) and      (vRec.ValueByName('Type').AsInteger = 1) then    begin      Result := vRec;      Break;    end;  end;end;function TProjectManagerFrame.HighlightProject(AWebID: Integer): Boolean;var vRec: TsdDataRecord;begin  vRec := RecByWebID(AWebID);  vRec.BeginUpdate;  vRec.ValueByName('WebMeWorking').AsBoolean := True;  vRec.EndUpdate;end;procedure TProjectManagerFrame.CheckOnlineSignStatusAndUpdate(  ARec: TsdDataRecord);  function SearchFileOnline(AURL: string; var ADownURL, AFolder, ASubFolder, ABidName, AMD5Web, AError: string; var AFolderID, ASubFolderID: Integer): Integer;  var vArr: TOVArr;  begin    Result := PHPWeb.Search(AURL, [''], [''], vArr);    AError := '';    if Result = 1 then    begin      if High(vArr) >= 0 then      begin        ADownURL := vArr[0, 0];        AFolder := vArr[0, 2];        ASubFolder := vArr[0, 3];        AMD5Web := vArr[0, 1];        AFolderID := StrToInt(vArr[0, 4]);        ASubFolderID := StrToInt(vArr[0, 5]);        ABidName := vArr[0, 6];      end      else        Result := 10;      // 返回10,表示无记录。用这个数字代表是否觉得怪异?没办法,0被占用了。    end    else if Result = 0 then      AError := PHPWeb.PageError('标段更新数据失败')    else if Result = -1 then      AError := PHPWeb.NetError('标段更新数据失败');  end;var  sSearchURL, sDownURL, sHint,  sMD5_UnLock, sError, sLocalFile: string;  iSearch, iFolderID, iSubFolderID: Integer;  bLock, bCanImp: Boolean;  vFileCheck: TTenderFileChecker;begin  GetLocalValues(ARec);  if FWebID = 0 then Exit;  LoadOnlineInfo;  // 先按正常接口找到最新的MD5码看是否需要更新  sSearchURL := Format('%stender/get/%d/update', [PHPWeb.MeasureURL, FWebID]);  iSearch := SearchFileOnline(sSearchURL, sDownURL, FWebFolder_OnLine, FWebSubFolder_OnLine, FWebBidName_OnLine, FWebMD5_OnLine, sError, iFolderID, iSubFolderID);  if iSearch = 1 then  begin    CheckWebFolders(iFolderID, iSubFolderID, FWebFolder_OnLine, FWebSubFolder_OnLine);    CheckBidName(FID, FWebBidName_OnLine);    // 打开前一定要先下载最新的标段文件(无论审核有没有通过)    if FWebMD5_OnLine <> FWebMD5_Local then      if not FileDownAndReceive(sDownURL, 1) then Exit;    // 编制人且项目末通过    if (FWebAuthorID = PHPWeb.UserID) and (FWebCheckStatusProject = csNotPass) then    begin      sHint := '本期计量审批不通过,你现在可以:' + #10#13 + '点击【是(Y)】重新开始本期计量,软件将打开本期上报时的数据,开始重新计量;' +        #10#13 +'点击【否(N)】查看不通过计量,软件将打开本期最后审批的数据,重新打开标段' + '可再次打开本确认窗口。';      if Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION) = ID_Yes then      begin        // 查找原报的文件        sSearchURL := Format('%suser/get/%d/%d/report/file', [PHPWeb.MeasureURL, FWebID, FPhaseNo]);        case SearchFileOnline(sSearchURL, sDownURL, FWebFolder_OnLine, FWebSubFolder_OnLine, FWebBidName_OnLine, sMD5_UnLock, sError, iFolderID, iSubFolderID) of          1: ; // 原报文件已正确找到          0, -1:          begin            sHint := sError + ' 因网络出错,无法连接到云端以获取本期原报上传的文件,无法重新开始本期,请重试。';            Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);            Exit;          end;        end;        if FileDownAndReceive(sDownURL, 2) then        begin          // 这里在线上创建新一期审批人列表、更改标段状态。不再使用同步更新等。          sSearchURL := Format('%suser/create/%d/%d/new/audit', [PHPWeb.MeasureURL, FWebID, FPhaseNo]);          case SearchFileOnline(sSearchURL, sDownURL, FWebFolder_OnLine, FWebSubFolder_OnLine, FWebBidName_OnLine, sMD5_UnLock, sError, iFolderID, iSubFolderID) of            1, 10:    // 执行到这里线上审核人列表已创建完毕。无需返回记录值,所以返回值为10。1是为了兼容。            begin              sHint := '【十分重要】:本期计量已重新开始,原报在本次上报完成前,请勿删除该标段或更换电脑。';              Application.MessageBox(PChar(sHint), '提示', MB_OK + MB_ICONINFORMATION);            end;            0, -1:            begin              sHint := sError + ' 因网络出错,无法在线上创建新一期审批人列表、提交项目状态等,请重试。';              Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);              Exit;            end;          end;        end        else          Exit;      end;    end;  end  else if (iSearch = 10) then  begin    if not PHPWeb.ExistInServer(FWebID) then    begin      sHint :='该项目[' + FWebBidName_Local + ']在云端已被删除,点击"确定"后,可手动删除该项目。';      Application.MessageBox(PChar(sHint), '提示', MB_OK + MB_ICONINFORMATION);      Exit;    end;  end  else if (iSearch = 0) or (iSearch = -1) then  begin    sHint := sError + '(因网络出错,无法检测[' + FWebBidName_Local + ']在云端是否有更新,本次操作已取消,请重试)。';    Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);    Exit;  end;  stdProjects.DataView.LocateInControl(ARec);end;procedure TProjectManagerFrame.LoadOnlineInfo;var  vPSArr: TStrArr;  vCArr: TOVArr;    // Checkers  sPicPath, sURL: string;begin  SetLength(vPSArr, 8);  sURL := Format('%smeasure/status/%d/get', [PHPWeb.MeasureURL, FWebID]);  if PHPWeb.Search(sURL, [''], [''], 3, vPSArr, vCArr) = 1 then  begin    FPhaseNo := StrToInt(vPSArr[0]);    FWebCheckStatusProject := TCheckStatus(StrToInt(vPSArr[1])-1);    FPhaseTotal := StrToInt(vPSArr[2]);    FWebFolder_OnLine := vPSArr[3];    FWebSubFolder_OnLine := vPSArr[4];    FWebOwnerName := vPSArr[5];    FWebOwnerCompany := vPSArr[6];    FWebOwnerRole := vPSArr[7];  end  else  begin    FPhaseNo := 0;    FWebCheckStatusProject := csNotBegin;    FPhaseTotal := 0;    FWebFolder_OnLine := '';    FWebSubFolder_OnLine := '';    FWebOwnerName := '';    FWebOwnerCompany := '';    FWebOwnerRole := '';  end;end;end.
 |