Merge branch '3.1.5'

DataModules/PHPWebDm.pas

@@ -93,6 +93,7 @@ type
       ACategory, AMemo, APhaseName: string; var ANewFileName: string): Boolean;
     function GetAttachmentFileList(AWebID: Integer; var vArr: TOVArr): Boolean;
     function zip(AFileArr: array of string): string;
+    function CheckZip(AZipFile: string; AFileCount: Integer): Boolean;   // 检测zip是否能够正确解压出所有文件。
     function TempName(ALength: Integer = 12): string;
     function WebPath: string;
     function UserPath: string;
@@ -261,6 +262,24 @@ begin
   end;
 end;
 
+function TPHPWeb.CheckZip(AZipFile: string; AFileCount: Integer): Boolean;
+var vUnZip: TVCLUnZip;
+begin
+  vUnZip := TVCLUnZip.Create(nil);
+  try
+    vUnZip.ZipName := AZipFile;
+    vUnZip.DestDir := 'C:\Temp\MeasureTemp\';
+    vUnZip.DoAll := True;
+    vUnZip.RecreateDirs := True;
+    vUnZip.RetainAttributes := True;
+    vUnZip.OverwriteMode := Always;
+    Result := (AFileCount = vUnZip.UnZip);
+  finally
+    DeleteFolder(vUnZip.DestDir);
+    vUnZip.Free;
+  end;
+end;
+
 
 function TPHPWeb.UpDataFile(AUserID, ATenderID, APhaseNo: Integer; AFile, AMD5_JL: string;
   AIsSubmit: Boolean; var AResultStr: string; ACheckPassed: Boolean; ACheckerMemo: string): Boolean;
@@ -299,7 +318,6 @@ begin
 
     IdDataStream.AddFile('upfile', AFile, 'text/plain');
     IdDataStream.AddFormField('upfile', AFile);
-//    IdDataStream.AddFormField('submit', 'submit');
     IdDataStream.AddFormField('MD5_JL', AMD5_JL);
     sZipMD5 := MD5_File(AFile);
     IdDataStream.AddFormField('MD5_Zip', sZipMD5);

Forms/mProgressProFrm.dfm

@@ -0,0 +1,88 @@
+object ProgressProForm: TProgressProForm
+  Left = 1179
+  Top = 324
+  BorderIcons = []
+  BorderStyle = bsNone
+  Caption = #25552#31034
+  ClientHeight = 236
+  ClientWidth = 428
+  Color = clWindow
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -12
+  Font.Name = #24494#36719#38597#40657
+  Font.Style = []
+  FormStyle = fsStayOnTop
+  OldCreateOrder = False
+  Position = poMainFormCenter
+  PixelsPerInch = 96
+  TextHeight = 17
+  object Shape1: TShape
+    Left = 0
+    Top = 0
+    Width = 428
+    Height = 236
+    Align = alClient
+    Brush.Style = bsClear
+    OnMouseDown = Shape1MouseDown
+  end
+  object Gauge1: TGauge
+    Left = 16
+    Top = 54
+    Width = 393
+    Height = 23
+    BackColor = clWindow
+    Color = clBlack
+    ForeColor = 43690
+    MaxValue = 0
+    ParentColor = False
+    ParentShowHint = False
+    Progress = 0
+    ShowHint = False
+    ShowText = False
+  end
+  object lblTitle: TLabel
+    Left = 16
+    Top = 16
+    Width = 133
+    Height = 25
+    Caption = #27491#22312#29983#25104#25968#25454#21253
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clWindowText
+    Font.Height = -19
+    Font.Name = #24494#36719#38597#40657
+    Font.Style = []
+    ParentFont = False
+  end
+  object lblPercent: TLabel
+    Left = 336
+    Top = 84
+    Width = 74
+    Height = 30
+    Alignment = taRightJustify
+    AutoSize = False
+    Caption = '100%'
+    Font.Charset = GB2312_CHARSET
+    Font.Color = 43690
+    Font.Height = -35
+    Font.Name = #40657#20307
+    Font.Style = [fsBold]
+    ParentFont = False
+  end
+  object mmTask: TMemo
+    Left = 16
+    Top = 125
+    Width = 393
+    Height = 104
+    TabStop = False
+    BorderStyle = bsNone
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clGray
+    Font.Height = -12
+    Font.Name = #24494#36719#38597#40657
+    Font.Style = []
+    ParentFont = False
+    ReadOnly = True
+    TabOrder = 0
+  end
+end

Forms/mProgressProFrm.pas

@@ -0,0 +1,129 @@
+{*******************************************************************************
+    单元名称： mProgressProFrm.pas
+
+    单元说明： 任务清单效果的进度条。
+
+    作者时间： Chenshilong, 2015-12-07
+*******************************************************************************}
+
+
+unit mProgressProFrm;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, ComCtrls, StdCtrls, ExtCtrls, Gauges, jpeg;
+
+type
+  TProgressProForm = class(TForm)
+    Shape1: TShape;
+    Gauge1: TGauge;
+    lblTitle: TLabel;
+    lblPercent: TLabel;
+    mmTask: TMemo;
+    procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
+      Shift: TShiftState; X, Y: Integer);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+  TProgressPosType = (pptNo, pptAdd, pptSet);    // 进度不变；增加进度；指定进度；
+  TProgressMemoType = (pmtNo, pmtAdd, pmtEdit);  // 备注信息不变；增加一条备注；修改当前这条备注。
+
+procedure ProgressProCreate(AMaxValue: Integer = 100; ATitle: string = '正在处理请稍候>>>');
+procedure ProgressProFree;
+procedure ProgressProRun(AMemoValue: string; APosValue: Integer = 10;
+                         AMemoType: TProgressMemoType = pmtAdd; APosType: TProgressPosType = pptAdd);
+procedure ProgressProTitle(ATitle: string);
+
+var
+  ProgressProForm: TProgressProForm = nil;
+
+const
+  sc_DragMove = $f012;
+
+implementation
+
+uses ScUtils;
+
+{$R *.dfm}
+
+procedure ProgressProCreate(AMaxValue: Integer; ATitle: string);
+begin
+  if ProgressProForm = nil then
+    ProgressProForm := TProgressProForm.Create(nil);
+  ProgressProForm.lblTitle.Caption := ATitle;
+  ProgressProForm.Gauge1.MaxValue := AMaxValue;
+  ProgressProForm.Gauge1.Progress := 0;
+  ProgressProForm.Show;
+  ProgressProForm.Update;
+end;
+
+procedure ProgressProFree;
+begin
+  if ProgressProForm <> nil then
+  begin
+    with ProgressProForm.Gauge1 do
+    begin
+      if (Progress <> MaxValue) then
+      ProgressProRun('已完成。', MaxValue, pmtAdd, pptSet);
+    end;
+
+    // 关闭前要延迟500ms，有些地方如果不延迟，关得太快，感觉进度条没走完就关了，体验很不好。
+    Sleep(500);
+
+    FreeAndNil(ProgressProForm);
+  end;
+end;
+
+procedure ProgressProRun(AMemoValue: string; APosValue: Integer;
+                         AMemoType: TProgressMemoType; APosType: TProgressPosType);
+begin
+  if ProgressProForm = nil then Exit;
+  with ProgressProForm do
+  begin
+    if APosType = pptAdd then
+      Gauge1.Progress := Gauge1.Progress + APosValue
+    else if APosType = pptSet then
+      Gauge1.Progress := APosValue;
+
+    if Gauge1.Progress > Gauge1.MaxValue then     // 如果算得不对，缩回5格
+      Gauge1.Progress := Gauge1.MaxValue - 2;
+
+    lblPercent.Caption := IntToStr(Gauge1.PercentDone) + '%';
+
+    if (AMemoType <> pmtNo) or (AMemoValue <> '') then
+    begin
+      with mmTask.Lines do
+      begin
+        if (AMemoType = pmtEdit) and (Count > 0) then
+          Delete(Count - 1);
+        Add(AMemoValue);
+      end;
+    end;
+
+    Update;
+  end;
+end;
+
+procedure ProgressProTitle(ATitle: string);
+begin
+  if ProgressProForm = nil then Exit;
+  with ProgressProForm do
+  begin
+    lblTitle.Caption := ATitle;
+    Update;
+  end;
+end;
+
+procedure TProgressProForm.Shape1MouseDown(Sender: TObject;
+  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+begin
+  ReleaseCapture;
+  (ProgressProForm as TWinControl).PerForm(wm_SysCommand, sc_DragMove, 0);
+end;
+
+end.

Frames/ProjectFme.dfm

@@ -877,7 +877,7 @@ object ProjectFrame: TProjectFrame
           OnChanged = jcbPhaseChanged
         end
         object btnPass: TCslButton
-          Left = 221
+          Left = 226
           Top = 1
           Width = 77
           Height = 19

Frames/ProjectFme.pas

@@ -189,7 +189,7 @@ uses
   PhaseData, BGLDm, MainFrm, ZhAPI, SearchDm, PHPWebDm, ActiveX,
   ConstUnit, MD5Unit, sdIDTree, sdDB, mProgressFrm, ConditionalDefines,
   ProjectCommands, ProjectProperty, CheckerMemoFrm, BillsMeasureDm,
-  ProgressHintFrm;
+  ProgressHintFrm, mProgressProFrm;
 
 {$R *.dfm}
 
@@ -755,7 +755,7 @@ begin
     if ProjectData.PhaseIndex < ProjectData.ProjProperties.PhaseCount then
       btnPass.Enabled := False
     else
-      btnPass.Enabled := CheckerFrame.Me.IsChecking;    
+      btnPass.Enabled := CheckerFrame.Me.IsChecking;
 
     btnNotPass.Enabled := btnPass.Enabled;
     btnPass.Left := jcbAudit.Left + jcbAudit.Width + 5;
@@ -779,8 +779,11 @@ var sURL, sAppFile, sJsonFile_Bills, sJsonFile_Common, sAppFile_UnLock,
   bSubmit: Boolean;
   vExportor: TTenderExport;
   vCF: TCheckerMemoForm;
+  bNeedFreeEarlier: Boolean;
+  iFile: Integer;
 begin
   bSubmit := False;
+  bNeedFreeEarlier := False;
   sAppFile := PHPWeb.UserPath + 'ProjectFile.rmf';
   // 只有编制人才真正需要该文件存在
   sAppFile_UnLock := PHPWeb.UserPath + 'ProjectFile_UnLock';
@@ -815,8 +818,9 @@ begin
       if Application.MessageBox(PChar(CheckersHint), '询问', MB_YESNO + MB_ICONQUESTION) = ID_No then
         Exit;
 
-      CreateProgress('正在保存项目');
+      ProgressProCreate(100, '本地数据文件上传到云端');
       ProjectData.Save;
+      ProgressProRun('保存本地数据。OK');
 
       // 生成无锁文件
       vRec := MainForm.ProjectManagerFrame.Rec(ProjectData.ProjectID);
@@ -826,8 +830,16 @@ begin
       finally
         vExportor.Free;
       end;
-
-      ProjectData.SubmitProject(sAppFile);
+      ProgressProRun('生成无锁文件。OK');
+      ProgressProRun('生成并检验待审核文件...', 0);
+      if not ProjectData.SubmitProject(sAppFile) then
+        if not ProjectData.SubmitProject(sAppFile) then
+        begin
+          bNeedFreeEarlier := True;
+          Application.MessageBox('Sorry！待审核文件连续2次生成失败！如果重试后仍不能解决该问题，请联系纵横客服。', '提示', MB_OK + MB_ICONWARNING);
+          Exit;
+        end;
+      ProgressProRun('生成并检验待审核文件。OK', 10, pmtEdit);
     end
     else if ProjectData.CurUserIsChecker then
     begin
@@ -851,9 +863,18 @@ begin
           Exit;
       end;
 
-      CreateProgress('正在保存项目');
+      ProgressProCreate(100, '本地数据文件上传到云端');
       ProjectData.Save;
-      ProjectData.SubmitProject(sAppFile);
+      ProgressProRun('保存本地数据。OK');
+      ProgressProRun('生成并检验待审核文件...', 0);
+      if not ProjectData.SubmitProject(sAppFile) then
+        if not ProjectData.SubmitProject(sAppFile) then
+        begin
+          bNeedFreeEarlier := True;
+          Application.MessageBox('Sorry！待审核文件连续2次生成失败！如果重试后仍不能解决该问题，请联系纵横客服。', '提示', MB_OK + MB_ICONWARNING);
+          Exit;
+        end;
+      ProgressProRun('生成并检验待审核文件。OK', 10, pmtEdit);
     end
     else if ProjectData.CurUserIsOwner then
     begin
@@ -877,16 +898,26 @@ begin
           Exit;
       end;
 
-      CreateProgress('正在保存项目');
+      ProgressProCreate(100, '本地数据文件上传到云端');
       ProjectData.Save;
-      ProjectData.ReplyProject(sAppFile);
+      ProgressProRun('保存本地数据。OK');
+      ProgressProRun('生成并检验待批复文件...', 0);
+      if not ProjectData.ReplyProject(sAppFile) then
+        if not ProjectData.ReplyProject(sAppFile) then
+        begin
+          bNeedFreeEarlier := True;
+          Application.MessageBox('Sorry！批复文件连续2次生成失败！如果重试后仍不能解决该问题，请联系纵横客服。', '提示', MB_OK + MB_ICONWARNING);
+          Exit;
+        end;
+      ProgressProRun('生成并检验待批复文件。OK', 10, pmtEdit);
     end;
   finally
     vCF.Free;
+    if bNeedFreeEarlier then
+      ProgressProFree;
   end;
 
   try
-    RefreshProgress('创建文件包');
     sJsonFile_Bills := ExtractFilePath(sAppFile) + 'JsonFile_Bills.json';
     sJsonFile_Common := ExtractFilePath(sAppFile) + 'JsonFile_Common.json';
     sMD5_JL := MD5_File(sAppFile);
@@ -894,16 +925,30 @@ begin
     // 上传清单，每期都传，可覆盖旧的。
     ProjectData.ExportJson_Bills(sJsonFile_Bills);
     ProjectData.ExportJson_Common(sJsonFile_Common);
+    ProgressProRun('生成Web汇总数据文件。OK');
+    ProgressProRun('生成并检验up数据包文件...', 0);
     sZipFile := PHPWeb.zip([sAppFile, sJsonFile_Bills, sJsonFile_Common, sAppFile_UnLock]);
+
+    if FileExists(sAppFile_UnLock) then
+      iFile := 4
+    else
+      iFile := 3;
+    if not PHPWeb.CheckZip(sZipFile, iFile) then
+    begin
+      Application.MessageBox('up数据包文件无法通过检验请重试！如果重试后仍不能解决该问题，请联系纵横客服。', '提示', MB_OK + MB_ICONWARNING);
+      Exit;
+    end;
+
+    ProgressProRun('生成并检验up数据包文件。OK', 10, pmtEdit);
     try
-      // 上传标段文件
-      RefreshProgress('上传到云端');
+      ProgressProRun('上传数据包到云端...(温馨提示：请不要乱点哦，Windows容易死机)', 0);
       if PHPWeb.UpDataFile(PHPWeb.UserID, ProjectData.WebID, ProjectData.PhaseIndex,
         sZipFile, sMD5_JL, bSubmit, sResult, ACheckPassed, sCheckerMemo) then
       begin
+        ProgressProRun('上传数据包到云端。OK', 90, pmtEdit, pptSet);
         if ProjectData.CurUserIsChecker then
           ProjectData.Checkers.FindByID(PHPWeb.UserID).Memo := sCheckerMemo;
-        RefreshProgress('本地刷新显示');
+
         if ProjectData.PhaseIndex = 0 then   // 0号台账，现已废弃
         begin
           MainForm.ProjectManagerFrame.ShowProjWebInfoTop(0);
@@ -957,7 +1002,7 @@ begin
         sResult), '警告', MB_OK + MB_ICONWARNING);
     end;
   finally
-    CloseProgress;
+    ProgressProFree;
   end;
 end;