版本管理系统。

DataModules/PHPWebDm.pas

@@ -85,7 +85,7 @@ type
     function Search(AURL: string; AInFields, AInValues: array of string; var AOutRecords: TOVArr): Integer; overload;
     function Search(AURL: string; AInFields, AInValues: array of string; var AOutStrs: array of string ; var AOutRecords: TOVArr): Integer; overload;
     function Search(AURL: string; AInFields, AInValues: array of string; AResultType: Integer; var AOutStrs: array of string ; var AOutRecords: TOVArr): Integer; overload;
-    function Login(AAccount, APW: string; var AInfo, ACheckCode: string): TLoginType;
+    function Login(AAccount, APW: string; var AInfo, ANewExeURL: string): TLoginType;
     function ConnectServer(AIP: string; var ACompanyName: string): Integer;  // 新装软件，先弹出设置IP窗口
     function UpDataFile(AUserID, ATenderID, APhaseNo: Integer; AFile, AMD5_JL: string;
       AIsSubmit: Boolean; var AResultStr: string; ACheckPassed: Boolean; ACheckerMemo: string): Boolean;
@@ -158,11 +158,11 @@ begin
   Result := 'JLZF';
 end;
 
-function TPHPWeb.Login(AAccount, APW: string; var AInfo, ACheckCode: string): TLoginType;
+function TPHPWeb.Login(AAccount, APW: string; var AInfo, ANewExeURL: string): TLoginType;
 var vArr: array of string;
 begin
   vArr := VarArrayOf(['uid', 'name', 'email', 'ucompany', 'jobtitle', 'avatar', 'msg']);
-  case Search(FMeasureURL + 'signin', ['v3name', 'v3pass'], [AnsiToUtf8(AAccount), APW], vArr) of
+  case Search(FMeasureURL + 'signin', ['v4name', 'v4pass', 'version'], [AnsiToUtf8(AAccount), APW, GetVersion], vArr) of
     -1: Result := ltDisCon;
     0:
     begin
@@ -180,6 +180,12 @@ begin
       AInfo := vArr[6];
       Result := ltCon;
     end;
+    2:
+    begin
+      AInfo := vArr[0];
+      ANewExeURL := vArr[1];
+      Result := ltUpdate;
+    end;
   end;
 end;
 
@@ -493,7 +499,7 @@ begin
           end;
           Result := 1;
         end
-        else                                                     // 数据读取失败
+        else if SameText(vJson.Value['status'], 'false') then                                                    // 数据读取失败
         begin
           case AResultType of
             0:
@@ -513,7 +519,14 @@ begin
               AOutRecords[0, 0] := vJson.Value['msg'];
             end;
           end;
+
           Result := 0;
+        end
+        else if SameText(vJson.Value['status'], 'upgrade') then
+        begin
+          AOutStrs[Low(AOutStrs)] := vJson.Value['msg'];
+          AOutStrs[Low(AOutStrs) + 1] := vJson.Value['url'];
+          Result := 2;
         end;
       finally
         vJson.Free;

Dprs/CSL/Measure_Cloud.cfg

@@ -31,7 +31,7 @@
 -M
 -$M16384,1048576
 -K$00400000
--E"C:\Program Files (x86)\李뷘흡숭\李뷘써炬엄炬셕좆寧竟뺏흡숭(暾경)"
+-E"C:\Program Files (x86)\李뷘흡숭\셕좆連마 (데샙경+暾경) 1"
 -N"D:\Work\DelphiTemp"
 -LE"c:\program files (x86)\borland\delphi7\Projects\Bpl"
 -LN"c:\program files (x86)\borland\delphi7\Projects\Bpl"

Dprs/CSL/Measure_Cloud.dof

@@ -90,7 +90,7 @@ MaxStackSize=1048576
 ImageBase=4194304
 ExeDescription=
 [Directories]
-OutputDir=C:\Program Files (x86)\纵横软件\纵横结算决算计量一体化软件(云版)
+OutputDir=C:\Program Files (x86)\纵横软件\计量支付 (单机版+云版) 1
 UnitOutputDir=D:\Work\DelphiTemp
 PackageDLLOutputDir=
 PackageDCPOutputDir=
@@ -115,7 +115,7 @@ AutoIncBuild=1
 MajorVer=3
 MinorVer=1
 Release=3
-Build=1091
+Build=1094
 Debug=0
 PreRelease=0
 Special=0
@@ -126,7 +126,7 @@ CodePage=936
 [Version Info Keys]
 CompanyName=珠海纵横创新软件有限公司
 FileDescription=纵横结算决算计量一体化云版
-FileVersion=3.1.3.1091
+FileVersion=3.1.3.1094
 InternalName=
 LegalCopyright=
 LegalTrademarks=
@@ -145,5 +145,5 @@ Count=1
 Item0=D:\Work\DelphiTemp
 [HistoryLists\hlOutputDirectorry]
 Count=2
-Item0=C:\Program Files (x86)\纵横软件\纵横结算决算计量一体化软件(云版)
-Item1=C:\Program Files (x86)\纵横软件\计量支付 (单机版+云版) 1
+Item0=C:\Program Files (x86)\纵横软件\计量支付 (单机版+云版) 1
+Item1=C:\Program Files (x86)\纵横软件\纵横结算决算计量一体化软件(云版)

Dprs/CSL/Measure_Cloud.dpr

@@ -199,7 +199,11 @@ uses
   ProjGatherCalcData in '..\..\ProjGather\ProjGatherCalcData.pas',
   ProjGatherSelectFrm in '..\..\ProjGather\ProjGatherSelectFrm.pas' {ProjGatherSelectForm},
   ProjGatherTree in '..\..\ProjGather\ProjGatherTree.pas',
-  CalcData in '..\..\Units\CalcData.pas';
+  CalcData in '..\..\Units\CalcData.pas',
+  DealBillsExcelImport in '..\..\Units\DealBillsExcelImport.pas',
+  ExcelImport_Bills in '..\..\Units\ExcelImport_Bills.pas',
+  ExcelImport_GclBills in '..\..\Units\ExcelImport_GclBills.pas',
+  FileDownLoadFrm in '..\..\Forms\FileDownLoadFrm.pas' {FileDownLoadForm};
 
 {$R *.res}
 
@@ -243,8 +247,7 @@ begin
     if CheckDogExists then
     begin
       Application.CreateForm(TMainForm, MainForm);
-  Application.CreateForm(TProgressProForm, ProgressProForm);
-  end;
+    end;
     Application.Run;
   end;
 

Forms/FileDownLoadFrm.dfm

@@ -0,0 +1,67 @@
+object FileDownLoadForm: TFileDownLoadForm
+  Left = 680
+  Top = 367
+  BorderIcons = []
+  BorderStyle = bsDialog
+  Caption = #26032#29256#26412#19979#36733
+  ClientHeight = 183
+  ClientWidth = 463
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -13
+  Font.Name = #24494#36719#38597#40657
+  Font.Style = []
+  FormStyle = fsStayOnTop
+  OldCreateOrder = False
+  Position = poScreenCenter
+  PixelsPerInch = 96
+  TextHeight = 19
+  object lblFileName: TLabel
+    Left = 24
+    Top = 32
+    Width = 86
+    Height = 20
+    Caption = 'lblFileName'
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clWindowText
+    Font.Height = -15
+    Font.Name = #24494#36719#38597#40657
+    Font.Style = []
+    ParentFont = False
+  end
+  object gDown: TGauge
+    Left = 24
+    Top = 64
+    Width = 417
+    Height = 41
+    ForeColor = clOlive
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clRed
+    Font.Height = -16
+    Font.Name = #24494#36719#38597#40657
+    Font.Style = []
+    ParentFont = False
+    Progress = 0
+  end
+  object ITPDown: TIdHTTP
+    MaxLineAction = maException
+    ReadTimeout = 0
+    OnWork = ITPDownWork
+    OnWorkBegin = ITPDownWorkBegin
+    OnWorkEnd = ITPDownWorkEnd
+    AllowCookies = True
+    ProxyParams.BasicAuthentication = False
+    ProxyParams.ProxyPort = 0
+    Request.ContentLength = -1
+    Request.ContentRangeEnd = 0
+    Request.ContentRangeStart = 0
+    Request.ContentType = 'text/html'
+    Request.Accept = 'text/html, */*'
+    Request.BasicAuthentication = False
+    Request.UserAgent = 'Mozilla/3.0 (compatible; Indy Library)'
+    HTTPOptions = [hoForceEncodeParams]
+    Left = 280
+    Top = 32
+  end
+end

Forms/FileDownLoadFrm.pas

@@ -0,0 +1,103 @@
+{*******************************************************************************
+  单元名称：  FileDownLoadFrm.pas
+
+  单元说明：  通用的文件下载进度窗体，下载完退出程序，并运行刚下载的文件。
+
+  作者时间：  Chenshilong, 2016-08-10
+*******************************************************************************}
+
+unit FileDownLoadFrm;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, Gauges, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
+  IdTCPClient, IdHTTP, ShellAPI;
+
+type
+  TFileDownLoadForm = class(TForm)
+    lblFileName: TLabel;
+    gDown: TGauge;
+    ITPDown: TIdHTTP;
+    procedure ITPDownWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
+      const AWorkCountMax: Integer);
+    procedure ITPDownWork(Sender: TObject; AWorkMode: TWorkMode;
+      const AWorkCount: Integer);
+    procedure ITPDownWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
+  private
+    FURL: string;
+    FFileName: string;
+    FLocalFile: string;
+    procedure SetURL(const Value: string);
+    { Private declarations }
+  public
+    { Public declarations }
+    property URL: string read FURL write SetURL;
+
+    function DownFile: Boolean;
+  end;
+
+implementation
+
+{$R *.dfm}
+
+{ TFileDownLoadForm }
+
+procedure TFileDownLoadForm.ITPDownWorkBegin(Sender: TObject;
+  AWorkMode: TWorkMode; const AWorkCountMax: Integer);
+begin
+  gDown.MinValue := 0;
+  gDown.Progress := 0;
+  gDown.MaxValue := AWorkCountMax;
+end;
+
+procedure TFileDownLoadForm.ITPDownWork(Sender: TObject;
+  AWorkMode: TWorkMode; const AWorkCount: Integer);
+begin
+  gDown.Progress := AWorkCount;
+end;
+
+procedure TFileDownLoadForm.ITPDownWorkEnd(Sender: TObject;
+  AWorkMode: TWorkMode);
+begin
+  // 
+end;
+
+procedure TFileDownLoadForm.SetURL(const Value: string);
+var s: string;
+begin
+  FURL := Value;
+  // 反斜杠 ExtractFileName 函数搞不定，这里先转换
+  s := StringReplace(FURL, '/', '\', [rfReplaceAll, rfIgnoreCase]);
+  FFileName := ExtractFileName(s);
+  FLocalFile := 'Web\' + FFileName;
+  lblFileName.Caption := FFileName;
+  lblFileName.Update;
+end;
+
+function TFileDownLoadForm.DownFile: Boolean;
+var
+  vStream: TMemoryStream;
+begin
+  Result := False;
+
+  if Trim(URL) = '' then Exit;
+
+  vStream := TMemoryStream.Create;
+  try
+    try
+      ITPDown.Get(URL, vStream);
+      vStream.SaveToFile(FLocalFile);
+      Result := True;
+      ShellExecute(Handle, 'open', pchar(FLocalFile), nil, nil, SW_SHOWNORMAL);
+      Application.Terminate;
+    except
+      Result := False;
+    end;
+  finally
+    vStream.Free;
+  end;
+end;
+
+end.

Forms/LoginFrm.pas

@@ -71,7 +71,8 @@ type
 implementation
 
 uses
-  ScUtils, ShellAPI, IniFiles, ScConfig, Md5, PHPWebDm, ConstUnit;
+  ScUtils, ShellAPI, IniFiles, ScConfig, Md5, PHPWebDm, ConstUnit,
+  FileDownLoadFrm;
 
 
 {$R *.dfm}
@@ -165,7 +166,8 @@ begin
 end;
 
 procedure TLoginFrm.btnLoginClick(Sender: TObject);
-var sInfo, sURL, sCheckCode, sMD5PW: string;
+var sInfo, sURL, sMD5PW: string;
+  vFDForm: TFileDownLoadForm;
 begin
   lblHint.Caption := '';
   lblHint.Update;
@@ -186,14 +188,14 @@ begin
     Exit;
   end;
 
-  case PHPWeb.Login(cbUser.Text, edtPW.Text, sInfo, sCheckCode) of
-    ltCon:
+  case PHPWeb.Login(cbUser.Text, edtPW.Text, sInfo, sURL) of
+   { ltCon:
     begin
       if Trim(sInfo) <> '' then
         Application.MessageBox(PChar(sInfo), '新版本提示', MB_OK + MB_ICONINFORMATION);
 
       ModalResult := mrOk;
-    end;
+    end;      }
 
     ltLoginFail:
     begin
@@ -205,7 +207,7 @@ begin
     end;
 
     ltUpdate:
-    begin
+  {  begin
       // 无法对PHP返回的字符串进行排版。这里使用Delphi自身的字符串。
       sInfo := '尊敬的用户：' + #13#13 +
                '系统检测出您是通过SmartCost旧版本程序注册了本帐户(' + Trim(cbUser.Text) +
@@ -224,6 +226,23 @@ begin
       finally
         Screen.Cursor := crDefault;
       end;
+    end;   }
+    // 升级
+    begin
+      if Application.MessageBox(PChar(sInfo), '系统提示', MB_OKCANCEL + MB_ICONQUESTION) = ID_OK then
+      begin
+        vFDForm := TFileDownLoadForm.Create(nil);
+        try
+          vFDForm.URL := sURL;
+          vFDForm.Show;
+          vFDForm.Update;
+          vFDForm.DownFile;
+        finally
+          vFDForm.Free;
+        end;
+      end;
+
+      ModalResult := mrNone;
     end;
 
     ltIncomplete: