VCL Scanner を Delphi Starter Edition でビルドしてみる

# はじめに
VCL Scanner というのは Delphi / C++Builder で作られたアプリをローカルドライブから検出するツールです。意外なツールが Delphi / C++Builder 製だったりして面白い発見があったりしました。製品の一部だけが Delphi 製とかもありましたね。

以前は Borland 社がバイナリを配布していましたが今では配布されていません。
(今、Borland 社って存在しないですしね)

この記事は VCL Scanner を Delphi 10.2 の無償版である Starter Edition でコンパイルしてみようというものです。

# VCL Scanner の入手
現在の Delphi / C++Builder の開発元である Embarcadero 社のサイトには、この VCL Scanner のソースコードが公開されています。以下からダウンロードできます。ダウンロードしたらアーカイブを適当な場所に解凍しておきます。

- [VCL Scanner (public source code)](https://cc.embarcadero.com/item/23078)

## プロジェクトを開く
Delphi 10.2 Starter Edition でプロジェクトを開きます [ファイル(F) | 開く(O)...]。

![01.png](https://qiita-image-store.s3.amazonaws.com/0/21785/f8988621-7c69-2d0e-b819-57956a920eb1.png)

Oh！タイムスタンプが 2000 年になっていますね。そして開こうとするとエラーが出ます。

![02.png](https://qiita-image-store.s3.amazonaws.com/0/21785/b096489e-84f2-ce26-a16d-8ab2d9fd1330.png)

これは現在の Delphi には含まれない NetManage 製のインターネットコンポーネントが使われているからです。インターネットコンポーネントが何に使われているのかというと VCL Scanner が検出した Delphi / C++Builder 製コンポーネントの調査結果をメールで Borland に送信する機能のために使われています。

今更 Borland にメールを送信しても仕方がないので [すべて無視] を押してください。

## コンパイルが通るようにする

まず、ソースコード中の Char を AnsiChar に置換してください。置換は〔Ctrl〕+〔R〕です。

![04.png](https://qiita-image-store.s3.amazonaws.com/0/21785/d3f3f543-b6fc-fc37-32e8-441d3d712edc.png)

全置換しましょう。これはこのツールが作られた時のコンパイラである Delphi 5 は ANSI 版のコンパイラであったのに対し、現在のコンパイラは Unicode 版であるからです。Unicode 版コンパイラの Char は WideChar なのです。

![05.png](https://qiita-image-store.s3.amazonaws.com/0/21785/19aa42c6-ef72-60e3-8fe9-17156e6bd075.png)

以降、コンパイルしながら不具合をつぶします。

![06.png](https://qiita-image-store.s3.amazonaws.com/0/21785/a7debd6a-4522-4fe9-4b5b-715a415fcb97.png)

先程、NetManage コンポーネントを無視したのでこのエラーが出ます。すべて [はい] を押して宣言を削除します。

 ![07.png](https://qiita-image-store.s3.amazonaws.com/0/21785/b01edb2e-b4ba-ab01-f7d6-0d6ba7db114f.png)

今度は Psock でエラーが出たと思います。これも NetManage 絡みなので削除します。Psock, NMsmtp, NMpop3, を削除してください。

```pascal:Main.pas
{$UNDEF DEBUG}

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, FileCtrl, CheckLst, jpeg, ComCtrls;

```

次は btnNext4Click() で止まります。メール絡みなので、{} を使いブロックコメントでコメントアウトします。削除しても構いません。

```pascal:Main.pas
procedure TfrmMain.btnNext4Click(Sender: TObject);
var
  Company : String;
  CRC     : DWORD;
begin
  if rbSelf.Checked then begin
    if (Pos('@',cbSelf.Text) = 0) or (Pos('.',cbSelf.Text) = 0) or
       (Pos('@',cbSelf.Text)+1 >= RPos('.',PChar(cbSelf.Text))) then begin
      Application.MessageBox('You have selected to send to yourself for test purposes. Make sure your email address is filled in correctly.','Check email...',0);
      Exit;
    end;
    if cbSMTP.Text = DefaultSMTPServer then begin
      Application.MessageBox('You cannot use Borland''s SMTP server to send to yourself. Please use your own server for this purpose.','Check server...',0);
      Exit;
    end;
  end;
{
  with Mail, PostMessage do begin
    ClearParams := False;
    Host := cbSMTP.Text;
    UserID := eUserID.Text;
    if Host = DefaultSMTPServer then begin
      Host := DefaultSMTPAddress;
      UserID := DefaultUserID;
    end;
    Subject := 'VCL Usage Report';
    if cbAnonymous.Checked then begin
      FromAddress := 'anonymous@borland.com';
      FromName := 'Anonymous';
      Company := 'Anonymous';
    end else begin
      FromAddress := cbEmail.Text;
      FromName := cbName.Text;
      Company := cbCompany.Text;
    end;
    if rbSelf.Checked then
      ToAddress.Text := cbSelf.Text
    else
      ToAddress.Text := DefaultToAddress;
    Body.Text := '[UserData]'#13#10+
                 'User Number='+IntToStr(SerialNumber)+#13#10+
                 'Name='+FromName+#13#10+
                 'Email='+FromAddress+#13#10+
                 'Company='+Company+#13#10+
                 #13#10+
                 reResults.Text;
    reFinalResults.Text := 'From: '+FromName+' <'+FromAddress+'>'#13#10+
                           'To: ';
    if rbSelf.Checked then
      reFinalResults.Text := reFinalResults.Text+ToAddress.Text
    else
      reFinalResults.Text := reFinalResults.Text+'Borland'#13#10;
    reFinalResults.Text := reFinalResults.Text+
                           'Subject: '+Subject+#13#10+
                           #13#10+
                           Body.Text
  end;
}
  gbStep5.BringToFront;
  gbStep4.Enabled := False;
  gbStep5.Enabled := True;
end;
```

次は btnBack5Click() で止まります。これもメール絡みなので、{} を使いブロックコメントでコメントアウトします。削除しても構いません。

```pascal:Main.pas
procedure TfrmMain.btnNext5Click(Sender: TObject);
begin
  frmStatus := TfrmStatus.Create(nil);
  frmStatus.Caption := 'Sending report...';
  frmStatus.Label1.Caption := '';
  frmStatus.Animate1.Active := True;
  frmStatus.Show;
  Enabled := False;
  try
    try
{
      with Mail do begin
        frmStatus.Label2.Caption := 'Connecting to '+Host+'...';
        try
          Connect;
        except
          if Host <> DefaultSMTPAddress then begin
            POP.Host := Host;
            POP.UserID := UserID;
            POP.Connect;
          end;
          Connect;
        end;
        frmStatus.Label2.Caption := 'Connected. Sending report...';
        SendMail;
        frmStatus.Label2.Caption := 'Done. Disconnecting...';
        Disconnect;
        if POP.Connected then
          POP.Disconnect;
      end;
}
      frmStatus.Close;
      frmStatus.Free;
      gbFinish.BringToFront;
      gbStep5.Enabled := False;
      gbFinish.Enabled := True;
    except
      Application.MessageBox('Something went wrong while sending your report. Go back and try changing the SMTP settings.','Sending mail failed...',0);
      frmStatus.Close;
      frmStatus.Free;
    end;
  finally
    Enabled := True;
  end;
end;
```

次は ExcludeFile() で止まります。GetFileVersionInfoSize() は Unicode 版 API なのに、PAnsiChar でキャストしているからです。さっき一括置換してしまいましたからね。この関数内の PAnsiChar を PChar に戻します。

```pascal:Main.pas
function TfrmMain.ExcludeFile(const FileName: String): Boolean;
const
  InfoNum = 2;
  InfoStr : array [1..InfoNum] of String =
    ('CompanyName', 'LegalCopyright');
var
  n, Len, i : Cardinal;
  Buf       : PAnsiChar; // <- ここ
  Value     : PAnsiChar; // <- ここ
begin
  Result := False;
  n := GetFileVersionInfoSize(PChar(FileName),n); // <- ここ
  if n > 0 then begin
    Buf := AllocMem(n);
    GetFileVersionInfo(PAnsiChar(FileName),0,n,Buf); // <- ここ
    for i:=1 to InfoNum do
      if VerQueryValue(Buf,PChar('StringFileInfo\040904E4\'+
                                 InfoStr[i]),Pointer(Value),Len) then begin
        Result := (Pos('Borland',Value) <> 0) or (Pos('Inprise',Value) <> 0) or (Pos('InterBase',Value) <> 0);
        if Result then
          Break;
      end;
    FreeMem(Buf,n);
  end;
end;
```
次は BannerTimerTimer() で止まります。定数 BannerInFront に代入しているからです。素直に変数にすればいいものを...

```pascal:Main.pas
var
  frmMain: TfrmMain;

implementation

{$R *.DFM}

uses
  Registry, UrlMon, Status, Debug, ShellAPI, CRC32;

type
  TBannerInFront = (bDelphi, bBCB, bLinux);

const
  DefaultSMTPServer = 'Borland SMTP Server';
  DefaultSMTPAddress = 'smtp.yourcompany.com';
  DefaultUserID = 'destinationuserid';
  DefaultToAddress = DefaultUserID+'@yourcompany.com';

var
  BannerInFront: TBannerInFront; // var にする
```

BannerInFront を変数にし、BannerInFront の初期値を FormCreate() 内で指定します。

```pascal:Main.pas
procedure TfrmMain.FormCreate(Sender: TObject);
begin
  BannerInFront := bDelphi; // 追加

  // Kludge to randomize what banner starts...
  Randomize;
  case Random(3) of

  ...
```
次は POPAuthenticationNeeded() で止まりますが、このイベントハンドラは使われていません。ブロックコメントにしましょう。

```pascal:Main.pas
{
procedure TfrmMain.POPAuthenticationNeeded(var Handled: Boolean);
begin
  POP.UserID := InputBox('Server authentication needed...','POP3 UserID','');
  POP.Password := InputBox('Server authentication needed...','POP3 Password','');
  Handled := True;
end;
}
```
定義部もコメントアウトします。

```pascal:Main.pas
    ...

    procedure btnUncheckSelectedClick(Sender: TObject);
//  procedure POPAuthenticationNeeded(var Handled: Boolean);　// コメントアウト
    procedure btnBack7Click(Sender: TObject);
  private
    { Private declarations }
    ResList : TStringList;
    Excludes : TStringList;

    ...
```
コンパイルが通るようになりましたが、メッセージウィンドウにワーニングが出ていますのでこれを潰します。

```
プロジェクトの依存関係を確認中...
VCLScanner.dproj をビルド中 (Debug, Win32)
brcc32 の "VCLScanner.vrc" コマンド ライン
dcc32 の "VCLScanner.dpr" コマンド ライン
[dcc32 警告] Main.pas(9): W1005 ユニット 'Vcl.FileCtrl' は特定のプラットフォームに固有のものです
[dcc32 ヒント] Main.pas(665): H2164 変数 'Company' が宣言されていますが 'TfrmMain.btnNext4Click' の中では使われていません
[dcc32 ヒント] Main.pas(666): H2164 変数 'CRC' が宣言されていますが 'TfrmMain.btnNext4Click' の中では使われていません
[dcc32 ヒント] Main.pas(1399): H2443 インライン関数 'Point' はユニット 'System.Types' が USES リストで指定されていないため展開されません
[dcc32 ヒント] Main.pas(1404): H2443 インライン関数 'Point' はユニット 'System.Types' が USES リストで指定されていないため展開されません
成功
経過時間: 00:00:06.4
```

最初のプラットフォームの警告は、Delphi がマルチプラットフォーム対応になってから出るようになったものですね。Windows 固有の機能を使おうとしているのでワーニングが出ます。これは無視しても構わないのですが {$WARN UNIT_PLATFORM OFF} を先頭の方に追加すれば消すことができます。

```pascal:Main.pas
{$UNDEF DEBUG}
{$WARN UNIT_PLATFORM OFF} // <- 追加

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, FileCtrl, CheckLst, jpeg, ComCtrls;

  ...

```
Company と CRC という使われていない変数は btnNext4Click() ですね。さっきコメントアウトした箇所でしか使われていなかったようです。ブロックコメントで止めるか削除しましょう。Company と CRC だけ消すと空の var ブロックが残ってしまうので、こちらも消しておきます。

```pascal:Main.pas
procedure TfrmMain.btnNext4Click(Sender: TObject);
{
var
  Company : String;
  CRC     : DWORD;
}
begin
  if rbSelf.Checked then begin
    if (Pos('@',cbSelf.Text) = 0) or (Pos('.',cbSelf.Text) = 0) or
       (Pos('@',cbSelf.Text)+1 >= RPos('.',PChar(cbSelf.Text))) then begin
      Application.MessageBox('You have selected to send to yourself for test purposes. Make sure your email address is filled in correctly.','Check email...',0);
      Exit;
    end;
    if cbSMTP.Text = DefaultSMTPServer then begin
      Application.MessageBox('You cannot use Borland''s SMTP server to send to yourself. Please use your own server for this purpose.','Check server...',0);
      Exit;
    end;
  end;

  ...
```
最後の System.Types がどうのこうのも無視して構わないのですが、uses の最後に Types を追加すれば消せます。System.Types を追加しても構いません。古いバージョンとの互換性のために、名前空間を一部省略する事が可能となっています。

```pascal:Main.pas
{$UNDEF DEBUG}
{$WARN UNIT_PLATFORM OFF}

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, FileCtrl, CheckLst, jpeg, ComCtrls, Types; // <- 追加
```
これですべてのエラーとワーニングを消すことができました。

![08.png](https://qiita-image-store.s3.amazonaws.com/0/21785/99e92c74-5f1e-9a51-25f6-f68be44c0b14.png)

ですが、このままだと判定ロジックがうまく動きません。EnumFunc() を以下のように修正します。

```pascal:Main.pas
function EnumFunc(Instance: THandle; ResType: Integer; ResName: PChar; lParam: LongInt): Boolean; stdcall;
var
  Buffer: PAnsiChar;
begin
  Buffer := LockResource(LoadResource(Instance,FindResource(Instance,ResName,RT_RCDATA)));
  if Pos('TPF0', String(AnsiString(Buffer))) = 1 then
    frmMain.ResList.Add(ResName);
  Result := True;
end;
```
これですべての修正が完了しました。

## VCL Scanner の使い方

VCL Scanner をコンパイルして実行してみましょう。

![09.png](https://qiita-image-store.s3.amazonaws.com/0/21785/926655fa-dd66-337c-f6c5-ff2d57fb1f7f.png)

[Next] ボタンを押します。

![10.png](https://qiita-image-store.s3.amazonaws.com/0/21785/aa2a2396-7a61-1528-27ce-fd593c38eb40.png)

探索したいフォルダを選び [Next] ボタンを押します。下のチェックボックスにチェックを入れればすべての (固定) ドライブをスキャンできます。スキャンが完了し、Delphi / C++Builder 製アプリを検出すると以下のような画面になります。

![11.png](https://qiita-image-store.s3.amazonaws.com/0/21785/756112d1-66d4-5e8e-9a37-7481df65a362.png)

左下の [More info...] を押すとスキャンから除外したいフォルダやファイルを指定できます。
[Next] ボタンを押すと多分エラーになります。ここから先は労力の割に大した事をやっていません。

***Step 3*** 以降は Borland にメールを送る算段なのです。この先を見たいのならエラーで止まる箇所を片っ端からコメントアウトすればいいと思います。

![image.png](https://qiita-image-store.s3.amazonaws.com/0/21785/a49a23ba-2a3b-0c71-f955-cdb022ad3147.png)

![image.png](https://qiita-image-store.s3.amazonaws.com/0/21785/97698308-12ff-69da-8c4d-245af86f40ab.png)

![image.png](https://qiita-image-store.s3.amazonaws.com/0/21785/9d511774-4667-e4a0-ed40-6bc733d76c16.png)

![image.png](https://qiita-image-store.s3.amazonaws.com/0/21785/48c422c9-66ad-6cb2-488a-53a44072b637.png)


# おわりに
[Delphi Professional 以上の製品を購入すると旧製品が入手可能](https://www.embarcadero.com/jp/products/delphi/previous-versions)ですので、もっと簡単にコンパイルできると思います。例えば Delphi 2007 なら NetManage の部分を無視するだけでコンパイルできると思います。

旧製品で入手できる最古の Delphi は ***バージョン 7*** なのですが、惜しいことに NetManage がバンドルされているのは Delphi 6 までなんですよね。

それと、この VCL Scanner ですが、名前の通り VCL を検出して Delphi / C++Builder 製かどうかを判定していますが、最近の Delphi には FireMonkey フレームワークがあるため、FireMonkey アプリケーションは検出できないかもしれません。

この記事を書いておいて身も蓋もないのですが、***Delphi / C++Builder 製アプリかどうかってバイナリエディタにかければ大体判る***んですよね (w


***See Also:***

 - [EXE を生成するのに使われた Delphi のバージョンを判定する](https://ht-deko.com/tech030.html#tech059)