Embedding InterBase 6.0 in 10 easy steps

By Marco Romanini - InterBase Software Corporation
Marco Romanini is a senior software engineer for InterBase Software Corporation, a subsidiary of Inprise Corporation. Marco has worked for Inprise Corporation since January 1994, in Technical Support for Paradox and Delphi. In August 1995, he joined InterBase Software Corporation in Quality Assurance, and later in Research and Development. Marco has been referred to as the "jack of all trades" at InterBase. He has worked on a wide variety of projects, including design of the install API, maintenance of UDF and Blob filter mechanisms, Webmaster for the company's intranet Web server, contributing to a company-wide effort to improve development methodology, and being the licensing guru. Marco received both his Bachelor's and Master's degrees in computer science from California State University at Chico.

Introduction

Install API

License API

Installing InterBase

Step 1: Perform install precheck

Step 2: Check software activation certificate

Step 3: Get suggested installation directory

Step 4: Get Option Information

Step 5: Set Install Options

Step 6: Perform Install

Step 7: Add software activation certificate and/or license file

Step 8: Create Start Menu Entries

Step 9: Start the InterBase Guardian

Step 10: Register Uninstall Program

Uninstalling InterBase

Step 1: Perform Uninstall

Step 2: Unregister Uninstall Program

Step 3: Remove Start Menu Entries

Summary

Appendix

A: Demo Install Program Source

B: Demo Uninstall Program Source

Introduction

Install API

• isc_install_set_option: Allows you to set an install option.  Options represent the components to be installed.
• isc_install_unset_option: Allows you to unset an install option.
• isc_install_clear_options: Clears all install options
• isc_install_precheck: Performs some pre-install checks on the system such as validating the source and destination directory, ensuring that there is no InterBase server running on the machine, and checking user permissions.
• isc_install_execute: Performs the install according to the options set and the directories specified.
• isc_uninstall_precheck: Performs some pre-uninstall checks on the system such as ensuring that there is no InterBase server running on the machine, and checking user permissions.
• isc_uninstall_execute: Performs the uninstall according to the information in the uninstall file.
• isc_install_get_message: Returns the error or warning message associated with a message code.
• isc_install_load_external_text: Loads a message file other than the default one, and instructs the install API to use it.  This is intended for internationalization purposes.

isc_install_get_info: Returns the suggested destination directory, or information about a specific option, such as the name, description, and size.

License API

• isc_license_check: Checks if a software activation certificate  is valid.
• isc_license_add: Adds a software activation certificate to the InterBase license.
• isc_license_remote: Removes a software activation certificate from the InterBase license.
• isc_license_display: Returns the list of software activation certificates which are in the InterBase license.
• isc_license_get_msg: Returns a message associated with an error code.

Note: If using the License API it is extremely important that the library and entry points be dynamically loaded only once the install is complete.  This ensures that the finished environment after install is used to add the license, rather than the one before.  If you are using Delphi, we have provided a unit containing functions which automatically handle the dynamic loading of this library.

The License API does not provide a facility for installing custom license files.  These are license files created for VARs for specific needs, and need only be concatenated to the end an existing license file if present.  A sample way of doing this is demonstrated in the demo install program provided in the AddLicenseInformationClick method.

Installing InterBase

1. Perform install precheck
2. Check software activation certificate
3. Get suggested installation directory
4. Get option information
5. Set install options
6. Perform install
7. Add software activation certificate and/or license file
8. Create start menu entries
9. Start the InterBase Guardian
10. Register Uninstall Program

Step 1: Perform install precheck

Step 2: Check software activation certificate

Step 3: Get suggested installation directory

Step 4: Get Option Information

Step 5: Set Install Options

Step 6: Perform Install

If the install program is to display installation status, you should write a status handling function, and pass its function pointer to isc_install_execute, this is optional, and its need is up to the discretion of the developer.  Additionally, if the install program needs to be aware of errors during the execution of the install, so that it can choose to rectify or ignore the error, or abort the install, you should write an error handling function, and pass its function pointer to isc_install_execute.  The error handling function can be written to automatically handle errors, or to display errors to the user, and let them decide weather to ignore, retry, or abort.  If no error handling function is provided isc_install_execute will abort immediately once an error is encountered, and return the error number.  Please see the demo install program for an example of a status handling function DisplayStatus and an error handling function DisplayError.

Step 7: Add software activation certificate and/or license file

The second method is to add software activation certificates using isc_license_add.  Software activation certificates are made up of two numbers, and ID and a key, and represent a predetermined set of features or simultaneous users to activate.  Any number of software activation certificates can be combined to activate more features, as long as they are unique, that is you can not use the same certificate twice.

The second method is just as effective as the first, except that it provides less flexibility, and you must request that your users enter multiple software activation certificates, or hardcode them in your installation program.  Furthermore, if you wish ot have the ability to have the InterBase software stop working on a given date, you can only do this with the use of license files, since they can be created to have an expiration date, whereas software activation certificates can not.

Step 8: Create Start Menu Entries

Step 9: Start the InterBase Guardian

Step 10: Register Uninstall Program

Uninstalling InterBase

1. Perform Uninstall
2. Unregister Uninstall Program
3. Remove Start Menu Entries

Step 1: Perform Uninstall

As with step 6: Perform Install on the installation, if the uninstall program is to display uninstallation status, you should write a status handling function, and pass its function pointer to isc_uninstall_execute, this is optional, and its need is up to the discretion of the developer.  Additionally, if the uninstall program needs to be aware of errors during the execution of the uninstall, so that it can choose to rectify or ignore the error, or abort the uninstall, you should write an error handling function, and pass its function pointer to isc_uninstall_execute.  The error handling function can be written to automatically handle errors, or to display errors to the user, and let them decide weather to ignore, retry, or abort.  If no error handling function is provided isc_uninstall_execute will abort immediately once an error is encountered, and return the error number.  Please see the demo uninstall program for an example of a status handling function DisplayStatus and an error handling function DisplayError.

Step 2: Unregister Uninstall Program

Step 3: Remove Start Menu Entries

Summary

Appendix

A: Demo Install Program Source

unit Install_main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, checklst, Gauges, IBInstall, ShlObj, ActiveX, ComObj,
  Registry, Winsvc, iblicense;

type
  TInteractiveInstallDemoFrm = class(TForm)
    InstallPageControl: TPageControl;
    InstallPage1: TTabSheet;
    InstallPage2: TTabSheet;
    InstallPage3: TTabSheet;
    Step1GrpBx: TGroupBox;
    PerformPrecheckBtn: TButton;
    Step2GrpBx: TGroupBox;
    CertIDLbl: TLabel;
    CertIDFld: TEdit;
    CertKeyLbl: TLabel;
    CertKeyFld: TEdit;
    CheckLicenseBtn: TButton;
    Step3GrpBx: TGroupBox;
    GetSuggestedDestinatoinBtn: TButton;
    DestinationDirLbl: TLabel;
    DestinationDirFld: TEdit;
    Step4GrpBx: TGroupBox;
    GetOptionInformationBtn: TButton;
    Step6GrpBx: TGroupBox;
    PerformInstallBtn: TButton;
    InstallProgressGauge: TGauge;
    Step7GrpBx: TGroupBox;
    AddLicenseInformation: TButton;
    Step8GrpBx: TGroupBox;
    CreateShorcutsBtn: TButton;
    Step9GrpBx: TGroupBox;
    StartGuardianBtn: TButton;
    Step10GrpBx: TGroupBox;
    UninstallFilenameFld: TEdit;
    RegisterUninstallBtn: TButton;
    Step5GrpBx: TGroupBox;
    ComponentsListBox: TCheckListBox;
    SetOptionsBtn: TButton;
    procedure PerformPrecheckBtnClick(Sender: TObject);
    procedure CheckLicenseBtnClick(Sender: TObject);
    procedure GetSuggestedDestinatoinBtnClick(Sender: TObject);
    procedure GetOptionInformationBtnClick(Sender: TObject);
    procedure SetOptionsBtnClick(Sender: TObject);
    procedure PerformInstallBtnClick(Sender: TObject);
    procedure AddLicenseInformationClick(Sender: TObject);
    procedure CreateShorcutsBtnClick(Sender: TObject);
    procedure StartGuardianBtnClick(Sender: TObject);
    procedure RegisterUninstallBtnClick(Sender: TObject);
  private
    { Private declarations }
    OptionsHandle: OPTIONS_HANDLE;
    SourceDir: String;
    RebootMessage: Boolean;
    Cancelling: Boolean;
    StartServer: Boolean;
    function DisplayErrorMessage(handle: OPTIONS_HANDLE; error: MSG_NO): word;
  public
    { Public declarations }
  end;

function DisplayError(msg: MSG_NO; data: pointer; error_msg: TEXT): integer; export; stdcall;
function DisplayStatus(status: integer; data: pointer; const status_msg: TEXT): integer; export; stdcall;

var
  InteractiveInstallDemoFrm: TInteractiveInstallDemoFrm;

const
   MaxComp = 12;
   ComponentOptionNumber: array [0..MaxComp-1] of OPT =
   (IB_SERVER, IB_CLIENT, IB_DOC, IB_CMD_TOOLS, IB_GUI_TOOLS,
    IB_DEV, IB_EXAMPLE_API, IB_EXAMPLE_DB, IB_CONNECTIVITY_SERVER,
    IB_ODBC_CLIENT, IB_JDBC_CLIENT, IB_OLEDB_CLIENT);

implementation

{$R *.DFM}

{*************************************}
{ Ten easy steps to embedd InterBase  }
{*************************************}

{ TODO 1: Perform Install PreCheck }
procedure TInteractiveInstallDemoFrm.PerformPrecheckBtnClick(
  Sender: TObject);
var
  err_no: MSG_NO;
begin
  { Perform a precheck at the begenning of the setup to ensure
  { that it is OK to install.  Since we are not passing in any
  { options, all that will be done is a search for incompatible
  { versions od InterBase such as InterBase 4.1 for NT (Classic)
  { and a check of the Operating system (NT 3.51 is not supported.
  { By doing this at the begenning the user finds out immediately
  { that the install can not be performed rather than waiting until
  { all the questions have been answered.}
  OptionsHandle := 0;
  SourceDir := ExtractFilePath(ParamStr(0));
  { By setting all options, we guarantee the maximum precheck.
  { If we had not set INTEERBASE, but rather had used IB_CLIENT
  { We would still be checking for CLassic server instaled, but
  { we would NOT be checking for a started Super server. }
  isc_install_set_option(@OptionsHandle,INTERBASE);
  err_no := isc_install_precheck(OptionsHandle, PChar(SourceDir), nil);
  { Since we are not passing sufficent information to the precheck
  { we know that we will get warnings.  However in this particular
  { instance we are only interested in errors, so we will only check for
  { positive return values. }
  if (err_no > 0) then
    DisplayErrorMessage(OptionsHandle, err_no)
  else
    MessageDlg('Precheck OK!',MtInformation,[mbok],0);
end;

{ TODO 2: Check License Information (optional) }
procedure TInteractiveInstallDemoFrm.CheckLicenseBtnClick(Sender: TObject);
var
  retval: integer;
begin
  { Call IscLicenseCheck to validate the ID/Key.  This allows you to
  { see if the id/key is valid and issue any errors immediately.  This
  { step is optional, since you might not want to surface this to the
  { users, and either use a hard-coded id/key, or use a custom license
  { file.  In either of these cases you would know that it is valid,
  { and therefore there is no need to check. }
  retval := IscLicenseCheck(ExtractFilePath(ParamStr(0))+'biniblicense.dll',CertIDFld.Text,CertKeyfld.Text);
  if ((not (retval = isc_license_success)) and (not (retval = isc_license_msg_dupid))) then
    begin
      MessageDlg('Could not license product' ,mtError,[mbOk],0);
    end
  else
    MessageDlg('License OK!',MtInformation,[mbok],0);
end;

{ TODO 3: Get Suggested Destination Directory }
procedure TInteractiveInstallDemoFrm.GetSuggestedDestinatoinBtnClick(
  Sender: TObject);
var
  err_no: MSG_NO;
  TmpDestDir: PChar;
begin
  TmpDestDir  := StrAlloc(ISC_INSTALL_MAX_PATH);
  { Call isc_install_get_info asking for the info_destination.
  { This will check for a preinstalled version and if one is found
  { will suggest that directory as the destination.  Otherwise it
  { will use the default directory. }
  err_no :=  isc_install_get_info(isc_install_info_destination, 0,
                                  TmpDestDir, ISC_INSTALL_MAX_PATH);
  if(err_no = isc_install_success) then
    DestinationDirFld.Text := String(TmpDestDir)
  else
    InteractiveInstallDemoFrm.DisplayErrorMessage(OptionsHandle, err_no);
  { Don't forget to free the memory }  
  StrDispose(TmpDestDir);
end;

{ TODO 4: Get Option Information (optional) }
procedure TInteractiveInstallDemoFrm.GetOptionInformationBtnClick(
  Sender: TObject);
var
  err_no: MSG_NO;
  TmpCompSize: Longint;
  TmpCompName: PChar;
  CompCount: integer;
begin
  TmpCompName := StrAlloc(ISC_INSTALL_MAX_MESSAGE_LEN);
  TmpCompSize := 0;
  ComponentsListBox.Items.Text := '';
  for CompCount := 0 to MaxComp - 1 do
    begin
      { For every option you wish to use, call isc_install_get_info to get the diskspace
      { needed for the option}
      err_no := isc_install_get_info(isc_install_info_opspace, ComponentOptionNumber[CompCount],
                                     Pointer(@TmpCompSize), Sizeof(Longint));
      if (err_no >< isc_install_success) then
        DisplayErrorMessage(OptionsHandle, err_no);
      { Call isc_install_get_info again to get the names of the options.  For example, IB_DOC
      { has a name of "On-line Documentation".  Optionally, you could additionally call
      { isc_install_get_info with isc_install_info_opdescription to get the long description
      { for the option.  This is more useful for fully interactive install to allow the
      { user to request more info on any one select option.}
      err_no := isc_install_get_info(isc_install_info_opname, ComponentOptionNumber[CompCount],
                                    Pointer(TmpCompName), ISC_INSTALL_MAX_MESSAGE_LEN);
      if (err_no >< isc_install_success) then
        DisplayErrorMessage(OptionsHandle, err_no);
      ComponentsListBox.Items.Add(String(TmpCompName)+' ('+IntToStr(TmpCompSize)+' K)');
    end;
  { Don't forget to free memory }
  StrDispose(TmpCompName);
end;

{ TODO 5: Set Install Options Selected }
procedure TInteractiveInstallDemoFrm.SetOptionsBtnClick(Sender: TObject);
var
  i: Integer;
  err_no: MSG_NO;
begin
  isc_install_clear_options(@OptionsHandle);
  StartServer := False;
  for i := 0 to MaxComp - 1 do
    begin
      if (ComponentsListBox.Checked[i]) then
        begin
          { If the server option has been selected, then make a note of it so that
          { you know that you should start it at the end. }
          if (ComponentOptionNumber[i] = IB_SERVER) then
            StartServer := True;
          { For every checked element in the list, set the equivalent option. }  
          err_no := isc_install_set_option(@OptionsHandle, ComponentOptionNumber[i]);
          if (err_no >< 0) then
            DisplayErrorMessage(OptionsHandle, err_no);
        end;
    end;
  MessageDlg('Options Set!',MtInformation,[mbok],0);
end;

{ TODO 6: Perform Install as requested }
procedure TInteractiveInstallDemoFrm.PerformInstallBtnClick(Sender: TObject);
var
  err_no: MSG_NO;
  ret_val: word;
  UninstallFilename: PChar;
begin
  UninstallFilename := StrAlloc(256);
  ret_val := mrIgnore;
  { Call precheck one more time to make sure that the options you have selected do not
  { have any unsattisfied dependencies.  If they do this is a warning, and thus can
  { be ignored if desired. }
  err_no := isc_install_precheck(OptionsHandle,PChar(SourceDir),PChar(DestinationDirFld.Text));
  if (err_no >< 0) then
    ret_val := DisplayErrorMessage(OptionsHandle, err_no);
  if (ret_val = mrIgnore) then
    begin
      { Perform the install, and set the error handling call back, the status handling call back
      { and the uninstall file name. }
      err_no := isc_install_execute(OptionsHandle,PChar(SourceDir),PChar(DestinationDirFld.Text),
                                    @DisplayStatus,nil,@DisplayError,nil,UninstallFileName);
      { If an error occured and was handled by the error handling call back, and the
      { user chose to abort/cancel, then exit the install. }
      if err_no = isc_install_user_aborted then
        exit;
      { If an error occured at the end, and was returned by the install, display it. }
      if (err_no >< 0) then
        begin
          ret_val := DisplayErrorMessage(OptionsHandle, err_no);
        end;
      { If the user chose to abort/cancel, then exit the install. }
      if not (ret_val = mrIgnore) then
        begin
          exit;
        end;
    end;
  UninstallFilenameFld.Text := UninstallFilename;
  StrDispose(UninstallFilename);
  { We have to manually copy our own uninstall program, since the
  { API knows nothing about it.}
  CopyFile(pChar(SourceDir+'Interactive_Uninstall_Demo.exe'),
           pchar(DestinationDirFld.Text+'Interactive_Uninstall_Demo.exe'),False);
  {If some files could not be copied, then they will be replaced the
  { next time you re-boot.  Therefore we need to inform the user of this. }           
  if (RebootMessage) then
    MessageDlg('You must reboot in order for install to finish!',MtInformation,[mbok],0)
  else
    MessageDlg('Install Successful!',MtInformation,[mbok],0);
end;

{ TODO 7: Add License Information (optional) }
procedure TInteractiveInstallDemoFrm.AddLicenseInformationClick(Sender: TObject);
var
  retval: integer;
  DestinationLicenseFile: TextFile;
  DestinationLicenseLine: String;
  SourceLicenseFile: TextFile;
  SourceLicenseLine: String;
  SourceLicenseLineAlreadyInDestination: boolean;
const
  LICENTOOL_SUCCESS = 29;
begin
  SourceLicenseLineAlreadyInDestination := false;
  { Open the destination licenes file, and attempt to reset it.
  { If you get any kind of exception, then the file MUST not exist,
  { so go ahead and reWrite it, so as to create it.  We know that
  { the only case in which there will be one already there, is the
  { case in which we just installed over a pre-existing version of
  { interbase.  In this case the license which was there may or
  { may not apply to this version, but we must never remove a users
  { license since it belongs to them. }
  AssignFile(DestinationLicenseFile, DestinationDirFld.Text+'ib_license.dat');
  try
    Reset(DestinationLicenseFile);
  except on E:Exception do
    ReWrite(DestinationLicenseFile);
  end;
  { We know that there is a license file on the install media, so
  { we do not have to check for existance.  Simply reset its file
  { poiner to the begining. }
  AssignFile(SourceLicenseFile, SourceDir+'ib_license.dat');
  Reset(SourceLicenseFile);
  while not eof(SourceLicenseFile) do
    begin
      { As long as there is information in the Source license file,
      { this is the one on the install media, then read one line at
      { the time, and compare it to each an evry line in the
      { destination license file. }
      Readln(SourceLicenseFile,SourceLicenseLine);
      Reset(DestinationLicenseFile);
      while ((not eof(DestinationLicenseFile)) and (not SourceLicenseLineAlreadyInDestination)) do
        begin
          Readln(DestinationLicenseFile,DestinationLicenseLine);
          if (SourceLicenseLine = DestinationLicenseLine) then
            SourceLicenseLineAlreadyInDestination := true;
        end;
      { If the source license line is not already in the destination
      { license file, then we go ahead and append it. }
      if not (SourceLicenseLineAlreadyInDestination) then
        begin
          Append(DestinationLicenseFile);
          Writeln(DestinationLicenseFile, SourceLicenseLine);
        end;
    end;
  CloseFile(DestinationLicenseFile);
  CloseFile(SourceLicenseFile);
  { Now that we have added the contents of the source license file to
  { the destination license file, we need to add the desired certificates
  { to the destination license file.  To do this correctly we call
  { IscLicenseAdd to actualy add the certificate.  If there
  { was a need to add multiple certificates, you could call this function
  { as many times as necessary. }
  retval := IscLicenseAdd(DestinationDirFld.text+'biniblicense.dll',CertIDFld.Text,CertKeyfld.Text);
  if ((not (retval = isc_license_success)) and (not (retval = isc_license_msg_dupid))) then
    begin
      MessageDlg('Could not license product' ,mtError,[mbOk],0);
    end
  else
    MessageDlg('License added Successfully',MtInformation,[mbok],0);
end;

{ TODO 8: Create Start Menu entries (optional) }
procedure TInteractiveInstallDemoFrm.CreateShorcutsBtnClick(Sender: TObject);
const
  ShortcutNames = 'License Registration Tool'+#10+
                  'Release Notes'+#10+
                  'License Agreement'+#10+
                  'InterBase Help'+#10+
                  'Performance Help'+#10+
                  'API Reference Guide'+#10+
                  'Data Definition Guide'+#10+
                  'Language Reference'+#10+
                  'Operations Guide'+#10+
                  'Programmer''s Guide'+#10+
                  'InterBase Tutorial'+#10+
                  'Communication Diagnostics'+#10+
                  'Server Manager'+#10+
                  'InterBase Windows ISQL';


  ShortcutTargets = '%sBiniblicense.exe'+#10+
                    '%sReleasenotes.pdf'+#10+
                    '%sLICENSE.TXT'+#10+
                    '%sBinib32.hlp'+#10+
                    '%sBinperform.hlp'+#10+
                    '%sdocAPIGuideAPIGuide.pdf'+#10+
                    '%sdocDataDefDataDef.pdf'+#10+
                    '%sdocLangRefLangRef.pdf'+#10+
                    '%sdocOpGuideOpGuide.pdf'+#10+
                    '%sdocProgGdProgGd.pdf'+#10+
                    '%sdocTutorialTutorial.pdf'+#10+
                    '%sBincomdg32.exe'+#10+
                    '%sBinibmgr32.exe'+#10+
                    '%sBinwisql32.exe';
var
  SLinkObject  : IUnknown;
  SLink   : IShellLink;
  PFile   : IPersistFile;
  StartMenuDir : pChar;
  WorkingDir: pChar;
  StartFolderPath: String;
  ppidl        : pItemIDList;
  SLinkNamesList: TStringList;
  SLinkTargetsList: TStringList;
  WLinkName: WideString;
  i: integer;
  verInfo: TOSVersionInfo;
begin
  { Find out what ersion of windows we are usnig. }
  verInfo.dwOSVersionInfoSize := sizeOf(verInfo);
  GetVersionEx(verInfo);
  SLinkNamesList := TStringList.create;
  SLinkTargetsList := TStringList.create;

  { If we are isntalling on NT then the program group will
  { be a common group, else it will not since 95/98 does
  { not support this concept }
  if (verinfo.dwPlatformId = VER_PLATFORM_WIN32_NT) then
    SHGetSpecialFolderLocation(0, CSIDL_COMMON_PROGRAMS, ppidl)
  else
    SHGetSpecialFolderLocation(0, CSIDL_PROGRAMS, ppidl);

  { Create the Start menu folder (directory) }
  StartMenuDir := StrAlloc(MAX_PATH);
  SHGetPathFromIDList(ppidl, StartMenuDir);
  StartFolderPath := StrPas(StartMenuDir) + 'InterBase';
  StrDispose (StartMenuDir);
  CreateDir(StartFolderPath);

  { Calculate the working directory }
  WorkingDir := StrAlloc(MAX_PATH);
  StrCopy(WorkingDir,PChar(DestinationDirFld.Text));
  StrCat(WorkingDir,PChar('bin'));

  SLinkNamesList.text := ShortcutNames;
  SLinkTargetsList.text := ShortcutTargets;

  { For each element in the list check to see if the
  { target exists.  If it does, then create the start menu
  { shortcut for it. }
  for i := 0 to SLinkNamesList.count - 1 do
    begin
      if (FileExists(SLinkTargetsList.strings[i])) then
        begin
          SLinkObject := CreateComObject (CLSID_ShellLink);
          SLink := SLinkObject as IShellLink;
          PFile := SLinkObject as IPersistFile;
          SLink.SetPath (pChar (Format(SLinkTargetsList.Strings[i],[DestinationDirFld.Text])));
          SLink.SetWorkingDirectory (WorkingDir);
          WLinkName := StartFolderPath + '' + SLinkNamesList.Strings[i] + '.lnk';
          PFile.Save (PWChar (WlinkName),False);
        end;
    end;

  { Notify the OS that something has changed, and that it
  { should do what ever is necessary to notice it. }
  SHChangeNotify (SHCNE_MKDIR, SHCNF_PATH, pChar(StartFolderPath), nil);
  SLinkNamesList.destroy;
  SLinkTargetsList.destroy;
  MessageDlg('Shortcuts created Successfully',MtInformation,[mbok],0);
end;

{ TODO 9: Start the guardian process (optional) }
procedure TInteractiveInstallDemoFrm.StartGuardianBtnClick(Sender: TObject);
var
  hManager: SC_HANDLE;
  hService: SC_HANDLE;
  verInfo: TOSVersionInfo;
  ServiceArgs: PChar;
  StartupInfo: TStartupInfo;
  ProcessInformation: TProcessInformation;
const
  GUARDIAN_SERVICE_NAME = 'InterBaseGuardian';
  GUARDIAN_APPLICATION_NAME = '%sbinibguard.exe';
begin
  if not StartServer then
    begin
      verInfo.dwOSVersionInfoSize := sizeOf(verInfo);
      GetVersionEx(verInfo);
      { If we are on NT, then contact the services manager and
      { ask it to start the guardian. }
      if (verinfo.dwPlatformId = VER_PLATFORM_WIN32_NT) then
        begin
          ServiceArgs := nil;
          hManager := OpenSCManager(nil,nil,SC_MANAGER_CONNECT);
          hService := OpenService(hManager,GUARDIAN_SERVICE_NAME,SERVICE_START);
          if (hService = 0) then
            MessageDlg('Could not start Service',mtError,[mbOk],0)
          else
           if not StartService(hService, 0, ServiceArgs) then
             if not GetLastError() = ERROR_SERVICE_ALREADY_RUNNING then
               MessageDlg('Could not start Guardian Service',mtError,[mbOk],0);
          CloseServiceHandle(hManager);
          CloseServiceHandle(hService);
        end
      { If we are on 95/98 then we must create the process. }
      else
        begin
          StartupInfo.cb := sizeof(StartupInfo);
          StartupInfo.lpReserved := nil;
          StartupInfo.lpTitle:= nil;
          StartupInfo.lpDesktop := nil;
          StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
          StartupInfo.wShowWindow := SW_SHOWNA;
          StartupInfo.cbReserved2 := 0;
          StartupInfo.lpReserved2 := nil;
          if not CreateProcess(nil,PChar(Format(GUARDIAN_APPLICATION_NAME,[DestinationDirFld.Text])),
                               nil,nil,False,NORMAL_PRIORITY_CLASS,nil,
                               PChar(DestinationDirFld.Text),StartupInfo,ProcessInformation) then
            MessageDlg('Could not start Guardian',mtError,[mbOk],0);
        end;
    end;
end;

{ TODO 10: Register Uninastall program (optional) }
procedure TInteractiveInstallDemoFrm.RegisterUninstallBtnClick(Sender: TObject);
var
  retval   : longint;
  regHndl  : HKey;
  security : REGSAM;
  KeyMade  : Dword;
  UninstallString: String;
const
  RegUninstallKey = 'SOFTWAREMicrosoftWindowsCurrentVersionUninstallInterBase';
  RegUninstallName = 'InterBase Demo Install/Uninstall';
  RegUninstallString = '"%sInteractive_Uninstall_Demo.exe" "%s"';
begin
  { Open the registry and add an uninstall key.  This will appear in the
  { Control Panel, Add/Remove Programs list. }
  security := KEY_ALL_ACCESS;
  retval := RegOpenKeyEx(HKEY_LOCAL_MACHINE,RegUninstallKey,0,security,regHndl);
  if not (retval = ERROR_SUCCESS) then
    retval := RegCreateKeyEx(HKEY_LOCAL_MACHINE,RegUninstallKey,0,'',
              REG_OPTION_NON_VOLATILE,KEY_WRITE,nil,regHndl,@KeyMade);
  if (retval = ERROR_SUCCESS) or (KeyMade = REG_CREATED_NEW_KEY) then
    begin
     if not (RegSetValueEx(regHndl,'DisplayName',0,REG_SZ,PChar(RegUninstallName),
	 length(RegUninstallName)+1) = ERROR_SUCCESS) then
       MessageDlg('Could not create uninstall registry key',mtError,[mbOk],0);
     UninstallString := Format(RegUninstallString,[DestinationDirFld.Text,UninstallFilenameFld.Text]);
     if not (RegSetValueEx(regHndl,'UninstallString',0,REG_SZ,PChar(UninstallString),
	 length(UninstallString)+1) = ERROR_SUCCESS) then
       MessageDlg('Could not create uninstall registry key',mtError,[mbOk],0)
     else
       MessageDlg('Uninstall Registered Successfully',MtInformation,[mbok],0);
    end
  else
    MessageDlg('Could not create uninstall registry key',mtError,[mbOk],0);
  RegCloseKey(regHndl);
end;

{**********************************}
{ Private Functions and procedures }
{**********************************}

function TInteractiveInstallDemoFrm.DisplayErrorMessage(handle: OPTIONS_HANDLE; error: MSG_NO): word;
var
  msg: PChar;
begin
  msg := StrAlloc(ISC_INSTALL_MAX_MESSAGE_LEN);
  isc_install_get_message(handle, error, msg, ISC_INSTALL_MAX_MESSAGE_LEN);
  if (error < isc_install_success) then
    result := MessageDlg(Strpas(msg),mtWarning,[mbOK, mbIgnore],0)
  else
    result := MessageDlg(Strpas(msg),mtWarning,[mbOK],0);
  StrDispose(msg);
end;

{****************************************************}
{ Call-back functions for Error and status reporting }
{****************************************************}

{ TODO 6: Setup Error Handling Callback function }
function DisplayError(msg: MSG_NO; data: pointer; error_msg: TEXT): integer;
var
  retval: word;
begin
if (not InteractiveInstallDemoFrm.Cancelling) then
  begin
    retval := mrIgnore;
    if (msg = isc_install_fp_copy_delayed) or (msg = isc_install_fp_delete_delayed) then
      InteractiveInstallDemoFrm.RebootMessage := true
    else
        retval := InteractiveInstallDemoFrm.DisplayErrorMessage
		(InteractiveInstallDemoFrm.OptionsHandle, msg);
    if retval = mrIgnore then
      result := isc_install_fp_continue
    else
      begin
        InteractiveInstallDemoFrm.Cancelling := true;
        result := isc_install_fp_abort;
      end;
  end
else
  result := isc_install_fp_abort;
end;

{ TODO 6: Setup Status Handling Callback function }
function DisplayStatus(status: integer; data: pointer; const status_msg: TEXT): integer;
begin
  InteractiveInstallDemoFrm.InstallProgressGauge.Progress := status;
  Application.ProcessMessages;
  result := isc_install_fp_continue;
end;

end.


B: Demo Install Program Source
unit Uninstall_Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Gauges, StdCtrls, IBInstall, ComCtrls, ShlObj, ExtCtrls;

type
  TInteractiveUninstallDemoFrm = class(TForm)
    Step1GrpBx: TGroupBox;
    UninstallFilenameFld: TEdit;
    PerformUninstallBtn: TButton;
    UninstallProgressGauge: TGauge;
    Step2GrpBx: TGroupBox;
    Step3GrpBx: TGroupBox;
    RemoveUninstallEntryBtn: TButton;
    RemoveStartMenuShortcutsBtn: TButton;
    procedure PerformUninstallBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RemoveUninstallEntryBtnClick(Sender: TObject);
    procedure RemoveStartMenuShortcutsBtnClick(Sender: TObject);
  private
    { Private declarations }
    RebootMessage: Boolean;
    Cancelling: Boolean;
    function DisplayErrorMessage(error: MSG_NO): word;
  public
    { Public declarations }
  end;

function DisplayError(msg: MSG_NO; data: pointer; error_msg: TEXT): integer; export; stdcall;
function DisplayStatus(status: integer; data: pointer; const status_msg: TEXT): integer; export; stdcall;

var
  InteractiveUninstallDemoFrm: TInteractiveUninstallDemoFrm;

implementation

{$R *.DFM}

procedure TInteractiveUninstallDemoFrm.FormCreate(Sender: TObject);
begin
  if ParamCount >= 1 then
    UninstallFilenameFld.Text := ParamStr(1);
end;

{*****************************************}
{ Three easy steps to uninstall InterBase }
{*****************************************}

{ TODO 1: Perform Uninstall }
procedure TInteractiveUninstallDemoFrm.PerformUninstallBtnClick(Sender: TObject);
var
  err_no: MSG_NO;
begin
  { Ask the install API to undo what ever it logged in the uninstall file. }
  err_no := isc_uninstall_execute(PChar(UninstallFileNameFld.text),
  @DisplayStatus, nil, @DisplayError, nil);
  if (err_no <> isc_install_success) then
    begin
      DisplayErrorMessage(error);
    end;
  { Display a message if there is a need to reboot.  This might be needed if
  { some files could not be copied because they were in use.  In this case they
  { were set up for a delayed copy, and this will be done on the next reboot. }
  if (RebootMessage) then
    MessageDlg('You must reboot in order for uninstall to finish!',mtInformation, [mbok], 0)
  else
    MessageDlg('Uninstalled Successfully!',mtInformation, [mbok], 0);
end;

{ TODO 2: Unregiter uninstall (optional) }
procedure TInteractiveUninstallDemoFrm.RemoveUninstallEntryBtnClick(
  Sender: TObject);
var
  security : REGSAM;
  regHndl  : HKey;
  retval: longint;
begin
  { Since we are now uninstalled, we should remove the uninstall entry
  { from the list in Control Panel | Add/Remove Programs which was added
  { by the install program. }
  security := KEY_ALL_ACCESS;
  retval := RegOpenKeyEx(HKEY_LOCAL_MACHINE,nil,0,security,regHndl);
  if (retval = ERROR_SUCCESS) then
    begin
      RegDeleteKey(HKEY_LOCAL_MACHINE,'SOFTWAREMicrosoftWindowsCurrentVersionUninstallInterBase');
    end;
  RegCloseKey(regHndl);
end;

{ TODO 3: Remove Shortcuts (optional) }
procedure TInteractiveUninstallDemoFrm.RemoveStartMenuShortcutsBtnClick(
  Sender: TObject);
const
  RootShortcutNames = 'Communication Diagnostics'+#10+
                      'InterBase Configuration Tool'+#10+
                      'InterBase Guardian'+#10+
                      'InterBase Server'+#10+
                      'License Registration Tool'+#10+
                      'Server Manager'+#10+
                      'InterBase Windows ISQL'+#10+
                      'Release Notes'+#10+
                      'License Agreement';

  DocsShortcutNames = 'InterBase Help'+#10+
                      'Performance Help'+#10+
                      'API Reference Guide'+#10+
                      'Data Definition Guide'+#10+
                      'Language Reference'+#10+
                      'Operations Guide'+#10+
                      'Programmer''s Guide'+#10+
                      'InterBase Tutorial';
var
  verInfo: TOSVersionInfo;
  StartMenuDir: pChar;
  StartFolderPath: String;
  ppidl: pItemIDList;
  SLinkNamesList: TStringList;
  i: integer;
begin
  { In the same way that the install program added the start menu
  { shortcuts, the uninstall should remove them. }
  verInfo.dwOSVersionInfoSize := sizeOf(verInfo);
  GetVersionEx(verInfo);
  if (verinfo.dwPlatformId = VER_PLATFORM_WIN32_NT) then
    SHGetSpecialFolderLocation(0, CSIDL_COMMON_PROGRAMS, ppidl)
  else
    SHGetSpecialFolderLocation(0, CSIDL_PROGRAMS, ppidl);
  StartMenuDir := StrAlloc(MAX_PATH);
  SHGetPathFromIDList(ppidl, StartMenuDir);
  StartFolderPath := StrPas(StartMenuDir) + 'InterBase';
  StrDispose (StartMenuDir);
  SLinkNamesList := TStringList.create;
  
  SLinkNamesList.text := RootShortcutNames;
  for i := 0 to SLinkNamesList.count - 1 do
    DeleteFile(StartFolderPath + '' + SLinkNamesList.Strings[i] + '.lnk');
  SLinkNamesList.text := DocsShortcutNames;
  for i := 0 to SLinkNamesList.count - 1 do
    DeleteFile(StartFolderPath + 'Documentation' + SLinkNamesList.Strings[i] + '.lnk');
  RemoveDir(StartFolderPath + 'Documentation');
  RemoveDir(StartFolderPath);
end;


{**********************************}
{ Private Functions and procedures }
{**********************************}

function TInteractiveUninstallDemoFrm.DisplayErrorMessage(error: MSG_NO): word;
var
  msg: PChar;
begin
  msg := StrAlloc(ISC_INSTALL_MAX_MESSAGE_LEN);
  isc_install_get_message(0, error, msg, ISC_INSTALL_MAX_MESSAGE_LEN);
  if (error < isc_install_success) then
    result := MessageDlg(Strpas(msg),mtWarning,[mbOK, mbIgnore],0)
  else
    result := MessageDlg(Strpas(msg),mtWarning,[mbOK],0);
  StrDispose(msg);
end;

{****************************************************}
{ Call-back functions for Error and status reporting }
{****************************************************}

{ TODO 1: Supply an error handling call-back function (optional) }
function DisplayError(msg: MSG_NO; data: pointer; error_msg: TEXT): integer;
var
  retval: word;
begin
  if not InteractiveUninstallDemoFrm.Cancelling then
    begin
      retval := mrIgnore;
      if (msg = isc_install_fp_copy_delayed) or (msg = isc_install_fp_delete_delayed) then
        InteractiveUninstallDemoFrm.RebootMessage := true
      else
          retval := InteractiveUninstallDemoFrm.DisplayErrorMessage(msg);
      if retval = mrIgnore then
        result := isc_install_fp_continue
      else
        begin
          InteractiveUninstallDemoFrm.Cancelling := true;
          result := isc_install_fp_abort;
        end;
    end
  else
    result := isc_install_fp_abort;
end;

{ TODO 1: Supply a status handling call-back function (options) }
function DisplayStatus(status: integer; data: pointer; const status_msg: TEXT): integer;
begin
  InteractiveUninstallDemoFrm.UninstallProgressGauge.Progress := status;
  Application.ProcessMessages;
  result := isc_install_fp_continue;
end;

end.