rsupgrade.pas

清理工具PS2键盘驱动程序

unit rsupgrade;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, TommHttpGet, IniFiles;

const const_upgradeurl = 'http://www.tommsoft.com/products/rscleaner/upgrade/rsup.asp?id=11';
      const_downlist: array[0..1] of string = ('rsclean.dll','rsdefine.dll');

type
  TForm_Upgrade = class(TForm)
    Btn_Check: TButton;
    ProgressBar1: TProgressBar;
    Label1: TLabel;
    Btn_Start: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Btn_CheckClick(Sender: TObject);
    procedure Btn_StartClick(Sender: TObject);
  private
    FDownloader: TTommHTTPGet;
    FEngineVer: string;
    FFileList: TStrings;
    FCurFile: byte;
    procedure MyOnProgress(Sender:TObject;FileName,url:string;
      FileTotalSize,FileReadedSize:integer);
    procedure MyOnDoneFile(Sender: TObject; FileName,url: String;
      FileSize: Integer;DownloadResult:boolean;aTotalFileCount,aDoneFileCount:integer);
    procedure MyOnError(Sender:TObject;FileName,url:string;
      ErrorMessage:TTommHttpGetErrorMessage);
    procedure ParseUpgradeInfo;
    procedure DoDownloadFile;
  public
    class function ShowUpgradeDialog(const s: string): boolean;
  end;

implementation

{$R *.dfm}

{ TForm_Upgrade }

function GetTmpPath: string;
var TempPath: array[0..255] of char;
begin
  ZeroMemory(@TempPath, sizeof(TempPath));
  GetTempPath(255, TempPath);
  Result := TempPath;
end;

function GetFileVersion(fn: string; var ma, mi, r ,b: integer; var VerStr: string):boolean;
var
  buf, p: pChar;
  sver: ^VS_FIXEDFILEINFO ;
  i: LongWord;
begin
  i:= GetFileVersionInfoSize(pchar(fn), i);
  new(sver);
  p:= pchar(sver);
  GetMem(buf, i);
  ZeroMemory(buf, i);
  result:= false;
  if GetFileVersionInfo(pchar(fn), 0, 4096, pointer(buf)) then
    if VerQueryValue(buf, '\', pointer(sver), i) then begin
      ma:= sVer^.dwFileVersionMS shr 16;
      mi:= sver^.dwFileVersionMS and $0000ffff;
      r:= sver^.dwFileVersionLS shr 16;
      b:= sver^.dwFileVersionLS and $0000ffff;
      result:= true;
    end;
  Dispose(p);
  FreeMem(buf);
  VerStr := Format('V%d.%d%d Build %.3d',[ma,mi,r,b]);
end;


function GetUrlFileName(const Url:string): string;
var Tempurl: string;
begin
  Result:= '';
  TempUrl:= Url;
  if TempUrl='' then exit;
  if (TempUrl[Length(TempUrl)]='/') or (TempUrl[Length(TempUrl)]='\') then exit;
  While (TempUrl[length(TempUrl)]<>'/') and (TempUrl[length(TempUrl)]<>'\') do begin
     Result:= copy(TempUrl,Length(TempUrl),1)+ Result;
     Delete(TempUrl,length(TempUrl),1);
     if TempUrl='' then break;
  end;
end;


class function TForm_Upgrade.ShowUpgradeDialog(const s: string): boolean;
var F: TForm_Upgrade;
begin
  F := TForm_Upgrade.Create(nil);
  F.FEngineVer := s;
  F.ShowModal;
end;

procedure TForm_Upgrade.FormCreate(Sender: TObject);
begin
  FDownloader := TTommHTTPGet.Create(nil);
  FDownloader.OnFileProgress := MyOnProgress;
  FDownloader.OnFileDone := MyOnDoneFile;
  FDownloader.OnFileDownloadError := MyOnError;
  FFileList := TStringList.Create;
  FCurFile := 0;
end;

procedure TForm_Upgrade.FormDestroy(Sender: TObject);
begin
  FDownloader.Free;
  FFileList.Free;
end;

procedure TForm_Upgrade.Btn_CheckClick(Sender: TObject);
begin
  FDownloader.Agent := 'RogueCleaner Client';
  FDownloader.UrlList.Add(const_upgradeurl);
  FDownloader.FileNameList.Add(GetTmpPath + 'rstmp.txt');
  FDownloader.BeginDownLoad;
  Label1.Caption := 'Checking for new version...';
end;

procedure TForm_Upgrade.MyOnDoneFile(Sender: TObject; FileName,url: String; FileSize: Integer;DownloadResult:boolean;aTotalFileCount,aDoneFileCount:integer);
begin
  if ExtractFileName(FileName) = 'rstmp.txt' then begin
    ParseUpgradeInfo;
  end;
end;

procedure TForm_Upgrade.MyOnProgress(Sender:TObject;FileName,url:string;
FileTotalSize,FileReadedSize:integer);
begin
  if FileTotalSize > 0 then ProgressBar1.Position := 100 * FileReadedSize div FileTotalSize;
  Label1.Caption := Format('Downloading %s, progress %d%%', [ExtractFileName(FileName), ProgressBar1.Position]);
end;

procedure TForm_Upgrade.MyOnError(Sender:TObject;FileName,url:string;ErrorMessage:TTommHttpGetErrorMessage);
begin
  Showmessage('Error');
end;

procedure TForm_Upgrade.ParseUpgradeInfo;
var i: integer;
    Ini: TIniFile;
    NewV, OldV, FileName: string;
    ma,mi,r,b: integer;
begin
  FFileList.Clear;
  Ini := TIniFile.Create(GetTmpPath + 'rstmp.txt');
  for i:= 0 to High(const_downlist) do begin
    NewV := Ini.ReadString(const_downlist[i], 'Version', '');
    FileName := Ini.ReadString(const_downlist[i], 'FileName', '');
    if const_downlist[i]='rsdefine.dll' then begin
      OldV := FEngineVer;
    end else begin
      GetFileVersion(ExtractFilePath(Application.ExeName)+const_downlist[i], ma, mi, r,b, OldV);
    end;
    if NewV > OldV then begin
      Btn_Start.Enabled := True;
      FFileList.Add(FileName);
    end;
  end;
  if FFileList.Count > 0 then begin
    Application.MessageBox('已经有了升级的版本!', '信息', MB_OK+MB_ICONINFORMATION);
  end else begin
    Application.MessageBox('您现在使用的已经是最新版本!', '信息', MB_OK+MB_ICONINFORMATION);
  end;
  //
end;


procedure TForm_Upgrade.DoDownloadFile;
var i: integer;
begin
  for i:= 0 to FFileList.Count - 1 do begin
    FDownloader.UrlList.Add(FFileList[i]);
    FDownloader.FileNameList.Add(GetTmpPath + GetUrlFileName(FFileList[i]));
  end;
  FDownloader.BeginDownLoad;
end;

procedure TForm_Upgrade.Btn_StartClick(Sender: TObject);
begin
  ProgressBar1.Position := 0;
  DoDownloadFile;
end;

end.