كيف عمل تحديث أوتوماتيكي لبرنامج المكتوب بدلفي

[onexite]

من برنامج لا تنسى صلاتك

PHP كود :

unit updateUnit;

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.Buttons, Vcl.SuperObject, IdBaseComponent, IdComponent, 
  IdTCPConnection, IdTCPClient, IdHTTP, Functions;


Type TTestThread = Class(TThread)
private
{ Private declarations }
idhttp1: Tidhttp;
FConnected: Boolean;
FFileList : TStringList;
public
{ Public declarations }
WorkCountMax: Integer;
WorkCount : Integer;
constructor Create(CreateSuspended: Boolean);
destructor Destroy; override;
function _Download(site:string):Boolean;
    function GetNewVersion(site:string): Boolean;
procedure IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Int64);
    Procedure IdHTTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
   procedure IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Int64);
  procedure IdHTTP1Abort(aSender: TObject; anError : integer);
   procedure Execute; override;

Property FileList : TStringList read FFileList write FFileList;
Property Connected: Boolean read FConnected write FConnected;
end;

type
  TUpdateForm = class(TForm)
    btn1: TBitBtn;
    pb1: TProgressBar;
    btn2: TBitBtn;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    lbl1: TLabel;
    mmo1: TMemo;
    lbl2: TLabel;
    cbb1: TComboBox;
    CheckBox1: TCheckBox;
    procedure btn1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
      NewThread: TTestThread;

  // function findlink(str:tstringlist):string;
    procedure UpdateCaption();

  end;

var
  UpdateForm: TUpdateForm;
  _Size :Int64;
  vers,_date:string;
  updatepath:string='salat.zip';
  _apptitle: string='لا تنس صلاتك';
  _start:Boolean=False;
implementation

{$R *.dfm}
 function FormatByteSize(const bytes: Longint): string;
 const
   B = 1; //byte
   KB = 1024 * B; //kilobyte
   MB = 1024 * KB; //megabyte
   GB = 1024 * MB; //gigabyte
 begin
   if bytes > GB then result := FormatFloat('#.## جيجابايت', bytes / GB)
   else if bytes > MB then result := FormatFloat('#.## ميجابايت', bytes / MB)
   else if bytes > KB then result := FormatFloat('#.## كيلوبايت', bytes / KB)
   else result := FormatFloat('#.## بايت', bytes) ;
 end;

function cdir():string;
 begin
   Result:=ExtractFilePath(Application.ExeName) ;
 end;

procedure TUpdateForm.btn1Click(Sender: TObject);

begin
mmo1.Clear;
mmo1.Lines.Add('الاصدار الحالي : '+__version) ;

  if  btn1.Caption='الغاء' then begin
  lbl1.Caption:='معلومات : ';
     btn1.Caption:='بحث';
     NewThread.idhttp1.Disconnect;
     Exit;
  end;

NewThread:=TTestThread.Create(True);
NewThread.Resume;

end;

procedure TUpdateForm.btn2Click(Sender: TObject);
begin
if NewThread.IdHTTP1.Connected then
NewThread.IdHTTP1.Disconnect;
Application.Terminate;
end;

procedure TUpdateForm.CheckBox1Click(Sender: TObject);
begin
save_ini('Update',IntToStr(Integer(CheckBox1.Checked)));
end;

procedure TUpdateForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
OtherFormClose:=True;
Action:=caFree;
end;

procedure TUpdateForm.FormCreate(Sender: TObject);
begin
 cbb1.Clear;
 cbb1.Items.Add(__site);
// cbb1.Items.Add('http://127.0.0.1/Salat_02/');
 cbb1.ItemIndex:=0;
 CheckBox1.Checked:=Boolean(UpdateApp)
end;

procedure TUpdateForm.FormShow(Sender: TObject);
begin
mmo1.Clear;
mmo1.Lines.Add('الاصدار الحالي : '+__version) ;
end;



procedure TUpdateForm.UpdateCaption;
begin
UpdateForm.pb1.Position:=NewThread.WorkCount ;
Application.ProcessMessages;
//UpdateForm.lbl1.Caption:=Format('تم تنزيل %d كيلوبايت من اصل %d كيلوبايت', [NewThread.WorkCount div 1024, NewThread.WorkCountMax div 1024] )+' .....';

UpdateForm.lbl1.Caption:='تم تنزيل '+FormatByteSize(NewThread.WorkCount)+' من اصل ' +FormatByteSize(NewThread.WorkCountMax) + ' .....'
end;



{ TTestThread }

constructor TTestThread.Create(CreateSuspended: Boolean);
begin
inherited;
  idhttp1 := TIdHTTP.Create(nil);
  FConnected:=False;
end;

destructor TTestThread.Destroy;
begin
 idhttp1.Disconnect;
  idhttp1.Free;
  inherited;
end;

procedure TTestThread.Execute;

begin
 _start:=False;
IdHTTP1.OnWork:=IdHTTP1Work;
IdHTTP1.OnWorkBegin:=IdHTTP1WorkBegin;
IdHTTP1.OnWorkEnd:=IdHTTP1WorkEnd;
//idhttp1.OnWorkAbort  := IdHTTP1Abort  ;
UpdateForm.mmo1.Clear;
UpdateForm.mmo1.Lines.Add('الاصدار الحالي : '+__version) ;
 if GetNewVersion(UpdateForm.cbb1.Text) then  begin
 _start:=True;
UpdateForm.btn1.Caption:='الغاء';
UpdateForm.mmo1.Clear;
UpdateForm.mmo1.Lines.Add('نسخة جديدة من البرنامج متاحة للتحميل ') ;
UpdateForm.mmo1.Lines.Add('اسم البرنامج : '+_apptitle) ;
UpdateForm.mmo1.Lines.Add('رقم النسخة : '+vers) ;
UpdateForm.mmo1.Lines.Add('وقت التحديث : '+_date) ;
UpdateForm.lbl1.Caption:='معلومات : جاري التنزيل .....';
_Download(UpdateForm.cbb1.Text);
 end;
  inherited;

end;

function TTestThread.GetNewVersion(site: string): Boolean;
var
Super: ISuperObject;
webquery    : TStringStream;
begin
 Result:=False;
 try
  try

 //$arr = array( 'date'=> $_date, 'name' =>$_nm , 'version' =>$_version , 'day' =>$_day ,'filename' => array('ext' => $_ext , 'name' =>$_name , 'url' => $_url ) );
   WebQuery := TStringStream.Create('', TEncoding.UTF8);
  IdHTTP1.Get(site+'?update',WebQuery);
 Super := SO(WebQuery.DataString);
 WebQuery.Free;
 if Super = nil then Exit;
  vers       :=Super['version'].AsString;
  _date      :=UTF8Encode(Super['day'].AsString+' '+Super['date'].AsString);
  _apptitle  :=UTF8Encode(Super['name'].AsString);
  updatepath :=Super['filename']['path'].AsString;
  except on e:Exception do begin
    UpdateForm.mmo1.Clear;
    UpdateForm.mmo1.Lines.Add('حدث خطأ في الاتصال بالمستضيف !'); //+e.message
    Exit;
    end;
    end;
  if ((vers  = __version) and (vers<>'')) then
   begin
    UpdateForm.mmo1.Lines.Add('لا توجد تحديثات حاليا') ;
    UpdateForm.mmo1.Lines.Add('النسخة المتوفرة على الخادم '+vers) ;
    UpdateForm.mmo1.Lines.Add('اسم البرنامج : '+_apptitle) ;
    UpdateForm.mmo1.Lines.Add('بتاريخ : '+_date) ;
    end else Result:=True;
 finally
   Super:=nil;
 end;
end;

procedure TTestThread.IdHTTP1Abort(aSender: TObject; anError: integer);
begin
IdHTTP1.Disconnect;
end;

procedure TTestThread.IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Int64);
begin
    if AWorkMode <> wmread then Exit;
  WorkCount := AWorkCount;
Synchronize(  UpdateForm.UpdateCaption );
end;

procedure TTestThread.IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Int64);
begin
 if AWorkMode <> wmread then Exit;
//if AWorkCountMax > 1 then
if  _start then
if AWorkCountMax>0 then begin
UpdateForm.mmo1.Lines.Add('الحجم : '+FormatByteSize(AWorkCountMax)) ;
_Size := AWorkCountMax;
 end;
  FConnected:=True;
WorkCountMax:=AWorkCountMax ;
Synchronize(UpdateForm.UpdateCaption);
    UpdateForm.pb1.Max:=AWorkCountMax;
end;

procedure TTestThread.IdHTTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
   UpdateForm.pb1.Position:=0;
 FConnected:=False;
Synchronize( UpdateForm.UpdateCaption);
end;

function TTestThread._Download(site: string): Boolean;
var ms:TMemoryStream;
begin

ms:=TMemoryStream.Create;
try
idhttp1.Get(site+updatepath,ms);
ms.SaveToFile(cdir+'tmp.zip');

if ms.Size  <> _Size then
 UpdateForm.lbl1.Caption:='معلومات : حجم الملف غير كامل ..'
 else
 begin
 UpdateForm.lbl1.Caption:='معلومات : تم انتهاء التنزيل.';
 UpdateForm.btn2.Enabled:=True;

     if FileExists(cdir+'tmp.zip') then
    ShellExecute(Application.MainForm.Handle, 'Open', PWideChar(ExtractFilePath(ParamStr(0))+'tmp.zip'), Nil, Nil, SW_SHOWNORMAL);

 end;
finally
ms.Free;
end;

end;

end.