unit1.~pas

实现自制的程序的自动升级

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Httpget,Inifiles, SHELLAPI,
  Dialogs, StdCtrls, ComCtrls, TrayIcon, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    b1: TButton;
    Edit2: TEdit;
    pb: TProgressBar;
    b2: TButton;
    b3: TButton;
    TrayIcon1: TTrayIcon;
    procedure b1Click(Sender: TObject);
    procedure b2Click(Sender: TObject);
    procedure b3Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure pbMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    hg:thttpget;
    downurl,savefilename:string;
  public
     procedure onp(Sender: TObject; TotalSize, Readed: Integer);
     procedure ond(Sender: TObject; FileName: string; FileSize:
    Integer);
    function readate():tdatetime;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function TForm1.readate():tdatetime;
var
  SysIni:TInifile;
  sPath:String;
begin
   sPath := ExtractFilePath(Application.ExeName)+'sys.ini';
   If not FileExists(sPath) then
    begin
     Application.Terminate;
    end;
  try
   SysIni := TIniFile.Create(sPath);
   result:=strtodate(SysIni.ReadString('Option','str20','2007-07-01'));
  finally
    SysIni.free;
   end;
end;

procedure TForm1.b1Click(Sender: TObject);
begin
hg:=thttpget.Create(self);
hg.BinaryData:=true;
hg.UseCache:=false;
hg.FileName:=edit2.Text;
hg.URL:=edit1.Text;
hg.OnProgress:=onp;
hg.OnDoneFile:=ond;
hg.GetFile;
end;

procedure TForm1.ond(Sender: TObject; FileName: string; FileSize: Integer);
var hwnd:integer;
begin
pb.Position:=0;

hwnd:=findwindow(nil,'信通软件');
if hwnd>0 then
begin
SendMessage(hwnd,WM_CLOSE,0,0);
end;

if FileExists(savefilename+'.ini') then  DeleteFile(savefilename+'.ini');
ShellExecute(handle,'open',pchar(savefilename),nil,nil,SW_ShowNormal);
close;
end;

procedure TForm1.onp(Sender: TObject; TotalSize, Readed: Integer);
begin
  pb.Max:=totalsize;
  pb.Position:=readed;
end;

procedure TForm1.b2Click(Sender: TObject);
begin
hg.Abort;
end;

procedure TForm1.b3Click(Sender: TObject);
begin
hg.getfile;
end;

procedure TForm1.FormActivate(Sender: TObject);
var
  temhttp: TIdHTTP;
   supdate, dupdate: TDateTime; //本机升级日期，升级包更新日期
begin
TrayIcon1.Minimize;

 downurl:=trim(edit1.Text);

  try
  temhttp := TIdHTTP.Create(nil);
  temhttp.ReadTimeout:=5000;
 showmessage( inttostr(temhttp.Response.ResponseCode));
    try
    temhttp.Head(downurl);
    except
     temhttp.Free;
     close;
    end;
   dupdate := temhttp.Response.LastModified;

  finally
  temhttp.Free;
  end;

  edit2.Text:=trim(datetostr(dupdate)+'.exe');
  savefilename:=trim(edit2.Text);
  supdate :=readate();

  if dupdate > supdate then
  begin
     if FileExists(savefilename) then
     DeleteFile(savefilename);
     b1.Click;
  end
  else
  begin
    close;
  end;
end;

procedure TForm1.pbMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
pb.Hint:=inttostr(pb.Position*100 div pb.Max)+'%'
end;

end.