upgrademainform.pas

一个简单的升级代理程序

unit UpgradeMainForm;

interface

uses
  Windows,Forms,SysUtils,StdCtrls, ExtCtrls,ShellApi,Classes,tlhelp32,
  Controls;

type
  TfrmMainUpgrade = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    Timer1  : TTimer;
    ProcList: TStringList;
    FexePath,
    FexeName,
    FtmpName : String;
    procedure Timer1Timer(Sender: TObject);
    procedure UpdateTree(var CurPath: String);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMainUpgrade: TfrmMainUpgrade;

implementation

{$R *.dfm}
procedure TfrmMainUpgrade.FormCreate(Sender: TObject);
begin
  ProcList := TStringList.Create;
  FexeName  := ParamStr(1);
  FexePath  := ExtractFilePath(FexeName);
  FtmpName  := UpperCase(ExtractFileName(FexeName));
  
  Timer1 := TTimer.Create(nil);
  Timer1.OnTimer := Timer1Timer;
  Timer1.Interval:= 1000;
  Timer1.Enabled := True;
end;

procedure TfrmMainUpgrade.FormDestroy(Sender: TObject);
begin
  ProcList.Free;
  Timer1.Free;
end;

procedure TfrmMainUpgrade.Timer1Timer(Sender: TObject);
var
  IsFind : Boolean;
  PHandle: THandle;
  PStruct: TProcessEntry32; //记录进程的数据结构;
  CurPath: String;
begin
  if FexeName = '' then
  begin
    Timer1.Enabled := False;
    Application.Terminate;
    Exit;
  end;

  { 枚举所有的进程 }
  ProcList.Clear;
  PHandle := CreateToolHelp32SnapShot(Th32CS_SnapProcess,0);
  PStruct.dwSize := SizeOf(PStruct);
  IsFind := Process32First(PHandle,PStruct);
  while IsFind do
  begin
    ProcList.Add(UpperCase(PStruct.szExeFile));
    IsFind := Process32Next(PHandle,PStruct);
  end;

  {
    //用程序的办法终止进程运行,暂不用.
    a : DWORD;
    h : Handle;
    h:=OpenProcess(process_all_access,true,PStruct.proid);
    GetExitCodeProcess(h,a);      //得到进程退出代码;
    TerminateProcess(h,a) ;  //终止进程
  }
  
  { 判断进程是否存在? }
  //前面是Win2000用到的，后面是Win98的进程名.
  if (ProcList.IndexOf(FtmpName)=-1)and(ProcList.IndexOf(UpperCase(FexeName))=-1) then
  begin
    Timer1.Enabled := False;
    ChDir(FexePath);
    CurPath := '';
    UpdateTree(CurPath);
    ShellExecute(0,'open',pchar(FexeName),nil,nil,SW_SHOW);
    Application.Terminate;
  end;
end;

procedure TfrmMainUpgrade.UpdateTree(var CurPath: String);
var
  Sr    : TSearchRec;
  Err   : Integer;
  i     : Integer;
  oldFileName,
  newFileName,
  FilePath    : String;
begin
  Err := FindFirst('*.new',$31,Sr);   //$31为除Volumn ID,Hidden,System Files外的所有文件
  //  如果找到文件
  while (Err = 0) do
  begin
    Application.ProcessMessages;
    if Sr.Name[1] <> '.' then
    begin
      if (Sr.Attr and faDirectory) = 0 then
      begin
        //找到a.exe.new,如果存在a.exe就删除它
        oldFileName := Sr.Name;
        delete(oldFileName,Pos('.new',oldFileName),Length('.new'));
        oldFileName := FexePath + CurPath + oldFileName;
        if FileExists(oldFileName) then DeleteFile(oldFileName);

        //再将a.exe.new改为a.exe
        oldFileName := FexePath + CurPath + Sr.Name;
        newFileName := Sr.Name;
        delete(newFileName,Pos('.new',newFileName),Length('.new'));
        ReNameFile(oldFileName,newFileName);
      end;
      //找到子目录
      if (Sr.Attr and faDirectory) = 16 then
      begin
        FilePath := ExpandFileName(Sr.Name);
        CurPath := CurPath  + Sr.Name + '\';
        ChDir(Sr.Name);
        UpdateTree(CurPath);
        ChDir('..');
        //将最后的目录减掉
        Delete(CurPath,Length(CurPath),1);
        for i := Length(CurPath) downto 1 do
           if CurPath[i]='\' then break;
        CurPath := Copy(CurPath,1,i);
      end;
    end;
    //结束递归
    Err := FindNext(Sr);
  end;
end;

end.