Блог

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

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

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

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