Можно ли изменить хост-приложение для нескольких проектов в групповом проекте Delphi 2009? - PullRequest
Новая
       62

Можно ли изменить хост-приложение для нескольких проектов в групповом проекте Delphi 2009?

1 голос
/ 24 октября 2011

Я не уверен, почему это не то, что можно изменить с помощью набора опций, было бы очень хорошо, если бы это было.И это даже не в DDevExtensions, хотя я могу изменить много других вещей там.

Есть ли место в IDE Delphi 2009 или еще одно расширение, которое я могу установить, чтобы я мог одним махом заменить хост-приложение для 30+ DLL в моем групповом проекте?

1 Ответ

1 голос
/ 24 октября 2011

Ну, по-видимому, нет никакого способа, хотя я не могу понять почему.Поэтому я написал это:

(с несколькими реквизитами для 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, вы можете загрузить их и сохранить.Я не включил ReadOnly в список вещей, которые нужно изменить из-за того, что все еще использую VSS, но я бы, вероятно, воспользовался этим, когда мы когда-нибудь переключимся на SVN для Delphi XE2.

...