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.
السلام عليكم إخوني كرام 
كيف عمل تحديث أوتوماتيكي لبرنامج المكتوب بدلفي
