ib_install.pas

FIBPlus version 6-96. This is somewhat usefull interbase database components. TFIBDatabase, TFIBTab

begin
  if FIBInstallLoaded then
    FInstallOptions.Free;
  inherited;
end;

procedure TpFIBInstall.InstallCheck;
var
  Handle : OPTIONS_HANDLE;
  SrcDir, DestDir : PChar;
begin
  Handle := 0;
  InternalSetOptions(@Handle);

  if FSourceDir = '' then
    SrcDir := nil
  else
    SrcDir := PChar(FSourceDir);

  if FDestinationDir = '' then
    DestDir := nil
  else
    DestDir := PChar(FDestinationDir);

  try
    Call(isc_install_precheck(Handle, SrcDir, DestDir));
  finally
    isc_install_clear_options(@Handle);
  end;
end;

procedure TpFIBInstall.InstallExecute;
var
  Handle : OPTIONS_HANDLE;
begin
  Handle := 0;
  InternalSetOptions(@Handle);

  if Handle = 0 then
    IBInstallerError(ieNoOptionsSet, ['']);

  try
    SetLength(FUninstallFile, ISC_INSTALL_MAX_PATH);
    Call(isc_install_execute(Handle, PChar(FSourceDir), PChar(FDestinationDir),
                            StatusCallback, Pointer(self), ErrorCallback,
                            Pointer(self), PChar(FUninstallFile)));
    SetLength(FUninstallFile, StrLen(PChar(FUninstallFile)));
  finally
    isc_install_clear_options(@Handle);
  end;
end;

procedure TpFIBInstall.InternalSetOptions(pHandle: POPTIONS_HANDLE);
begin
  with FInstallOptions do
  begin
    if FMainComponents <> [] then
    begin
     if moClient in  FMainComponents then
       isc_install_set_option(pHandle, IB_CLIENT);
     if moDevelopment in FMainComponents then
       isc_install_set_option(pHandle, IB_DEV);
     if moServer in FMainComponents then
       isc_install_set_option(pHandle, IB_SERVER);
     if  moDocumentation in FMainComponents then
       isc_install_set_option(pHandle, IB_DOC);
     if moConServer in FMainComponents then
       isc_install_set_option(pHandle, IB_CONNECTIVITY_SERVER);
     if moGuiTools in FMainComponents then
       isc_install_set_option(pHandle, IB_GUI_TOOLS);
    end;

    if FExamples <> [] then
    begin
     if exDB in FExamples  then
       isc_install_set_option(pHandle, IB_EXAMPLE_DB);
     if exAPI in FExamples then
       isc_install_set_option(pHandle, IB_EXAMPLE_API);
    end;

    if FCmdLineTools  <> [] then
    begin
     if cmDBMgmt in FCmdLineTools then
        isc_install_set_option(pHandle, IB_CMD_TOOLS_DB_MGMT);
     if cmDBQuery in FCmdLineTools then
        isc_install_set_option(pHandle, IB_CMD_TOOLS_DB_QUERY);
     if cmUsrMgmt in FCmdLineTools then
        isc_install_set_option(pHandle, IB_CMD_TOOLS_USR_MGMT);
    end;

    if FConnectivityClients <> [] then
    begin
     if cnODBC in FConnectivityClients then
       isc_install_set_option(pHandle, IB_ODBC_CLIENT);
     if cnOLEDB in FConnectivityClients then
       isc_install_set_option(pHandle, IB_OLEDB_CLIENT);
     if  cnJDBC in FConnectivityClients then
        isc_install_set_option(pHandle, IB_JDBC_CLIENT);
    end;
  end;
end;

procedure TpFIBInstall.SetDestination(const Value: string);
var
  IscCode  : MSG_NO;
begin
  if Value <> '' then
  begin
    IscCode := isc_install_precheck(0, nil, PChar(Value));
    if(IscCode > isc_install_success) then
     IBInstallError(IscCode);
  end;
  FDestinationDir := Value;
end;

procedure TpFIBInstall.SetInstallOptions(const Value: TInstallOptions);
begin
  if FInstallOptions <> Value then
    FInstallOptions.Assign(Value);
end;

procedure TpFIBInstall.SetSource(const Value: string);
var
  IscCode  : MSG_NO;
begin
  if Value <> '' then
  begin
    IscCode := isc_install_precheck(0, PChar(Value), nil);
    if(IscCode > isc_install_success) then
      IBInstallError(IscCode);
    end;
  FSourceDir := Value;
end;

procedure TpFIBInstall.SuggestDestination;
begin
  SetLength(FSuggestedDestination, ISC_INSTALL_MAX_PATH);
  Call(isc_install_get_info(isc_install_info_destination, 0, PChar(FSuggestedDestination),
                           ISC_INSTALL_MAX_PATH));
  SetLength(FSuggestedDestination, StrLen(PChar(FSuggestedDestination)));
end;

function TpFIBInstall.GetOptionDescription(Option: TExamplesOption): string;
var
  OptionDesc : string;
begin
  SetLength(OptionDesc, ISC_INSTALL_MAX_MESSAGE_LEN);
  GetOptionProperty(isc_install_info_opdescription, Option, PChar(OptionDesc),
                   ISC_INSTALL_MAX_MESSAGE_LEN);
  SetLength(OptionDesc, StrLen(PChar(OptionDesc)));
  Result := OptionDesc;
end;

function TpFIBInstall.GetOptionDescription3(Option: TCmdOption): string;
var
  OptionDesc : string;
begin
  SetLength(OptionDesc, ISC_INSTALL_MAX_MESSAGE_LEN);
  GetOptionProperty3(isc_install_info_opdescription, Option, PChar(OptionDesc),
                   ISC_INSTALL_MAX_MESSAGE_LEN);
  SetLength(OptionDesc, StrLen(PChar(OptionDesc)));
  Result := OptionDesc;
end;

function TpFIBInstall.GetOptionDescription2(Option: TConnectivityOption): string;
var
  OptionDesc : string;
begin
  SetLength(OptionDesc, ISC_INSTALL_MAX_MESSAGE_LEN);
  GetOptionProperty2(isc_install_info_opdescription, Option, PChar(OptionDesc),
                   ISC_INSTALL_MAX_MESSAGE_LEN);
  SetLength(OptionDesc, StrLen(PChar(OptionDesc)));
  Result := OptionDesc;
end;

function TpFIBInstall.GetOptionDescription1(Option: TMainOption): string;
var
  OptionDesc : string;
begin
  SetLength(OptionDesc, ISC_INSTALL_MAX_MESSAGE_LEN);
  GetOptionProperty1(isc_install_info_opdescription, Option, PChar(OptionDesc),
                   ISC_INSTALL_MAX_MESSAGE_LEN);
  SetLength(OptionDesc, StrLen(PChar(OptionDesc)));
  Result := OptionDesc;
end;

function TpFIBInstall.GetOptionName(Option: TExamplesOption): string;
var
  OptionName : string;
begin
  SetLength(OptionName, ISC_INSTALL_MAX_MESSAGE_LEN);
  GetOptionProperty(isc_install_info_opname, Option, PChar(OptionName),
                   ISC_INSTALL_MAX_MESSAGE_LEN);
  SetLength(OptionName, StrLen(PChar(OptionName)));
  Result := OptionName;
end;

function TpFIBInstall.GetOptionName3(Option: TCmdOption): string;
var
  OptionName : string;
begin
  SetLength(OptionName, ISC_INSTALL_MAX_MESSAGE_LEN);
  GetOptionProperty3(isc_install_info_opname, Option, PChar(OptionName),
                   ISC_INSTALL_MAX_MESSAGE_LEN);
  SetLength(OptionName, StrLen(PChar(OptionName)));
  Result := OptionName;
end;

function TpFIBInstall.GetOptionName2(Option: TConnectivityOption): string;
var
  OptionName : string;
begin
  SetLength(OptionName, ISC_INSTALL_MAX_MESSAGE_LEN);
  GetOptionProperty2(isc_install_info_opname, Option, PChar(OptionName),
                  ISC_INSTALL_MAX_MESSAGE_LEN);
  SetLength(OptionName, StrLen(PChar(OptionName)));
  Result := OptionName;
end;

function TpFIBInstall.GetOptionName1(Option: TMainOption): string;
var
  OptionName : string;
begin
  SetLength(OptionName, ISC_INSTALL_MAX_MESSAGE_LEN);
  GetOptionProperty1(isc_install_info_opname, Option, PChar(OptionName),
                   ISC_INSTALL_MAX_MESSAGE_LEN);
  SetLength(OptionName, StrLen(PChar(OptionName)));
  Result := OptionName;
end;

function TpFIBInstall.GetOptionSpaceRequired(Option: TExamplesOption): cardinal;
var
  OptionSpace : cardinal;
begin
  GetOptionProperty(isc_install_info_opspace, Option, @OptionSpace,
                    Cardinal(SizeOf(OptionSpace)));
  Result := OptionSpace;
end;

function TpFIBInstall.GetOptionSpaceRequired1(Option: TMainOption): cardinal;
var
  OptionSpace : cardinal;
begin
  GetOptionProperty1(isc_install_info_opspace, Option, @OptionSpace,
                    Cardinal(SizeOf(OptionSpace)));
  Result := OptionSpace;
end;

function TpFIBInstall.GetOptionSpaceRequired2(Option: TConnectivityOption): cardinal;
var
  OptionSpace : cardinal;
begin
  GetOptionProperty2(isc_install_info_opspace, Option, @OptionSpace,
                    Cardinal(SizeOf(OptionSpace)));
  Result := OptionSpace;
end;

function TpFIBInstall.GetOptionSpaceRequired3(Option: TCmdOption): cardinal;
var
  OptionSpace : cardinal;
begin
  GetOptionProperty3(isc_install_info_opspace, Option, @OptionSpace,
                   Cardinal(SizeOf(OptionSpace)));
  Result := OptionSpace;
end;

procedure TpFIBInstall.GetOptionProperty1(InfoType: Integer; Option : TMainOption;
                                       Buffer: Pointer; BufferLen : Cardinal);
var
 IscOption : OPT;
begin
  case Option of
    moClient:
     IscOption := IB_CLIENT;
    moDevelopment:
     IscOption := IB_DEV;
    moServer:
     IscOption :=  IB_SERVER;
    moDocumentation:
     IscOption := IB_DOC;
    moGuiTools:
     IscOption := IB_GUI_TOOLS;
    else
     IscOption :=  IB_CONNECTIVITY_SERVER;
  end;
  Call(isc_install_get_info(InfoType, IscOption, Buffer, BufferLen));
end;

procedure TpFIBInstall.GetOptionProperty(InfoType: Integer; Option: TExamplesOption;
                                       Buffer: Pointer; BufferLen : Cardinal);
var
 IscOption : OPT;
begin
  case Option of
     exDB:
       IscOption := IB_EXAMPLE_DB;
     else
       IscOption := IB_EXAMPLE_API;
   end;
   Call(isc_install_get_info(InfoType, IscOption, Buffer, BufferLen));
end;

procedure TpFIBInstall.GetOptionProperty3(InfoType: Integer; Option: TCmdOption;
                                       Buffer: Pointer; BufferLen : Cardinal);
var
 IscOption : OPT;
begin
  case Option of
    cmDBMgmt:
      IscOption := IB_CMD_TOOLS_DB_MGMT;
        cmDBQuery:
      IscOption := IB_CMD_TOOLS_DB_QUERY;
        else
      IscOption := IB_CMD_TOOLS_USR_MGMT;
  end;
  Call(isc_install_get_info(InfoType, IscOption, Buffer, BufferLen));
end;

procedure TpFIBInstall.GetOptionProperty2(InfoType: Integer; Option: TConnectivityOption;
                                       Buffer: Pointer; BufferLen : Cardinal);
var
 IscOption : OPT;
begin
  case Option of
    cnODBC:
     IscOption :=  IB_ODBC_CLIENT;
    cnOLEDB:
     IscOption := IB_OLEDB_CLIENT;
    else
     IscOption := IB_JDBC_CLIENT;
  end;
  Call(isc_install_get_info(InfoType, IscOption, Buffer, BufferLen));
end;

{ TpFIBUnInstall }

procedure TpFIBUnInstall.UnInstallCheck;
begin
  if FUninstallFile = '' then
    IBInstallerError(ieNoUninstallFile, ['']);

  Call(isc_uninstall_precheck(PChar(FUninstallFile)));
end;

procedure TpFIBUnInstall.UnInstallExecute;
begin
  if FUninstallFile = '' then
    IBInstallerError(ieNoUninstallFile, ['']);

  Call(isc_uninstall_execute(PChar(FUninstallFile), StatusCallback, Pointer(self),
                             ErrorCallback, Pointer(self)));
end;

{ EIBInstall }

constructor EIBInstall.Create(IscCode: MSG_NO; IscMessage: string);
begin
   inherited Create(IscMessage);
   FIscError := IscCode;
   FInstallerError := ieSuccess;
end;

constructor EIBInstall.Create1(ECode: TIBInstallerError; EMessage: string);
begin
  inherited Create(EMessage);
  FInstallerError := ECode;
  FIscError := isc_install_success;
end;

end.