Is it possible to change the host application for multiple projects in a Delphi 2009 group project?

Question

I'm not sure why this isn't something that is changeable with an option set, it would be really nice if it was. And it's not even in DDevExtensions, although I can change a lot of other stuff there.

Is there a place in the Delphi 2009 IDE, or yet another extension that I can install so I can change the host application for the 30+ DLL's in my group project in one fell swoop?

Answer 1

Well, apparently there is no way, although for the life of me I can't think of why. So I wrote this:

(with a few props to Zarko Gajic for the file search)

unit HostAppSwitcherDialog;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, FileCtrl, msxml, msxmldom, Contnrs,
  Generics.Collections;

type
  TForm1 = class(TForm)
    lv1: TListView;
    btnFolder: TButton;
    btnHostApp: TButton;
    btnUpdate: TButton;
    procedure btnFolderClick(Sender: TObject);
    procedure btnHostAppClick(Sender: TObject);
        procedure btnUpdateClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    procedure ClearList;
      public
      end;

  TDprojHostAppInfo = class
    FileName : String;
    Directory : String;
    HostApp : String;
    function GetPath : String;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


function GetHostApplication(const AFileName : String) : String;
var
  DomDoc : IXMLDOMDocument;
  DomNode : IXMLDOMNode;
begin
  DomDoc :=  CreateDOMDocument;
  if DomDoc.load(AFileName) then
  begin
    DomNode := DomDoc.selectSingleNode('//Parameters[@Name="HostApplication"]');
    if assigned(DomNode) then
      Result := DomNode.text;

  end;
end;


function FileSearch(const PathName, FileName : string; const InDir : boolean) : TObjectList<TDprojHostAppInfo>;
var Rec  : TSearchRec;
    Path : string;
    TmpFiles : TObjectList<TDprojHostAppInfo>;
    DProj : TDprojHostAppInfo;
begin
  Result := TObjectList<TDprojHostAppInfo>.Create(False);
  Path := IncludeTrailingBackslash(PathName);
  if FindFirst(Path + FileName, faAnyFile - faDirectory, Rec) = 0 then
  try
    repeat
      if (faReadOnly and rec.Attr) <> faReadOnly then
      begin
        DProj := TDprojHostAppInfo.Create;
        DProj.FileName := Rec.Name;
        DProj.Directory := Path;
        DProj.HostApp := GetHostApplication(DProj.GetPath);
        Result.Add(DProj);
      end;
    until FindNext(Rec) <> 0;
  finally
    FindClose(Rec);
  end;

  If not InDir then Exit;

  if FindFirst(Path + '*.*', faDirectory, Rec) = 0 then
  try
    repeat
      if ((Rec.Attr and faDirectory) <> 0)  and (Rec.Name<>'.') and (Rec.Name<>'..')     then
      begin
        TmpFiles := FileSearch(Path + Rec.Name, FileName, True);
        TmpFiles.OwnsObjects := false;
        for DProj in TmpFiles do
          Result.Add(DProj);
        TmpFiles.Free;
      end;
    until FindNext(Rec) <> 0;
  finally
     FindClose(Rec);
  end;
end; //procedure FileSearch


procedure SetHostApplication(const AFileName : String; const ANewHostApplication :    String);
var
  DomDoc : IXMLDOMDocument;
  DomNode : IXMLDOMNode;
begin
  DomDoc :=  CreateDOMDocument;
  if DomDoc.load(AFileName) then
  begin
    DomNode := DomDoc.selectSingleNode('//Parameters[@Name="HostApplication"]');
    if assigned(DomNode) then
      DomNode.text := ANewHostApplication;

  end;
  DomDoc.save(AFileName);
end;


procedure TForm1.btnHostAppClick(Sender: TObject);
var
  NewHostApp : String;
  lvi : TListItem;
  DProj : TDprojHostAppInfo;
begin
  NewHostApp := InputBox('New Host Application', 'Please type the new host     application', 'w:\bcproc\');
  for lvi in lv1.Items do
    if lvi.Selected then
    begin
      DProj := TDprojHostAppInfo(lvi.Data);
      DProj.HostApp := NewHostApp;
      lvi.SubItems[0] := NewHostApp;
    end;
end;

procedure TForm1.btnUpdateClick(Sender: TObject);
var
  lvi : TListItem;
  dproj : TDprojHostAppInfo;
begin
  for lvi in lv1.Items do
    if lvi.Checked then
    begin
      dproj := TDprojHostAppInfo(lvi.Data);
      SetHostApplication(dproj.GetPath, dproj.HostApp);
    end;
end;

procedure TForm1.ClearList;
var
  lvi : TListItem;
  dproj : TDprojHostAppInfo;
begin
  for lvi in lv1.Items do
  begin
    dproj := TDprojHostAppInfo(lvi.Data);
    dproj.Free;
  end;
  lv1.Clear;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ClearList;
end;

procedure TForm1.btnFolderClick(Sender: TObject);
var
  Options : TSelectDirOpts;
  ChosenDir : string;

  Files : TObjectList<TDprojHostAppInfo>;
  DProj : TDprojHostAppInfo;
  lvi : TListItem;
begin
  ClearList;
  ChosenDir := 'C:\';

  if SelectDirectory(ChosenDir, Options, 0) then
  begin
    Files := FileSearch(ChosenDir, '*.dproj', True);

    for DProj in Files do
    begin
      lvi := lv1.Items.Add;
      lvi.Caption := DProj.FileName;
      lvi.SubItems.Add(DProj.HostApp);
      lvi.Data := DProj;
    end;

    Files.Free;
  end;
end;


function TDprojHostAppInfo.GetPath: String;
begin
  Result := Directory + '\' + FileName;
end;

end.

I'll let you write your own DFM, as mine is not pretty.

Since dproj's are just XML files, you can load them and save them. I didn't include ReadOnly ones in the list of things to change on account of still using VSS, but I'd probably take that out of we ever switch to SVN for Delphi XE2.