みなさん、こんにちは。十兵衛です。



Mes19で話題になったDelphiSelectorですが一度コンパイルされてDCUファイルが
生成されたモノであればDelphi3、Delphi4のどちらでコンパイルされたかを判別
します。

クラスとして実現していますのでUsesに追加して使用してください。

-----------------------ここから------------------------

unit DelphiSelect;

interface

uses
  SysUtils, Classes;

type
  TProjectType = (ptDel3,ptDel4,ptUnKnown);

  TDelphiSelector = class(TObject)
  private
    FFileName,FPasFile:TFileName;
    FProType:TProjectType;
  protected
    procedure SetFileName(Value:TFileName);
    procedure FileCheck;
    procedure ProjectRead;
    procedure PasRead;
  public
    property FileName:TFileName read FFileName write SetFileName;
    property ProjectType:TProjectType read FProType;
  end;

implementation

type
 TMyFileStyle = (fsDpr,fsPas,fsUnKnown);

procedure TDelphiSelector.SetFileName(Value:TFileName);
begin
 if Value <> FFileName then begin
    FFileName := Value;
    FileCheck;
 end;
end;

procedure TDelphiSelector.FileCheck;
var
 FileStyle:TMyFileStyle;
 FExt:string;
begin
 if FileExists(FFileName) then begin
    FExt := ExtractFileExt(FFileName);
    if AnsiCompareText('.Dpr',FExt) = 0 then FileStyle := fsDpr
    else if AnsiCompareText('.Pas',FExt) = 0 then FileStyle := fsPas
    else FileStyle := fsUnKnown;
 end else FileStyle := fsUnKnown;
 case FileStyle of
  fsDpr:ProjectRead;
  fsPas:
  begin
    FPasFile := FFileName;
    PasRead;
  end;
  fsUnKnown:FProType := ptUnKnown;
 end;
end;

procedure TDelphiSelector.ProjectRead;
var
 FPro:TextFile;
 FStr:string;
 FPos1,FPos2:Integer;
begin
 AssignFile(FPro,FFileName);
 FileMode := 0;
 Reset(FPro);
 try
  while not Eof(FPro) do begin
    Readln(FPro,FStr);
    FPos1 := AnsiPos('.PAS',AnsiUpperCase(FStr));
    if FPos1 > 0 then begin
     FPos2 := Pos('''',FStr)+1;
     FPasFile := Copy(FStr,FPos2,FPos1-FPos2+4);
     FPasFile := ExtractFilePath(FFileName)+FPasFile;
     PasRead;
     Break;
    end;
  end;
 finally
  CloseFile(FPro);
  FileMode := 2;
 end;
end;

procedure TDelphiSelector.PasRead;
var
 FReadFile:TFileStream;
 FDcuFile:string;
 Buf:array[0..7] of Char;
begin
 FDcuFile := ChangeFileExt(FPasFile,'.dcu');
 if FileExists(FDcuFile) then begin
    FReadFile := TFileStream.Create(FDcuFile,fmOpenRead);
    try
      FReadFile.Read(Buf,4);
      if StrLComp(Buf,#$41#$86#$51#$44,4) = 0 then
         FProType := ptDel3
      else if StrLComp(Buf,#216#166#104#71,4) = 0 then
              FProType := ptDel4
      else FProType := ptUnKnown;
    finally
      FReadFile.Free;
    end;
 end else FProType := ptUnKnown;
end;

end.

-----------------------ここまで-----------------------------

次は使用例です。FormにButtonとOpenDialogとLabelを貼り付けてください。

UsesにDelphiSelectを追加します。

FormのPrivate部に DelSel:TDelphiSelector; の様に宣言します。

フォーム生成時に生成します。
procedure TSelector.FormCreate(Sender: TObject);
begin
 Label1.Caption := '';
 OpenDialog1.Filter := 'DelphiFiles(dpr,pas)|*.dpr;*.pas';
 OpenDialog1.Title := 'Delphiのファイルを指定する';
 DelSel := TDelphiSelector.Create;
end;

フォームの廃棄時に開放します。
procedure TSelector.FormDestroy(Sender: TObject);
begin
 DelSel.Free;
end;

ボタンが押されたらファイル名をセットして判断します。
procedure TSelector.Button1Click(Sender: TObject);
begin
 Label1.Caption := '';
 OpenDialog1.FileName := '';
 if OpenDialog1.Execute then begin
    DelSel.FileName := OpenDialog1.FileName;
    case DelSel.ProjectType of
      ptDel3:Label1.Caption := 'Delphi3です';
      ptDel4:Label1.Caption := 'Delphi4です';
      ptUnKnown:Label1.Caption := '不明です';
    end;
 end;
end;


ではでは(^^)
                                     98/09/26(土) 14:52 十兵衛(BZT01311)

Original document by 十兵衛          氏 ID:(BZT01311)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。