delphi4arab منتديات دلفي للعرب

السلام عليكم إخوني كرام Heart

بعد بيع برنامجي للزبون كيف أعمل له تحديث أوتوماتيكي؟ دون أن يأتي الزبون و اعطه نسخة جديدة
حيث يكون تحميل النسخة الجديدة من mediafire.com
و أيضا كيف تنبه الزبون بأنه يوجد تحديث جديد مع mtconfermation mbyes mbno

http://delphi4arab.net/forum/showthread.php?tid=1897

أخي شكرا لك على المشاركة و لكن لم أفهم كيفية تطبيقها على برنامج
و كما قلت هل ممكن أن يحمل التحديث من mediafire الخاص بي

السلام عليكم
رابط الموضوع الذي طرحه أخي عبد العزيز كافي و وافي لسؤالك
---------------
أنا لست مع إستعمال موقع كـ mediafire
يجب أن يتوفر عندك سرفر خاص (موقع خاص) أو مساحة خاصة لتكون فيها تحديثات.....و..
ميكانكية العمل ستكون مبنية بنفس الطريقة التي في الموضوع السابق
ملف يكون به معلومات النسخة الأخيرة
يتم تحقق منها دوريا مثلا عند كل تنفيذ للبرنامج ومقارنة معلومات الملف مع النسخة المستعملة
في حالة عدم تحقق المقارنة ستعمل المستخدم بأنه يوجد نسخة أحدث

شكرا لك أخي Agmcz و لكن ليس هكذا يكون فهم الدرس

أريد أن أعرف من هم الكونات الذي نستعملهم و كيف نستعملهم بالتفصيل من تلك المحتوى فهمت إلى الطرق الذي أسير فيها ولا يشرح الدرس باتفاصيل

بإمكانك إستعمال مكونات Indy (موجودة مع دلفي)
هذا مثال للتحقق فقط من وجود نسخة جديدة إستعملت فقط مكون IdHTTP
في المرفقات تجد سورس بسيط مع ملف نصي
تعديل الملف النصي يتم بإستعمال إحدى محررات Hex لأن دالة التحقق تتعامل مع كل بايتات الملف

PHP كود :
uses
  IdHTTP;

type
  TVer = packed record
    Sign: array[0..3] of Char;
    Ver: Word;
  end;

function CheckVer(const URL: string; Ver: TVer): Integer;
var
  HTTP: TIdHTTP;
  Stm: TMemoryStream;
  VerStm: TVer;
begin
  Result  := 0;
  HTTP := TIdHTTP.Create(nil);
  Stm := TMemoryStream.Create;
  try
    HTTP.HandleRedirects := True;
    HTTP.ConnectTimeout := 15000; // 15sec
    HTTP.ReadTimeout := 15000;    // 15sec
    try
      HTTP.Get(URL, Stm);
      Result := Integer(CompareMem(@Ver, Stm.Memory, SizeOf(TVer)));
    except
      // Error!
      Result := -1;
    end;
  finally
    HTTP.Free;
    Stm.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  CurVer: TVer;
  iResult: Integer;
begin
  StrPCopy(CurVer.Sign, 'Ver:'); // Buffer Signature
  CurVer.Ver := 01;              // Current Version
  iResult := CheckVer('http://www.example.net/updater.txt', CurVer);
  case iResult of
    -1: MessageBox(Handle, 'Error!', 'Up', MB_ICONWARNING);
    0: MessageBox(Handle, 'New version is available', 'Up', MB_ICONASTERISK);
  end;
end; 

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

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. 

شكرا أخي Agmcz و onexite على شرح المبسط ومفهوم جدا

merzoug2020

محمد عبد العزيز

merzoug2020

Agmcz

merzoug2020

Agmcz

onexite

merzoug2020