Jelajahi Sumber

文件版本管理,引入多线程。

Chenshilong 8 tahun lalu
induk
melakukan
538aca09a4

+ 1 - 1
DataModules/PHPWebDm.pas

@@ -162,7 +162,7 @@ function TPHPWeb.Login(AAccount, APW: string; var AInfo, ANewExeURL: string): TL
 var vArr: array of string;
 begin
   vArr := VarArrayOf(['uid', 'name', 'email', 'ucompany', 'jobtitle', 'avatar', 'msg']);
-  case Search(FMeasureURL + 'signin', ['v4name', 'v4pass', 'version'], [AnsiToUtf8(AAccount), APW, GetVersion], vArr) of
+  case Search(FMeasureURL + 'signin', ['v4name', 'v4pass', 'version'], [AnsiToUtf8(AAccount), APW, {'0.0.0.0'}GetVersion], vArr) of
     -1: Result := ltDisCon;
     0:
     begin

+ 2 - 2
Dprs/CSL/Measure_Cloud.dof

@@ -115,7 +115,7 @@ AutoIncBuild=1
 MajorVer=3
 MinorVer=1
 Release=3
-Build=1094
+Build=1101
 Debug=0
 PreRelease=0
 Special=0
@@ -126,7 +126,7 @@ CodePage=936
 [Version Info Keys]
 CompanyName=珠海纵横创新软件有限公司
 FileDescription=纵横结算决算计量一体化云版
-FileVersion=3.1.3.1094
+FileVersion=3.1.3.1101
 InternalName=
 LegalCopyright=
 LegalTrademarks=

+ 3 - 2
Dprs/CSL/Measure_Cloud.dpr

@@ -203,7 +203,8 @@ uses
   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};
+  FileDownLoadFrm in '..\..\Forms\FileDownLoadFrm.pas' {FileDownLoadForm},
+  DebugUsers in '..\..\Units\DebugUsers.pas';
 
 {$R *.res}
 
@@ -247,7 +248,7 @@ begin
     if CheckDogExists then
     begin
       Application.CreateForm(TMainForm, MainForm);
-    end;
+  end;
     Application.Run;
   end;
 

TEMPAT SAMPAH
Dprs/CSL/Measure_Cloud.res


+ 4 - 3
Forms/FileDownLoadFrm.dfm

@@ -1,7 +1,7 @@
 object FileDownLoadForm: TFileDownLoadForm
   Left = 680
   Top = 367
-  BorderIcons = []
+  BorderIcons = [biSystemMenu]
   BorderStyle = bsDialog
   Caption = #26032#29256#26412#19979#36733
   ClientHeight = 183
@@ -15,6 +15,7 @@ object FileDownLoadForm: TFileDownLoadForm
   FormStyle = fsStayOnTop
   OldCreateOrder = False
   Position = poScreenCenter
+  OnCreate = FormCreate
   PixelsPerInch = 96
   TextHeight = 19
   object lblFileName: TLabel
@@ -35,9 +36,9 @@ object FileDownLoadForm: TFileDownLoadForm
     Top = 64
     Width = 417
     Height = 41
-    ForeColor = clOlive
+    ForeColor = clBlue
     Font.Charset = DEFAULT_CHARSET
-    Font.Color = clRed
+    Font.Color = clBlack
     Font.Height = -16
     Font.Name = #24494#36719#38597#40657
     Font.Style = []

+ 52 - 25
Forms/FileDownLoadFrm.pas

@@ -16,6 +16,18 @@ uses
   IdTCPClient, IdHTTP, ShellAPI;
 
 type
+  TDownThread = class(TThread)
+  private
+    FURL: string;
+    FFileName: string;
+    FLocalFile: string;
+    FOwner: TObject;
+    procedure SetURL(const Value: string);
+  public
+    property URL: string read FURL write SetURL;
+    procedure Execute; override;
+  end;
+
   TFileDownLoadForm = class(TForm)
     lblFileName: TLabel;
     gDown: TGauge;
@@ -25,17 +37,15 @@ type
     procedure ITPDownWork(Sender: TObject; AWorkMode: TWorkMode;
       const AWorkCount: Integer);
     procedure ITPDownWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
+    procedure FormCreate(Sender: TObject);
   private
-    FURL: string;
-    FFileName: string;
-    FLocalFile: string;
+    FDownThread: TDownThread;
     procedure SetURL(const Value: string);
     { Private declarations }
   public
     { Public declarations }
-    property URL: string read FURL write SetURL;
-
-    function DownFile: Boolean;
+    property URL: string write SetURL;
+    procedure RefreshDisplay(AFileName: string);
   end;
 
 implementation
@@ -65,39 +75,56 @@ 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;
+  FDownThread.URL := Value;
+end;
+
+procedure TFileDownLoadForm.RefreshDisplay(AFileName: string);
+begin
+  lblFileName.Caption := AFileName;
   lblFileName.Update;
 end;
 
-function TFileDownLoadForm.DownFile: Boolean;
+{ TDownThread }
+
+procedure TDownThread.Execute;
 var
   vStream: TMemoryStream;
 begin
-  Result := False;
+  inherited;
 
-  if Trim(URL) = '' then Exit;
+  if Trim(FURL) = '' 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;
+    TFileDownLoadForm(FOwner).ITPDown.Get(FURL, vStream);
+    vStream.SaveToFile(FLocalFile);
+    ShellExecute(Handle, 'open', pchar(FLocalFile), nil, nil, SW_SHOWNORMAL);
+    TFileDownLoadForm(FOwner).Close;
+    Synchronize(Application.Terminate);      // 同步到主线程,不然执行后没响应。
   finally
     vStream.Free;
   end;
 end;
 
+procedure TFileDownLoadForm.FormCreate(Sender: TObject);
+begin
+  FDownThread := TDownThread.Create(True);
+  FDownThread.FOwner := Self;
+  FDownThread.FreeOnTerminate := True;
+end;
+
+procedure TDownThread.SetURL(const Value: string);
+var s: string;
+begin
+  FURL := Value;
+  // 反斜杠 ExtractFileName 函数搞不定,这里先转换
+  s := StringReplace(Value, '/', '\', [rfReplaceAll, rfIgnoreCase]);
+  FFileName := ExtractFileName(s);
+  FLocalFile := 'Web\' + FFileName;
+  TFileDownLoadForm(FOwner).RefreshDisplay(FFileName);
+
+  Resume;    // 在这里唤醒
+end;
+
 end.

+ 3 - 8
Forms/LoginFrm.pas

@@ -191,13 +191,10 @@ begin
   end;
 
   case PHPWeb.Login(cbUser.Text, edtPW.Text, sInfo, sURL) of
-   { ltCon:
+    ltCon:
     begin
-      if Trim(sInfo) <> '' then
-        Application.MessageBox(PChar(sInfo), 'а汾Ìáʾ', MB_OK + MB_ICONINFORMATION);
-
       ModalResult := mrOk;
-    end;      }
+    end;      
 
     ltLoginFail:
     begin
@@ -236,9 +233,7 @@ begin
         vFDForm := TFileDownLoadForm.Create(nil);
         try
           vFDForm.URL := sURL;
-          vFDForm.Show;
-          vFDForm.Update;
-          vFDForm.DownFile;
+          vFDForm.ShowModal;
         finally
           vFDForm.Free;
         end;