是否可以在Delphi 2009組項目中更改多個項目的主機應用程序？

Question

我不確定爲什麼這不是一個選項集可以改變的東西，如果是這樣的話，它會非常好。這甚至不在DDevExtensions中，儘管我可以在其中更改很多其他的東西。

在Delphi 2009 IDE中還有一個地方，還是我可以安裝的另一個擴展，所以我可以一次性更改我的組項目中的30多個DLL的宿主應用程序？

Answer 1

好吧，顯然沒有辦法，雖然對於我的生活我想不出爲什麼。所以我寫了這一點：

（有幾個道具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. 

我讓你寫你自己的DFM，像我是不漂亮。

由於dproj只是XML文件，您可以加載它們並保存它們。由於仍然使用VSS，我沒有將ReadOnly列入要更改的列表中，但我可能會將其從我們切換到SVN的Delphi XE2中取出。