Form Utama Updater

unit ufrmUtama;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls, Vcl.ExtActns;

type
  TfrmUtama = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    edSource: TEdit;
    edTarget: TEdit;
    ProgressBar1: TProgressBar;
    edUpdate: TButton;
    sb: TStatusBar;
    procedure FormDestroy(Sender: TObject);
    procedure edUpdateClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure URL_OnDownloadProgress (Sender: TDownLoadURL;
              Progress, ProgressMax: Cardinal;
              StatusCode: TURLDownloadStatus;
              StatusText: String; var Cancel: Boolean) ;
  private
    procedure DoDownload;
    function StatusCodeToStr(AStatus: TURLDownloadStatus): String;
  public
    { Public declarations }
  end;

var
  frmUtama: TfrmUtama;

implementation

{$R *.dfm}

uses
  WinAPI.ShellAPI, System.UITypes;

var
  cWidth, cHeight: Integer;
  Complete: Boolean;

function ProgramVersion(sFileName:string): string;
var
  VerInfoSize: DWORD;
  VerInfo: Pointer;
  VerValueSize: DWORD;
  VerValue: PVSFixedFileInfo;
  Dummy: DWORD;
begin
  VerInfoSize := GetFileVersionInfoSize(PChar(sFileName), Dummy);
  GetMem(VerInfo, VerInfoSize);
  GetFileVersionInfo(PChar(sFileName), 0, VerInfoSize, VerInfo);
  VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
  with VerValue^ do
  begin
    Result := IntToStr(dwFileVersionMS shr 16);
    Result := Result + '.' + IntToStr(dwFileVersionMS and $FFFF);
    Result := Result + '.' + IntToStr(dwFileVersionLS shr 16);
    Result := Result + '.' + IntToStr(dwFileVersionLS and $FFFF);
  end;
  FreeMem(VerInfo, VerInfoSize);
end;

procedure TfrmUtama.URL_OnDownloadProgress (Sender: TDownLoadURL;
                     Progress, ProgressMax: Cardinal;
                     StatusCode: TURLDownloadStatus;
                     StatusText: String; var Cancel: Boolean);
begin
   ProgressBar1.Max      := ProgressMax;
   ProgressBar1.Position := Progress;

   if ProgressMax > 0 then
   Label3.Caption    := format('Progress %.2n%s',
                              [Progress / ProgressMax * 100, '%']);
   sb.Panels[0].Text := 'Status : ' + StatusCodeToStr(StatusCode);
   Application.ProcessMessages;

   if StatusCode = dsEndDownloadData then
   begin
     MessageDlg('Update Aplikasi Selesai', mtInformation, [mbOK], 0);
     Complete := true;
     Close;
   end;
end;

procedure TfrmUtama.FormDestroy(Sender: TObject);
begin
  if Complete then
  begin
    if FileExists(paramstr(2)) then
    ShellExecute(0, 'Open', PChar(paramstr(2)), '', '', SW_SHOWNORMAL);
  end;
end;

procedure TfrmUtama.edUpdateClick(Sender: TObject);
begin
  if FileExists(paramstr(2) + '.bak') then
  DeleteFile(PChar(paramstr(2) + '.bak'));

  RenameFile(paramstr(2), paramstr(2) + '.bak');
  DoDownload;
end;

procedure TfrmUtama.FormCreate(Sender: TObject);
var
  source: String;
  target: String;
begin
  Caption := 'Updater v.' + ProgramVersion(paramstr(0));

  source := Paramstr(1);
  target := Paramstr(2);

  if (source = '') or (target = '') then
  begin
    MessageDlg('Error !!!'#13#10'File Sumber atau File target tidak ditemukan',
               mtError, [mbOK], 0);
    Application.Terminate;
  end;

  edSource.Text  := source;
  edTarget.Text  := target;
  DoubleBuffered := true;

  cWidth   := Width;
  cHeight  := Height;
  Complete := false;
end;

procedure TfrmUtama.FormResize(Sender: TObject);
begin
  Width  := cWidth;
  Height := cHeight;
end;

procedure TfrmUtama.DoDownload;
begin
   with TDownloadURL.Create(Self) do
   try
     URL      := paramstr(1);
     FileName := paramstr(2);
     OnDownloadProgress := URL_OnDownloadProgress;

     ExecuteTarget(nil) ;
   finally
     Free;
   end;
end;

function TfrmUtama.StatusCodeToStr(AStatus: TURLDownloadStatus): String;
begin
  case AStatus of
    dsFindingResource           : result := 'Finding Resource';
    dsConnecting                : result := 'Connecting';
    dsRedirecting               : result := 'Redirecting';
    dsBeginDownloadData         : result := 'Begin Download Data';
    dsDownloadingData           : result := 'Downloading Data';
    dsEndDownloadData           : result := 'End Download Data';
    dsBeginDownloadComponents   : result := 'Begin Download Components';
    dsInstallingComponents      : result := 'Installing Components';
    dsEndDownloadComponents     : result := 'End Download Components';
    dsUsingCachedCopy           : result := 'Using Cached Copy';
    dsSendingRequest            : result := 'Sending Request';
    dsClassIDAvailable          : result := 'Class ID Available';
    dsMIMETypeAvailable         : result := 'MIME Type Available';
    dsCacheFileNameAvailable    : result := 'Cache File Name Available';
    dsBeginSyncOperation        : result := 'Begin Sync Operation';
    dsEndSyncOperation          : result := 'End Sync Operation';
    dsBeginUploadData           : result := 'Begin Upload Data';
    dsUploadingData             : result := 'Uploading Data';
    dsEndUploadData             : result := 'End Upload Data';
    dsProtocolClassID           : result := 'Protocol Class ID';
    dsEncoding                  : result := 'Encoding';
    dsVerifiedMIMETypeAvailable : result := 'Verified MIME Type Available';
    dsClassInstallLocation      : result := 'Class Install Location';
    dsDecoding                  : result := 'Decoding';
    dsLoadingMIMEHandler        : result := 'Loading MIME Handler';
    dsContentDispositionAttach  : result := 'Content Disposition Attach';
    dsFilterReportMIMEType      : result := 'Filter Report MIME Type';
    dsCLSIDCanInstantiate       : result := 'CLSID Can Instantiate';
    dsIUnKnownAvailable         : result := 'IUnKnown Available';
    dsDirectBind                : result := 'Direct Bind';
    dsRawMIMEType               : result := 'Raw MIME Type';
    dsProxyDetecting            : result := 'Proxy Detecting';
    dsAcceptRanges              : result := 'Accept Ranges';
    dsCookieSent                : result := 'Cookie Sent';
    dsCompactPolicyReceived     : result := 'Compact Policy Received';
    dsCookieSuppressed          : result := 'Cookie Suppressed';
    dsCookieStateUnknown        : result := 'Cookie State Unknown';
    dsCookieStateAccept         : result := 'Cookie State Accept';
    dsCookeStateReject          : result := 'Cooke State Reject';
    dsCookieStatePrompt         : result := 'Cookie State Prompt';
    dsCookieStateLeash          : result := 'Cookie State Leash';
    dsCookieStateDowngrade      : result := 'Cookie State Downgrade';
    dsPolicyHREF                : result := 'Policy HREF';
    dsP3PHeader                 : result := 'P3P Header';
    dsSessionCookieReceived     : result := 'Session Cookie Received';
    dsPersistentCookieReceived  : result := 'Persistent Cookie Received';
    dsSessionCookiesAllowed     : result := 'Session Cookies Allowed';
  end;
end;


end.