implementation

uses
  BDE,
  Winapi.ShlObj,
  System.IOUtils;

{$R *.dfm}

//-----------------------------------------------------------------------------
//  BDE の 環境の設定を変更する関数
//  戻り値は変更前の値   
//
//  AConfigPath  : 環境の項目名
//  AConfigName  : その項目内の定義名
//  AConfigValue : その定義名の設定値

//  管理者権限で実行しないと変更できない
//  変更できない場合でもエラーは発生しない
//
//  uses に BDE が必要
//-----------------------------------------------------------------------------
function ConfigBDE(AConfigPath, AConfigName, AConfigValue: string): string;
var
  LhDBICur : hDBICur;
  LConfig  : CFGDesc;
  LszPath  : DBIPATH;
begin
  Result := '';

  // BDE がインストールされていなければ (使用不可ならば) 終了
  if DbiInit(nil) <> DBIERR_NONE then Exit;
  try
    LhDBICur := nil;
    StrPCopy(LszPath, AConfigPath);
    if DbiOpenCfgInfoList(nil,
                          dbiREADWRITE,
                          cfgPersistent,
                          @LszPath,
                          LhDBICur) = DBIERR_NONE then begin
      if DbiSetToBegin(LhDBICur) <> DBIERR_NONE then Exit;

      while True do begin
        if (DbiGetNextRecord(LhDBICur,
                             dbiWRITELOCK,
                             @LConfig,
                             nil) <> DBIERR_NONE) then Break;

        if Trim(string(LConfig.szNodeName)) = AConfigName then begin
          Result := LConfig.szValue;
          StrPCopy(LConfig.szValue, AConfigValue);
          DbiModifyRecord(LhDBICur, @LConfig, True);
          Break;
        end;
      end;
    end;
  finally
    DbiExit;
  end;
end;

//=============================================================================
//  BDE の PARADOX の NET DIR の設定を変更
//
//  管理者権限で実行しないと変更できない．エラーは発生しない
//  結果の表示は変更結果の値になるが実際は変更されていない
//  再度実行すれば変更されたかの確認が可能
//
//  uses に Winapi.ShlObj. System.IOUtils が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LText     : string;
  LOldValue : string;
  LNewValue : string;
begin
  Memo1.Lines.Clear;

  if not IsUserAnAdmin then begin
    LText := '管理者権限で実行してください';
    MessageBox(Handle, PChar(LText), 'BDE の環境設定', MB_ICONWARNING);
    Exit;
  end;


  // Delphi XE5 以降用 = C:\Users\Public\Documents
  LNewValue := TPath.GetSharedDocumentsPath;
  LOldValue := ConfigBDE('\DRIVERS\PARADOX\INIT', 'NET DIR', LNewValue);

  Memo1.Lines.Add('変更前 : ' + LOldValue);
  Memo1.Lines.Add('変更後 : ' + LNewValue);

    // 前の場所の PDOXUSRS.NET ファイルは削除
    if LOldValue <> LNewValue then begin
    DeleteFile(IncludeTrailingPathDelimiter(LOldValue) + 'PDOXUSRS.NET');
  end;
end;

//=============================================================================
//  BDE の System の Init の以下の設定を変更するプログラム
//  SHAREDMEMLOCATION
//  SHAREDMEMSIZE
//
//  管理者権限で実行しないと変更できない．エラーは発生しない
//  結果の表示は変更結果の値になるが実際は変更されていない
//  再度実行すれば変更されたかの確認が可能
//
//  uses に Winapi.ShlObj が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LText     : string;
  LOldValue : string;
  LNewValue : string;
begin
  Memo1.Lines.Clear;

  if not IsUserAnAdmin then begin
    LText := '管理者権限で実行してください';
    MessageBox(Handle, PChar(LText), 'BDE の環境設定', MB_ICONWARNING);
    Exit;
  end;


  LNewValue := '3BDE';
  LOldValue := ConfigBDE('\SYSTEM\INIT', 'SHAREDMEMLOCATION', LNewValue);

  Memo1.Lines.Add('SHAREDMEMLOCATION');
  Memo1.Lines.Add('変更前 : ' + LOldValue);
  Memo1.Lines.Add('変更後 : ' + LNewValue);


  LNewValue := '2048';
  LOldValue := ConfigBDE('\SYSTEM\INIT', 'SHAREDMEMSIZE', LNewValue);

  Memo1.Lines.Add('');
  Memo1.Lines.Add('SHAREDMEMSIZE');
  Memo1.Lines.Add('変更前 : ' + LOldValue);
  Memo1.Lines.Add('変更後 : ' + LNewValue);
end;

// 32 ビット Windows のレジストリ
// 64 ビット Windows の 32 ビット用レジストリ (C:\Windows\SysWOW64\Regedit で起動可能)
HKEY_LOCAL_MACHINE\SOFTWARE\Borland\Database Engine\Settings\SYSTEM\INIT

// 64 ビット Windows のレジストリ (RegEdit だけで起動可能)
HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Borland\Database Engine\Settings\SYSTEM\INIT

unit plBDEInstallerUnit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    function DialogHook(var Message: TMessage): Boolean;
  end;

function InstallBDE(ASrcDir: string): Boolean;
function RunExeFile(hWnd: HWND; AFile: string; AParameters: string;
   Verb: string; nShow: Cardinal): Cardinal;
function ExpandEnvironmentString(AEnvName: String): String;
function ConfigBDE(AConfigPath, AConfigName, AConfigValue: string): string;
function GetBDEVersion: string;
function GetFileVersionString(FileName: string): string;

var
  Form1: TForm1;

implementation

uses
  BDE,
  System.Types,
  System.IOUtils,
  Winapi.ShlObj,
  Winapi.ShellAPI,
  System.Win.Registry;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Button2.Enabled := DbiInit(nil) = DBIERR_NONE;
  DbiExit;
end;

//=============================================================================
//  BDE のインストールを実行
//
//  この EXE のフォルダ内に BDE_Timp の名前のフォルダを作成
//  既存の BDE フォルダ内のフォルダとファイルを BDE_Temp 内にコピーしておく
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBDE_TempDir : string;
  LNetDirPath  : string;
  LText        : string;
begin
  if not IsUserAnAdmin then begin
    LText := '管理者権限で実行してください';
    MessageBox(Handle, PChar(LText), 'BDE インストール', MB_ICONWARNING);
    Exit;
  end;

  LBDE_TempDir := ExtractFilePath(Application.ExeName) + 'BDE_Temp';

  if not FileExists(IncludeTrailingPathDelimiter(LBDE_TempDir) + 'bdeinst.cab') then begin
    LText := 'bdeinst.cab ファイルがありません';
    MessageBox(Handle, PChar(LText), 'BDE インストール', MB_ICONWARNING);
    Exit;
  end;


  Button1.Enabled := False;

  // ダイアログのフック開始
  Application.HookMainWindow(DialogHook);

  if InstallBDE(LBDE_TempDir) then begin
    // NET DIR の設定
    // Delphi XE5 以降用 = C:\Users\Public\Documents
    LNetDirPath := TPath.GetSharedDocumentsPath;
    ConfigBDE('\DRIVERS\PARADOX\INIT', 'NET DIR', LNetDirPath);

    // その他の設定
    // 必要に応じてエイリアス等，他の設定をする
    ConfigBDE('\SYSTEM\INIT', 'SHAREDMEMLOCATION', '3BDE');
    ConfigBDE('\SYSTEM\INIT', 'SHAREDMEMSIZE',     '2048');

    LText := 'BDE のインストールが完了しました' + sLineBreak
           + 'BDE Version : ' + GetBDEVersion;
    MessageBox(Handle, PChar(LText), 'BDE インストール', MB_ICONINFORMATION);

    Button2.Enabled := True;
  end else begin
    LText := 'BDE はインストールされています　' + sLineBreak
           + 'BDE Version : ' + GetBDEVersion;
    MessageBox(Handle, PChar(LText), 'BDE インストール', MB_ICONINFORMATION);
  end;

  // ダイアログのフック終了
  Application.UnhookMainWindow(DialogHook);

  Button1.Enabled := True;
  Close;
end;

//=============================================================================
//  BDE Administrator の起動
//  エンドユーザにエクスプローラで bdeadmin.exe を探すような操作はさせない
//  
//  64 ビット Windows の場合はコントロールパネルから起動できない
//  32 ビット Windows はコントロールパネルから起動可能だが管理者権限では起動不可
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  ShellExecute(0, 'runas', 'bdeadmin.cpl', nil, nil, SW_SHOW);
end;

//-----------------------------------------------------------------------------
//  DBE のインストール用関数
//  アプリに BDE のインストール機能を組み込む際の参考コード
//  インストール先は %CommonProgramFiles%\Borland Shared\BDE 固定
//  管理者権限で実行しないと失敗する
//  失敗してもエラーは発生しない
//
//  ASrcDir   : BDE 関係のファイルがあるディレクトリ
//
//  uses に BDE 等が必要
//-----------------------------------------------------------------------------
function InstallBDE(ASrcDir: string): Boolean;
var
  LInstDir : string;
  LCabPath : string;
  LDllPath : string;
begin
  Result := False;

  // BDE がインストール済みの場合は終了
  try
    if (DbiInit(nil) = DBIERR_NONE) then Exit;
  finally
    DbiDLLExit;
    DbiExit;
  end;

  // インストール先のディレクトリ
  LInstDir := ExpandEnvironmentString('%CommonProgramFiles%\Borland Shared\BDE');

  // ディレクトリを作成してファイルをコピー
  ForceDirectories(LInstDir);
  Sleep(10);
  TDirectory.Copy(ASrcDir, LInstDir);
  Sleep(10);

  LInstDir := IncludeTrailingPathDelimiter(LInstDir);
  LCabPath := AnsiQuotedStr(LInstDir + 'bdeinst.cab', '"');
  LDllPath := AnsiQuotedStr(LInstDir + 'BdeInst.dll', '"');

  // 環境設定ファイルは削除
  DeleteFile(LInstDir + 'IDAPI32.CFG' );

  // CAB 書庫からインストール用の DLL を取り出す
  RunExeFile(0, 'Expand', LCabPath + ' ' + LDllPath, '', SW_HIDE);

  // BDE のインストール
  // regsvr32 を使用しているが DLL の登録 (COM の登録) ではない
  RunExeFile(0, 'regsvr32.exe', '/s ' + LDllPath, '', SW_SHOW);

  Result := True;
end;

//-----------------------------------------------------------------------------
//  ShellExecuteEx関数を使用して，指定したファイルを実行する
//  起動したアプリが終了するまで待つ
//  この関数の戻り値は TShellExecuteInfo.hInstApp の値
//
//  uses に Winapi.ShellAPI が必要
//-----------------------------------------------------------------------------
function RunExeFile(hWnd: HWND; AFile: string; AParameters: string;
   Verb: string; nShow: Cardinal): Cardinal;
var
  LInfo : TShellExecuteInfo;
  LRet  : Cardinal;
begin
  FillChar(LInfo, SizeOf(LInfo), 0);
  LInfo.cbSize := SizeOf(LInfo);
  LInfo.fMask  := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI;

  LInfo.lpFile       := PChar(AFile);
  LInfo.lpParameters := PChar(AParameters);
  LInfo.Wnd    := hWnd;
  LInfo.lpVerb := PChar(Verb);
  LInfo.nShow  := nShow;

  ShellExecuteEx(@LInfo);

  //ShellExecuteExは成功するとhInstAppに33以上の値を返す
  Result := LInfo.hInstApp;
  if Result >= 33 then begin
    //プロセス生成完了まで待つ
    repeat
      LRet := WaitForInputIdle(LInfo.hProcess, 50);
      Application.ProcessMessages;
    until LRet <> WAIT_TIMEOUT;

    // プロセスが起動したらプロセス ID の値をグローバル変数に代入
//      FProcessID := GetProcessId(LInfo.hProcess);

   //起動したプロセス(アプリ)の終了を待つ処理
    while WaitForSingleObject(LInfo.hProcess, 100) = WAIT_TIMEOUT do begin
      Application.ProcessMessages;
    end;

    CloseHandle(LInfo.hProcess);
  end;
end;

//-----------------------------------------------------------------------------
//  環境変数(%で囲まれた文字列)から実際のパス名を取得する関数
//-----------------------------------------------------------------------------
function ExpandEnvironmentString(AEnvName: String): String;
var
  LDstPath : array [0..MAX_PATH - 1] of Char;
begin
  ExpandEnvironmentStrings(PChar(AEnvName), LDstPath, Length(LDstpath));
  Result := LDstPath;
end;

//-----------------------------------------------------------------------------
//  TApplication.HookMainWindowの処理関数 (ダイアログのフック)
//  BDE のインストール時に現れる以下のダイアログで処理を継続
//  進捗ダイアログは表示
//
//  (1) インストール先のディレクトリの確認ダイアログ (TOKBottomDlg)
//  (2) 『ドライブ C: に十分な残り容量がありません．インストールを継続しますか』
//     整数値のオーバーフローによって発生するものと思われる (TOKBottomDlg)
//
//  注意 : この処理は常に正常に動作するとは限らない
//-----------------------------------------------------------------------------
function TForm1.DialogHook(var Message: TMessage): Boolean;

  Procedure PressEnterKey(AhWindow: HWND);
  begin
    SetForegroundWindow(AhWindow);
    Sleep(30);
    keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), 0, 0);
    keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), KEYEVENTF_KEYUP, 0);
  end;
var
  LDlgWindow : HWND;
begin
  Result := False;

  LDlgWindow := FindWindow('TOKBottomDlg', nil);
  if (LDlgWindow <> 0) and IsWindowVisible(LDlgWindow) then begin
    PressEnterKey(LDlgWindow);
  end;

  LDlgWindow := FindWindow('TMessageForm', nil);
  if (LDlgWindow <> 0) and IsWindowVisible(LDlgWindow) then begin
    PressEnterKey(LDlgWindow);
  end;
end;

//-----------------------------------------------------------------------------
//  BDE の 環境の設定を変更する関数
//  戻り値は変更前の値
//
//  AConfigPath  : 環境の項目名
//  AConfigName  : その項目内の定義名
//  AConfigValue : その定義名の設定値

//  管理者権限で実行しないと変更できない
//  変更できない場合でもエラーは発生しない
//
//  uses に BDE が必要
//-----------------------------------------------------------------------------
function ConfigBDE(AConfigPath, AConfigName, AConfigValue: string): string;
var
  LhDBICur : hDBICur;
  LConfig  : CFGDesc;
  LszPath  : DBIPATH;
begin
  Result := '';

  // BDE がインストールされていなければ (使用不可ならば) 終了
  if DbiInit(nil) <> DBIERR_NONE then Exit;
  try
    LhDBICur := nil;
    StrPCopy(LszPath, AConfigPath);
    if DbiOpenCfgInfoList(nil,
                          dbiREADWRITE,
                          cfgPersistent,
                          @LszPath,
                          LhDBICur) = DBIERR_NONE then begin
      if DbiSetToBegin(LhDBICur) <> DBIERR_NONE then Exit;

      while True do begin
        if (DbiGetNextRecord(LhDBICur,
                             dbiWRITELOCK,
                             @LConfig,
                             nil) <> DBIERR_NONE) then Break;

        if Trim(string(LConfig.szNodeName)) = AConfigName then begin
          Result := LConfig.szValue;
          StrPCopy(LConfig.szValue, AConfigValue);
          DbiModifyRecord(LhDBICur, @LConfig, True);
          Break;
        end;
      end;
    end;
  finally
    DbiDLLExit;
    DbiExit;
  end;
end;

//-----------------------------------------------------------------------------
//  BDE のバージョンを取得する関数
//  uses に BDE, System.Win.Registry, Scripting_TLB が必要
//-----------------------------------------------------------------------------
function GetBDEVersion: string;
var
  LRegistry  : TRegistry;
  LRegistKey : string;
  LDllPath   : string;
begin
  Result := '';

  // BDE のインストール先のディレクトリを取得
  LRegistry := TRegistry.Create(KEY_READ);
  try
    LRegistry.RootKey := HKEY_LOCAL_MACHINE;
    LRegistKey := 'SOFTWARE\Borland\Database Engine';

    if LRegistry.OpenKey(LRegistKey, False) then begin
      LDllPath := LRegistry.ReadString('DLLPATH');
      LRegistry.CloseKey;
    end;
  finally
    FreeAndNil(LRegistry);
  end;
  if LDllPath = '' then Exit;

  LDllPath := LDllPath + '\idapi32.dll';
  if not FileExists(LDllPath) then Exit;

  Result := GetFileVersionString(LDllPath);
end;

//-----------------------------------------------------------------------------
//  [ファイルのバージョン]の文字列を取得する関数
//  [ファイルのバージョン]は，ファイルのプロパティダイアログで表示される値
//  引数はファイルのフルパス名
//-----------------------------------------------------------------------------
function GetFileVersionString(FileName: string): string;
var
  LdwHandle  : Cardinal;
  LpInfo     : Pointer;
  LInfoSize  : DWORD;
  LpFileInfo : PVSFixedFileInfo;
  LiVer      : array[0..3] of Cardinal;
begin
  Result := '';

  LInfoSize := GetFileVersionInfoSize(PChar(FileName), LdwHandle);
  if LInfoSize = 0 then exit;

  GetMem(LpInfo, LInfoSize);
  try
    GetFileVersionInfo(PChar(FileName), 0, LInfoSize, LpInfo);
    VerQueryValue(LpInfo, PathDelim, Pointer(LpFileInfo), LInfoSize);

    LiVer[0] := LpFileInfo.dwFileVersionMS shr 16;
    LiVer[1] := LpFileInfo.dwFileVersionMS and $FFFF;
    LiVer[2] := LpFileInfo.dwFileVersionLS shr 16;
    LiVer[3] := LpFileInfo.dwFileVersionLS and $FFFF;
    Result := Format('%d.%d.%d.%d', [LiVer[0], LiVer[1], LiVer[2], LiVer[3]]);
  finally
    FreeMem(LpInfo, LInfoSize);
  end;
end;

end.

//=============================================================================
//  管理者権限で eXE を起動
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LExePath : string;
begin
  // BDE のインストール用プログラムのフルパス
  LExePath := 'BDEInstaller.exe';

  Form1.Enabled := False;

  RunExeFile(Handle, LExePath, '', 'runas', SW_Show);

  SetForegroundWindow(Handle);
  Form1.Enabled := True;
end;

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

function UnInstallBDE(ANetDir: string; var AIsRunBDE: Boolean): Boolean;
function ExpandEnvironmentString(AEnvName: String): string;
function Is64bitWindows: Boolean;

var
  Form1: TForm1;

implementation

uses
  System.Win.Registry,
  System.IOUtils,
  Winapi.ShlObj,
  System.Types;

{$R *.dfm}

// -----------------------------------------------------------------------------
// BDE のアンインストール用関数
// 管理者権限で実行しないと失敗する
// 失敗してもエラーは発生しない
//
//  BDE 関係の機能を使用しないコードにしている
//  BDE 関係の機能を使用するとインストール先のディレクトリが削除できない
//
//  uses に System.Win.Registry 等が必要
// -----------------------------------------------------------------------------
function UnInstallBDE(ANetDir: string; var AIsRunBDE: Boolean): Boolean;
var
  LInstDir   : string;
  LBdeDir    : string;
  LIdAPI32   : string;
  LRegistry  : TRegistry;
  LRegistKey : string;
  LKeyList   : TStringList;
  LAdminPath : string;
begin
  Result := False;
  AIsRunBDE := False;

  // BDE のインストール先のディレクトリを調べる
  LRegistry := TRegistry.Create(KEY_READ);
  try
    LRegistry.RootKey := HKEY_LOCAL_MACHINE;
    LRegistKey := 'SOFTWARE\Borland\Database Engine';

    if LRegistry.OpenKey(LRegistKey, False) then begin
      LBdeDir := LRegistry.ReadString('DLLPATH');
      LRegistry.CloseKey;
    end;
  finally
    FreeAndNil(LRegistry);
  end;
  if LBdeDir = '' then Exit;


  // 親ディレクトリとidapi32.dll のパス
  LInstDir := ExtractFileDir(LBdeDir);
  LIdAPI32 := IncludeTrailingPathDelimiter(LBdeDir) + 'idapi32.dll';

  // この DLL が削除できない時は BDE を使用するコードが実行されている
  // 単に BDE を使用するアプリが起動しているだけであれば削除可能
  // その場合，このディレクトリは操作不可状態となり，そのアプリ終了後に削除される
  if not DeleteFile(LIdAPI32) then begin
    AIsRunBDE := True;
    Exit;
  end;

  // インストール先ディレクトリを削除
  if DirectoryExists(LBdeDir) then begin
    TDirectory.Delete(LBdeDir, True);
  end;
  if DirectoryExists(LInstDir) then begin
    if TDirectory.IsEmpty(LInstDir) then begin
      TDirectory.Delete(LInstDir, True);
    end;
  end;

  // 関係レジストリキーを削除
  LKeyList := TStringList.Create;
  LRegistry := TRegistry.Create;
  try
    LRegistry.RootKey := HKEY_LOCAL_MACHINE;
    LRegistry.DeleteKey('SOFTWARE\Borland\BLW32');
    LRegistry.DeleteKey('SOFTWARE\Borland\Database Engine');

    if LRegistry.OpenKey('SOFTWARE\Borland', False) then begin
      LRegistry.GetKeyNames(LKeyList);
      LRegistry.CloseKey;
      if LKeyList.Count = 0 then begin
        LRegistry.DeleteKey('SOFTWARE\Borland');
      end;
    end;

    LRegistry.RootKey := HKEY_CURRENT_USER;
    LRegistry.DeleteKey('SOFTWARE\Borland\BLW32');
    LRegistry.DeleteKey('SOFTWARE\Borland\Database Engine');

    if LRegistry.OpenKey('SOFTWARE\Borland', False) then begin
      LRegistry.GetKeyNames(LKeyList);
      LRegistry.CloseKey;
      if LKeyList.Count = 0 then begin
        LRegistry.DeleteKey('SOFTWARE\Borland');
      end;
    end;
  finally
    FreeAndNil(LRegistry);
    FreeAndNil(LKeyList);
  end;

  // BdeAdmin.cpl の削除
  if Is64bitWindows then begin
    LAdminPath := ExpandEnvironmentString('%SystemRoot%\SysWOW64\BDEADMIN.CPL');
  end else begin
    LAdminPath := ExpandEnvironmentString('%SystemRoot%\System32\BDEADMIN.CPL');
  end;
  DeleteFile(LAdminPath);

  // PDOXUSRS.NET ファイルの削除
  if ANetDir <> '' then begin
    ANetDir := IncludeTrailingPathDelimiter(ANetDir) + 'PDOXUSRS.NET';
    DeleteFile(ANetDir);
  end;

  Result := True;
end;

//=============================================================================
//  BDE のアンインストールを実行
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LResBool : Boolean;
  LRunBDE  : Boolean;
  LText   : string;
begin
  if not IsUserAnAdmin then begin
    LText := '管理者権限で実行してください';
    MessageBox(Handle, PChar(LText), 'BDE アンインストール', MB_ICONWARNING);
    Exit;
  end;

  Button1.Enabled := False;

  LResBool := UnInstallBDE('', LRunBDE);

  if LResBool then begin
    LText := 'BDE をシステムから削除しました';
    MessageBox(Handle, PChar(LText), 'BDE アンインストール ( 削除 )', MB_ICONINFORMATION);
  end else begin
    if not LRunBDE then begin
      LText := 'BDE はインストールされていません';
      MessageBox(Handle, PChar(LText), 'BDE アンインストール ( 削除 )', MB_ICONINFORMATION);
    end else begin
      // この場合はアンインストールの中止も可能
      LText := 'BDE をアンインストールできません' + sLineBreak
             + 'BDE を使用したアプリを終了して再度実行してください' + sLineBreak
             + 'またはアンインストールを中止してください';
      MessageBox(Handle, PChar(LText), 'BDE アンインストール ( 削除 )', MB_ICONWARNING);
    end;
  end;

  Button1.Enabled := True;
  Close;
end;

//-----------------------------------------------------------------------------
//  環境変数(%で囲まれた文字列)から実際のパス名を取得する関数
//-----------------------------------------------------------------------------
function ExpandEnvironmentString(AEnvName: String): String;
var
  LDstPath : array [0..MAX_PATH - 1] of Char;
begin
  ExpandEnvironmentStrings(PChar(AEnvName), LDstPath, Length(LDstpath));
  Result := LDstPath;
end;

//-----------------------------------------------------------------------------
//  32ビットのWindowsか64ビットのWindowsかを調べる関数
//  64ビット版のWindowsの場合はTrueを返す
//-----------------------------------------------------------------------------
function Is64bitWindows: Boolean;
var
  Wow64Proc : function(hProcess: THandle; var Wow64: BOOL): BOOL stdcall;
  LRetFlag  : LongBool;
begin
  @Wow64Proc := GetProcAddress(GetModuleHandle('Kernel32.dll'), 'IsWow64Process');
  if @Wow64Proc <> nil then begin
    Wow64Proc(GetCurrentProcess, LRetFlag);

    if SizeOf(THandle) = 4 then begin
      Result := LRetFlag;
    end else
    if SizeOf(THandle) = 8 then begin
      Result := True;
    end;
  end else begin
    //Windows XPの64ビット版か
    Result := CheckWin32Version(5, 2);
  end;
end;

end.

implementation

uses
  BDE,
  System.Win.Registry,
  Scripting_TLB;

{$R *.dfm}

//-----------------------------------------------------------------------------
//  BDE のバージョンを取得する関数
//
//  [戻り値]
//  BDE がインストール済みで使用可能であればそのバージョン文字列
//  BDE がインストールしていないか使用不可の時は空文字
//
//  uses に BDE, System.Win.Registry, Scripting_TLB が必要
//-----------------------------------------------------------------------------
function GetBDEVersion: string;
var
  LRegistry     : TRegistry;
  LRegistKey    : string;
  LDllPath      : string;
  LIFileSystem3 : Scripting_TLB.IFileSystem3;
begin
  Result := '';

  // BDE がインストールされていなければ (使用不可ならば) 終了
  if DbiInit(nil) <> DBIERR_NONE then Exit;
  DbiExit;


  // BDE のインストール先のディレクトリを取得
  LRegistry := TRegistry.Create(KEY_READ);
  try
    LRegistry.RootKey := HKEY_LOCAL_MACHINE;
    LRegistKey := 'SOFTWARE\Borland\Database Engine';

    if LRegistry.OpenKey(LRegistKey, False) then begin
      LDllPath := LRegistry.ReadString('DLLPATH');
      LRegistry.CloseKey;
    end;
  finally
    FreeAndNil(LRegistry);
  end;
  if LDllPath = '' then Exit;


  LDllPath := LDllPath + '\idapi32.dll';
  if not FileExists(LDllPath) then Exit;

  // DLL のファイルバージョン文字列を取得
  LIFileSystem3 := CoFileSystemObject.Create;
  try
    Result := LIFileSystem3.GetFileVersion(LDllPath);
  finally
    LIFileSystem3 := nil;
  end;
end;

//=============================================================================
//  フォーム生成時の処理
//  BDE のインストールの有無と BDE のバージョン取得
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LValue : string;
begin
  LValue := GetBDEVersion;

  if LValue = '' then begin
    MessageBox(Handle, 'BDE はインストールされていません．', 'BDE', MB_ICONWARNING);
    PostMessage(Handle, WM_CLOSE, 0, 0);
    Exit;
  end;

  LValue := 'BDE Version' + sLineBreak + LValue;
  MessageBox(Handle, PChar(LValue), 'BDE', MB_ICONINFORMATION);
end;

implementation

uses
  BDE,
  Bde.DBTables,
  Winapi.ShlObj,
  System.IOUtils;

{$R *.dfm}

//-----------------------------------------------------------------------------
//  BDE 使用データベースのエイリアスを設定する手続き
//---------------------------------------------------------------------------
procedure AddStdAlias(Alias, Driver, Path: String);
begin
  if Session.IsAlias(Alias) then begin
    Session.DeleteAlias(Alias);
  end;

  Session.AddStandardAlias(Alias, Path, Driver);
  Session.SaveConfigFile;
end;

//=============================================================================
//  Paradox のデータベースのエイリアスの設定
//
//  フォームに　TFileOpenDialog (Vista Dialogs) コンポーネントを配置
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LDefaultFolder : string;
  LDataFileDir   : string;
  LText          : string;
begin
  if not IsUserAnAdmin then begin
    LText := '管理者権限で実行してください';
    MessageBox(Handle, PChar(LText), 'BDE の設定', MB_ICONWARNING);
    Exit;
  end;

  if DbiInit(nil) <> DBIERR_NONE then begin
    MessageBox(Handle, 'BDE がインストールされていません．', 'BDE の設定', MB_ICONWARNING);
    Exit;
  end;
  DbiExit;


  FileOpenDialog1.Options := [fdoPickFolders, fdoPathMustExist, fdoForceFileSystem];
  LDefaultFolder := TPath.GetSharedDocumentsPath + '\ParadoxData';
  FileOpenDialog1.DefaultFolder := LDefaultFolder;

  // フォルダの選択ダイアログを表示
  if FileOpenDialog1.Execute then begin
    LDataFileDir :=  FileOpenDialog1.FileName;
    AddStdAlias('DBDEMOS', 'PARADOX', LDataFileDir);
  end;
end;

//-----------------------------------------------------------------------------
//  BDE 使用データベースのエイリアスを設定する手続き
//---------------------------------------------------------------------------
procedure AddStdAlias(Alias, Driver, Path: String);
var
  LAlias  : AnsiString;
  LDriver : AnsiString;
  LPath   : AnsiString;
  LParams : AnsiString;
begin
  LAlias  := Alias;
  LDriver := Driver;
  LPath   := Path;

  if DbiInit(nil) <> DBIERR_NONE then Exit;
  try
    DbiDeleteAlias(nil, PAnsiChar(LAlias));

    LParams := 'PATH:' + LPath + ';ENABLE BCD:TRUE';

    DbiAddAlias(nil, PAnsiChar(LAlias), PAnsiChar(LDriver), PAnsiChar(LParams), True);
    DbiCfgSave(nil, nil, True);
  finally
    DbiExit;
  end;
end;