⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 itigprogressknown.pas

📁 autoupdate 1.02 source code
💻 PAS
字号:
unit ItigProgressKnown;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls, Progress, syncobjs, ItigNet;

type

  TItigProgressKnown = class(TForm, IUnknown, IProgress)
    Panel1: TPanel;
    Image1: TImage;
    lblMessage: TLabel;
    lblTime: TLabel;
    tmrTiming: TTimer;
    cmdAct: TButton;
    prProgress: TProgressBar;
    lblPercent: TLabel;
    procedure tmrTimingTimer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure cmdActClick(Sender: TObject);
  private
    totalActions: Integer;
    doneActions: Integer;
    showTime: Boolean;

    start: TDateTime;
    ivInfo: TItigNet;

    ivAutoClose: Boolean;
    ivTimeReached: Boolean;
    ivDoClose: Boolean;
    ivCanClose: Boolean;

    ivPhases: Integer;
    ivCurrentPhase: Integer;
    ivIsPhased: Boolean;
    ivAction : String;

    ivCancelled: Boolean;
    ThreadWorking : Boolean;

  public

   ActionDescription : String;

    property AutoClose : Boolean read ivAutoClose write ivAutoClose;

    procedure setNoActions(toVal: Integer);
    procedure actionDone();
    procedure SetPos(n : Integer);
    procedure setMessage(msg: String);
    procedure showProgress(b: Boolean);

    procedure OnThreadComplete(var Message: TMessage); message WM_THREAD_COMPLETE;

    procedure Execute(Action: String; toInfo: TItigNet);

    procedure SetInfo(toInfo: TItigNet);
    property Info: TItigNet Write setInfo;

    property ShowET: Boolean read showTime write showTime;
    function GetHandle : hWnd;
    function IsCancelled: Boolean;
    procedure Done;

    procedure PhaseDone;
    procedure SetPhases(noPhases: integer);

  end;

var
  ProgressKnown: TItigProgressKnown;

implementation

uses AutoUpdate;

{$R *.DFM}

procedure TItigProgressKnown.actionDone();
begin
   doneActions := doneActions + 1;
   if TotalActions > 0 then
   begin
      lblPercent.Caption := format('%2.0f%%', [(doneActions / totalActions )*100]);
   end;
   prProgress.Position := doneActions;
end;

procedure TItigProgressKnown.SetPos(n : Integer);
begin
   doneActions := n;
   if TotalActions > 0 then
   begin
      lblPercent.Caption := format('%2.0f%%', [(doneActions / totalActions )*100]);
   end;
   prProgress.Position := n;
end;

procedure TItigProgressKnown.setNoActions(toVal: Integer);
begin
   totalActions := toVal;
   doneActions := 0;
   start := Now;

   prProgress.Max := totalActions;
   prProgress.Step := 1;
   prProgress.Position := 0;

   lblTime.Caption := 'Estimated time remaining...';
end;

procedure TItigProgressKnown.tmrTimingTimer(Sender: TObject);
var
    actRem: Integer;
    currTime, remTime: Double;
    timePerAction: Double;
    h, m, s: Integer;
begin

   if not ivTimeReached then
   begin
      ivTimeReached := true;
      if ivDoClose then
      begin
         ModalResult := mrOk;
         Exit;
      end;
   end;

   if Not((totalActions <= 0) or (doneActions = 0) or (totalActions = doneActions)) then
   begin
      currTime := (Now - start) * 86400; //24 * 60 * 60
      lblTime.Caption := 'Estimated time remaining...';
      timePerAction := currTime / doneActions;
      actRem := totalActions - doneActions;
      remTime := timePerAction * actRem;

      if (actRem / totalActions) < 0.98 then
      begin
         h := Trunc(remTime / 1440); //24 * 60
         remTime := remTime - (h * 1440);
         m := Trunc(remTime / 60);
         remTime := remTime - (m * 60);
         s := Trunc(remTime);
         lblTime.Caption := 'Estimated time remaining ' + format('%.2d', [h]) + ':' + format('%.2d', [m]) + ':' + format('%.2d', [s]);
      end;

      tmrTiming.Interval := Trunc((currTime * 1000) / 20);
      if tmrTiming.Interval < 1000 then tmrTiming.Interval := 1000;
   end;
end;

procedure TItigProgressKnown.setMessage(msg: String);
begin
   if ivIsPhased then
   begin
      lblMessage.Caption := format('Stage %d of %d: %s', [ivCurrentPhase, ivPhases, msg]);
   end
   else
   begin
      lblMessage.Caption := msg;
   end;
end;

procedure TItigProgressKnown.OnThreadComplete(var Message: TMessage);
begin
   ivInfo.GotMessage;
   
   ThreadWorking := False;

   ivCanClose := true;
   cmdAct.enabled := true;

   if ivInfo.GetResult = irTryAgain then
   begin
      if ivInfo.GetErrorMsg = '' then
      begin
               // retry somehow...
               ivInfo.ResultCode := irReady;

               ivDoClose := false;
               ivTimeReached := false;

               ThreadWorking := True;
               ivCanClose := False;
               ivCancelled := False;

                totalActions := 0;
                doneActions := 0;

               ivInfo.BeginExecute(ivAction, self);
               exit;
      end
      else
      begin
         // for now assume that we need to install the cert.
         if MessageDlg('Before you can use the Info-In.com client software you must install the server certificate.  This is used to guarantee the security of your connection to the Info-In.com server.  Do you wish to install the certificate?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
         begin
            // retry somehow...
            MessageDlg('Once the certificate is installed, click OK to continue', mtInformation, [mbOK], 0);
            ivInfo.ResultCode := irReady;

            ivDoClose := false;
            ivTimeReached := false;

            ThreadWorking := True;
            ivCanClose := False;
            ivCancelled := False;

             totalActions := 0;
             doneActions := 0;

            ivInfo.BeginExecute(ivAction, self);
            exit;
         end
         else
         begin
            if MessageDlg('It is possible to run the Info-In.com client in low security mode.  This means that it is harder to guarantee that the Info-In.com server is who it says it is.  Do you wish to run in low security mode?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
            begin
               ivInfo.Option.LowSecurity := True;
               //ivInfo.Option.SaveInternet;

               // retry somehow...
               ivInfo.ResultCode := irReady;

               ivDoClose := false;
               ivTimeReached := false;

               ThreadWorking := True;
               ivCanClose := False;
               ivCancelled := False;

                totalActions := 0;
                doneActions := 0;

               ivInfo.BeginExecute(ivAction, self);
               exit;
            end
            else
            begin
               ivInfo.ResultCode := irError;
            end;
         end;
      end;
   end;

   if (ivInfo.GetResult = irError)  then
   begin
      ivInfo.Debug('Error Message: ' + ivInfo.GetErrorMsg);
      ivInfo.ThreadComplete(Message);
      MessageDlg(ivInfo.GetErrorMsg, mtError, [mbOk], 0);

      ModalResult := mrCancel;
   end
   else if (ivInfo.GetResult = irCancel) then
   begin
      MessageDlg('Operation cancelled at user request', mtInformation, [mbOK], 0);
      ivInfo.Debug('Process Cancelled');
      ivInfo.ThreadComplete(Message);

      ModalResult := mrCancel;
   end
   else
   begin
      //ivInfo.Debug('Done Message');
      ivInfo.ThreadComplete(Message);
      SetPos(totalActions);

      if AutoClose then
      begin
         cmdAct.enabled := false;
         if ivTimeReached then
         begin
            ModalResult := mrOK;
         end
         else
         begin
            ivDoClose := true;
         end;
      end;
   end;
end;

procedure TItigProgressKnown.Execute(Action: String; toInfo: TItigNet);
begin
   try
      ivDoClose := false;
      ivTimeReached := false;
      ivAction := Action;

      SetInfo(toInfo);
      ThreadWorking := True;
      ivCanClose := False;
      ivCancelled := False;
      toInfo.Debug('BeginExecute' );
      ivInfo.BeginExecute(Action, self);
      toInfo.Debug('Show Modal' );
      ShowModal;
      toInfo.Debug('Show Modal Done');
   except
      on E : Exception do
      begin
         toInfo.Debug('There was an exception ' + E.Message);
      end;
   end;
end;

procedure TItigProgressKnown.SetInfo(toInfo: TItigNet);
begin
    ivInfo := toInfo;
end;

procedure TItigProgressKnown.showProgress(b:Boolean);
begin
    prProgress.visible := b;
    lblTime.visible := b;
    lblPercent.visible := b;
end;

function TItigProgressKnown.GetHandle : hWnd;
begin
   Result := Handle;
end;

procedure TItigProgressKnown.Done;
begin
   cmdAct.Caption := '&Ok';
   cmdAct.ModalResult := mrOk;

   lblTime.Caption := ActionDescription + 'Complete';
   lblPercent.Caption := '100%';

   if not AutoClose then
   begin
      Beep;
   end;

   if totalActions = 0 then
   begin
      setNoActions(1);
   end;
   SetPos(totalActions);

end;

procedure TItigProgressKnown.PhaseDone;
begin
   ivCurrentPhase := ivCurrentPhase + 1;
   setNoActions(100);
end;

procedure TItigProgressKnown.SetPhases(noPhases: integer);
begin
   ivIsPhased := true;
   ivPhases := noPhases;
   ivCurrentPhase := 1;
end;

procedure TItigProgressKnown.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
   CanClose := ivCanClose;
end;

procedure TItigProgressKnown.FormCreate(Sender: TObject);
var
   ResName : String;
   hInst : HMODULE;
begin
   try
      with Owner as TAutoUpdate do
      begin
         ResName := ResourceName;

         if Length(ResName) > 0 then
         begin
            // get the instance of the app we are upgrading....
            if Length(ResourceImage) > 0 then
            begin
               hInst := LoadLibraryEx(PChar(ResourceImage), 0, LOAD_LIBRARY_AS_DATAFILE);
               try
                  Image1.Picture.Bitmap.LoadFromResourceName(hInst, ResName);
               finally
                  FreeLibrary(hInst);
               end;
            end
            else
            begin
               Image1.Picture.Bitmap.LoadFromResourceName(hInstance, ResName);
            end;
         end;
      end;
   except
   end;

   ivIsPhased := false;
   ivCanClose := True;
   ivAutoClose := true;
   ThreadWorking := False;
   ivPhases := 0;
end;

procedure TItigProgressKnown.cmdActClick(Sender: TObject);
begin
   cmdAct.Enabled := false;
   ivCancelled := true;
   ivInfo.Debug('Cancel' );
end;

function TItigProgressKnown.IsCancelled: Boolean;
begin
   Result := ivCancelled;
end;


end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -