delphi - 是否可以更改 Delphi 2009 组项目中多个项目的主机应用程序？

Question

我不确定为什么这不是可以通过选项集更改的东西，如果可以的话，那就太好了。它甚至不在 DDevExtensions 中，尽管我可以在那里更改很多其他内容。

Delphi 2009 IDE 中是否有一个位置，或者我可以安装另一个扩展，以便我可以一举更改我的组项目中 30 多个 DLL 的主机应用程序？

Answer 1

好吧，显然没有办法，尽管我一生都想不出为什么。所以我写了这个：

（带有一些用于文件搜索的 Zarko Gajic道具）

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.

我会让你编写自己的 DFM，因为我的并不漂亮。

由于 dproj 只是 XML 文件，因此您可以加载并保存它们。由于仍在使用 VSS，我没有将 ReadOnly 包含在要更改的内容列表中，但我可能会考虑到我们曾经为 Delphi XE2 切换到 SVN。