SHARE
TWEET

Form Utama Updater

maskofa Apr 22nd, 2019 91 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit ufrmUtama;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls, Vcl.ExtActns;
  8.  
  9. type
  10.   TfrmUtama = class(TForm)
  11.     Label1: TLabel;
  12.     Label2: TLabel;
  13.     Label3: TLabel;
  14.     edSource: TEdit;
  15.     edTarget: TEdit;
  16.     ProgressBar1: TProgressBar;
  17.     edUpdate: TButton;
  18.     sb: TStatusBar;
  19.     procedure FormDestroy(Sender: TObject);
  20.     procedure edUpdateClick(Sender: TObject);
  21.     procedure FormCreate(Sender: TObject);
  22.     procedure FormResize(Sender: TObject);
  23.     procedure URL_OnDownloadProgress (Sender: TDownLoadURL;
  24.               Progress, ProgressMax: Cardinal;
  25.               StatusCode: TURLDownloadStatus;
  26.               StatusText: String; var Cancel: Boolean) ;
  27.   private
  28.     procedure DoDownload;
  29.     function StatusCodeToStr(AStatus: TURLDownloadStatus): String;
  30.   public
  31.     { Public declarations }
  32.   end;
  33.  
  34. var
  35.   frmUtama: TfrmUtama;
  36.  
  37. implementation
  38.  
  39. {$R *.dfm}
  40.  
  41. uses
  42.   WinAPI.ShellAPI, System.UITypes;
  43.  
  44. var
  45.   cWidth, cHeight: Integer;
  46.   Complete: Boolean;
  47.  
  48. function ProgramVersion(sFileName:string): string;
  49. var
  50.   VerInfoSize: DWORD;
  51.   VerInfo: Pointer;
  52.   VerValueSize: DWORD;
  53.   VerValue: PVSFixedFileInfo;
  54.   Dummy: DWORD;
  55. begin
  56.   VerInfoSize := GetFileVersionInfoSize(PChar(sFileName), Dummy);
  57.   GetMem(VerInfo, VerInfoSize);
  58.   GetFileVersionInfo(PChar(sFileName), 0, VerInfoSize, VerInfo);
  59.   VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
  60.   with VerValue^ do
  61.   begin
  62.     Result := IntToStr(dwFileVersionMS shr 16);
  63.     Result := Result + '.' + IntToStr(dwFileVersionMS and $FFFF);
  64.     Result := Result + '.' + IntToStr(dwFileVersionLS shr 16);
  65.     Result := Result + '.' + IntToStr(dwFileVersionLS and $FFFF);
  66.   end;
  67.   FreeMem(VerInfo, VerInfoSize);
  68. end;
  69.  
  70. procedure TfrmUtama.URL_OnDownloadProgress (Sender: TDownLoadURL;
  71.                      Progress, ProgressMax: Cardinal;
  72.                      StatusCode: TURLDownloadStatus;
  73.                      StatusText: String; var Cancel: Boolean);
  74. begin
  75.    ProgressBar1.Max      := ProgressMax;
  76.    ProgressBar1.Position := Progress;
  77.  
  78.    if ProgressMax > 0 then
  79.    Label3.Caption    := format('Progress %.2n%s',
  80.                               [Progress / ProgressMax * 100, '%']);
  81.    sb.Panels[0].Text := 'Status : ' + StatusCodeToStr(StatusCode);
  82.    Application.ProcessMessages;
  83.  
  84.    if StatusCode = dsEndDownloadData then
  85.    begin
  86.      MessageDlg('Update Aplikasi Selesai', mtInformation, [mbOK], 0);
  87.      Complete := true;
  88.      Close;
  89.    end;
  90. end;
  91.  
  92. procedure TfrmUtama.FormDestroy(Sender: TObject);
  93. begin
  94.   if Complete then
  95.   begin
  96.     if FileExists(paramstr(2)) then
  97.     ShellExecute(0, 'Open', PChar(paramstr(2)), '', '', SW_SHOWNORMAL);
  98.   end;
  99. end;
  100.  
  101. procedure TfrmUtama.edUpdateClick(Sender: TObject);
  102. begin
  103.   if FileExists(paramstr(2) + '.bak') then
  104.   DeleteFile(PChar(paramstr(2) + '.bak'));
  105.  
  106.   RenameFile(paramstr(2), paramstr(2) + '.bak');
  107.   DoDownload;
  108. end;
  109.  
  110. procedure TfrmUtama.FormCreate(Sender: TObject);
  111. var
  112.   source: String;
  113.   target: String;
  114. begin
  115.   Caption := 'Updater v.' + ProgramVersion(paramstr(0));
  116.  
  117.   source := Paramstr(1);
  118.   target := Paramstr(2);
  119.  
  120.   if (source = '') or (target = '') then
  121.   begin
  122.     MessageDlg('Error !!!'#13#10'File Sumber atau File target tidak ditemukan',
  123.                mtError, [mbOK], 0);
  124.     Application.Terminate;
  125.   end;
  126.  
  127.   edSource.Text  := source;
  128.   edTarget.Text  := target;
  129.   DoubleBuffered := true;
  130.  
  131.   cWidth   := Width;
  132.   cHeight  := Height;
  133.   Complete := false;
  134. end;
  135.  
  136. procedure TfrmUtama.FormResize(Sender: TObject);
  137. begin
  138.   Width  := cWidth;
  139.   Height := cHeight;
  140. end;
  141.  
  142. procedure TfrmUtama.DoDownload;
  143. begin
  144.    with TDownloadURL.Create(Self) do
  145.    try
  146.      URL      := paramstr(1);
  147.      FileName := paramstr(2);
  148.      OnDownloadProgress := URL_OnDownloadProgress;
  149.  
  150.      ExecuteTarget(nil) ;
  151.    finally
  152.      Free;
  153.    end;
  154. end;
  155.  
  156. function TfrmUtama.StatusCodeToStr(AStatus: TURLDownloadStatus): String;
  157. begin
  158.   case AStatus of
  159.     dsFindingResource           : result := 'Finding Resource';
  160.     dsConnecting                : result := 'Connecting';
  161.     dsRedirecting               : result := 'Redirecting';
  162.     dsBeginDownloadData         : result := 'Begin Download Data';
  163.     dsDownloadingData           : result := 'Downloading Data';
  164.     dsEndDownloadData           : result := 'End Download Data';
  165.     dsBeginDownloadComponents   : result := 'Begin Download Components';
  166.     dsInstallingComponents      : result := 'Installing Components';
  167.     dsEndDownloadComponents     : result := 'End Download Components';
  168.     dsUsingCachedCopy           : result := 'Using Cached Copy';
  169.     dsSendingRequest            : result := 'Sending Request';
  170.     dsClassIDAvailable          : result := 'Class ID Available';
  171.     dsMIMETypeAvailable         : result := 'MIME Type Available';
  172.     dsCacheFileNameAvailable    : result := 'Cache File Name Available';
  173.     dsBeginSyncOperation        : result := 'Begin Sync Operation';
  174.     dsEndSyncOperation          : result := 'End Sync Operation';
  175.     dsBeginUploadData           : result := 'Begin Upload Data';
  176.     dsUploadingData             : result := 'Uploading Data';
  177.     dsEndUploadData             : result := 'End Upload Data';
  178.     dsProtocolClassID           : result := 'Protocol Class ID';
  179.     dsEncoding                  : result := 'Encoding';
  180.     dsVerifiedMIMETypeAvailable : result := 'Verified MIME Type Available';
  181.     dsClassInstallLocation      : result := 'Class Install Location';
  182.     dsDecoding                  : result := 'Decoding';
  183.     dsLoadingMIMEHandler        : result := 'Loading MIME Handler';
  184.     dsContentDispositionAttach  : result := 'Content Disposition Attach';
  185.     dsFilterReportMIMEType      : result := 'Filter Report MIME Type';
  186.     dsCLSIDCanInstantiate       : result := 'CLSID Can Instantiate';
  187.     dsIUnKnownAvailable         : result := 'IUnKnown Available';
  188.     dsDirectBind                : result := 'Direct Bind';
  189.     dsRawMIMEType               : result := 'Raw MIME Type';
  190.     dsProxyDetecting            : result := 'Proxy Detecting';
  191.     dsAcceptRanges              : result := 'Accept Ranges';
  192.     dsCookieSent                : result := 'Cookie Sent';
  193.     dsCompactPolicyReceived     : result := 'Compact Policy Received';
  194.     dsCookieSuppressed          : result := 'Cookie Suppressed';
  195.     dsCookieStateUnknown        : result := 'Cookie State Unknown';
  196.     dsCookieStateAccept         : result := 'Cookie State Accept';
  197.     dsCookeStateReject          : result := 'Cooke State Reject';
  198.     dsCookieStatePrompt         : result := 'Cookie State Prompt';
  199.     dsCookieStateLeash          : result := 'Cookie State Leash';
  200.     dsCookieStateDowngrade      : result := 'Cookie State Downgrade';
  201.     dsPolicyHREF                : result := 'Policy HREF';
  202.     dsP3PHeader                 : result := 'P3P Header';
  203.     dsSessionCookieReceived     : result := 'Session Cookie Received';
  204.     dsPersistentCookieReceived  : result := 'Persistent Cookie Received';
  205.     dsSessionCookiesAllowed     : result := 'Session Cookies Allowed';
  206.   end;
  207. end;
  208.  
  209.  
  210. end.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top