Componentes.Terceros.jvcl/official/3.36/devtools/InstallerTests/DelphiPkgInstaller/Uninstall/Main.pas

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, DelphiData, ShellAPI;

type
  TFormMain = class(TForm)
    ProgressBar: TProgressBar;
    LblStatus: TLabel;
    BtnUninstall: TButton;
    BtnCancel: TButton;
    procedure BtnCancelClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BtnUninstallClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private-Deklarationen }
    FLog: TStrings;
    FTargetList: TCompileTargetList;
    FTarget: TCompileTarget;
  public
    { Public-Deklarationen }
  end;

var
  FormMain: TFormMain;

implementation

uses
  JvGnugettext;

{$R *.dfm}

var
  Uninstalled: Boolean = False;
  DeleteUninstallerDir: Boolean = False;

procedure TFormMain.BtnCancelClick(Sender: TObject);
begin
  Close;
end;

procedure TFormMain.FormCreate(Sender: TObject);
var
  Filename: string;
  Title: string;
  Version: string;
  i: Integer;
begin
  Filename := ExtractFilePath(ParamStr(0)) + 'install.log';
  if not FileExists(Filename) then
  begin
    Application.ShowMainForm := False;
    MessageDlg(_('No install.log found.'), mtError, [mbOk], 0);
    Application.Terminate;
    Exit;
  end;
  FLog := TStringList.Create;
  try
    FLog.LoadFromFile(Filename);
  except
    Application.ShowMainForm := False;
    Application.HandleException(Self);
    Application.Terminate;
    Exit;
  end;

  Version := Copy(FLog[0], 9, MaxInt);
  Title := Copy(FLog[1], 7, MaxInt);

  FTargetList := TCompileTargetList.Create;
  for i := 0 to FTargetList.Count - 1 do
    if FTargetList[i].Name + ' ' + FTargetList[i].VersionStr = Version then
    begin
      FTarget := FTargetList[i];
      Break;
    end;

  if FTarget = nil then
  begin
    Application.ShowMainForm := False;
    MessageDlg(Format(_('No valid %s installation found.'), [Version]), mtError, [mbOk], 0);
    Application.Terminate;
    Exit;
  end;
  LblStatus.Caption := Format(LblStatus.Caption, [Title]);
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  FTargetList.Free;
  FLog.Free;
end;

procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := BtnCancel.Enabled;
end;

procedure TFormMain.BtnUninstallClick(Sender: TObject);
var
  i: Integer;
  Action, Kind, Filename: string;
  Percentage, NewPercentage: Integer;
  S: string;
  Index: Integer;
  List: TStrings;
begin
  ProgressBar.Max := 100;
  ProgressBar.Position := 0;
  ProgressBar.Visible := True;
  BtnUninstall.Enabled := False;
  BtnCancel.Enabled := False;
  try
    LblStatus.Caption := 'Uninstalling...';
    Percentage := 0;
    for i := FLog.Count - 1 downto 2 do
    begin
      S := FLog[i];
      Action := Copy(S, 1, Pos(':', S) - 1);
      Delete(S, 1, Length(Action) + 1);
      if SameText(Action, 'FileAdd') then
      begin
        Filename := S;
        SetFileAttributes(PChar(Filename), 0);
        DeleteFile(Filename);
      end
      else
      if SameText(Action, 'DirAdd') then
      begin
        Filename := S;
        if not RemoveDir(Filename) then
        begin
          if SameText(Filename, ExtractFileDir(ParamStr(0))) then
            DeleteUninstallerDir := True;
        end;
      end
      else
      if SameText(Action, 'PathListAdd') then
      begin
        Kind := Copy(S, 1, Pos(',', S) - 1);
        Delete(S, 1, Length(Kind) + 1);
        List := nil;
        if SameText(Kind, 'Search') then
          List := FTarget.SearchPaths
        else if SameText(Kind, 'Browse') then
          List := FTarget.BrowsingPaths
        else if SameText(Kind, 'Debug') then
          List := FTarget.DebugDcuPaths;
        if List <> nil then
        begin
          Index := List.IndexOf(S);
          if Index = -1 then
            Index := List.IndexOf(FTarget.InsertDirMacros(S));
          if Index = -1 then
            Index := List.IndexOf(FTarget.ExpandDirMacros(S));
          if Index <> -1 then
            List.Delete(Index);
        end;
      end
      else if SameText(Action, 'PackageAdd') then
      begin
        Index := FTarget.KnownPackages.IndexOfFilename(S);
        if Index = -1 then
          Index := FTarget.KnownPackages.IndexOfFilename(FTarget.InsertDirMacros(S));
        if Index = -1 then
          Index := FTarget.KnownPackages.IndexOfFilename(FTarget.ExpandDirMacros(S));
        if Index <> -1 then
          FTarget.KnownPackages.Delete(Index);
      end;

      NewPercentage := Int64(FLog.Count - i) * 100 div FLog.Count;
      if NewPercentage <> Percentage then
      begin
        Percentage := NewPercentage;
        ProgressBar.Position := Percentage;
        Application.ProcessMessages;
      end;
    end;
    FTarget.SavePaths;
    FTarget.SavePackagesLists;
  finally
    LblStatus.Caption := 'Finished.';
    BtnCancel.Enabled := True;
    BtnCancel.Caption := _('Quit');
  end;
  Uninstalled := True;
end;

function GetTempDir: string;
begin
  SetLength(Result, MAX_PATH);
  SetLength(Result, GetTempPath(Length(Result), PChar(Result)));
end;

procedure Finalize;
var
  f: TextFile;
  DeleteFileName: string;
begin
  DeleteFileName := IncludeTrailingPathDelimiter(ExtractShortPathName(GetTempDir)) + 'DeleteDelphiPkgUninstall.bat';

  DeleteFile(ExtractFilePath(ParamStr(0)) + 'install.log');
  SetFileAttributes(PChar(ParamStr(0)), 0);

  AssignFile(f, DeleteFileName);
  Rewrite(f);

  WriteLn(f, '@cd \');
  WriteLn(f, '@del ', ParamStr(0));
  if DeleteUninstallerDir then
    WriteLn(f, '@rd ', ExtractFileDir(ParamStr(0)));
  Write(f, '@del ', DeleteFileName);
  CloseFile(f);
  Application.ProcessMessages;

  ShellExecute(0, 'open', PChar(DeleteFileName), nil, nil, SW_HIDE);
  Halt(0);
end;

initialization

finalization
  if Uninstalled then
    Finalize;
end.