Mega Code Archive
Embedd an IB installation in your own WISE install
<![CDATA[
Title: Embedd an IB installation in your own WISE install
Question: How can I easily embedd the Interbase installation in my own install?
Answer:
Here is an example on how you can use WISE to embedd an Interbase Installation and install IB using the IBINSTALL.DLL
Some notes about how it all works
---------------------------------
WISE InstallBuilder and other Installation tools from WISE Solutions can call DLL files during the
installation progress.
This is used to call IBWISE.DLL, a DLL written in Delphi (code below) that reads WISE variables and then
pass them further to the IBINSTALL.DLL (suplied by Interbase).
IBINSTALL.DLL does the actual installation work of Interbase but the IBWISE.DLL wraps it and adds
option handling, error control and progress showing.
The IBWISE.DLL also returns back any status messages to WISE from IBINSTALL.DLL.
For more information about WISE or Borland Interbase, see the "More information" section at the end
of this document.
Things need to be done in your WISE script
------------------------------------------
The WISE variables is needed for the IBWISE.DLL file, make sure they are setup in WISE before
calling the IBWISE.DLL file:
In variables (Read by the IBWISE.DLL to run the Interbase Install)
IBINSTALLMODE String, Can be set to R and/or S
R = Start (Run) Interbase after Install
S = Silent installation (no progress window is called)
Example: Set Variable IBINSTALLMODE to RS
(Runs the IB installation in silent mode and starts the IB server after install)
IBOPTIONS (Optional) String, Set this variable to control what part of interbase that should be installed.
[Empty] = All Interbase files
A = IB_SERVER
B = IB_CLIENT
C = IB_CMD_TOOLS
D = IB_CMD_TOOLS_DB_MGMT
E = IB_CMD_TOOLS_USR_MGMT
F = IB_CMD_TOOLS_DB_QUERY
G = IB_GUI_TOOLS
H = IB_DOC
I = IB_EXAMPLES
J = IB_EXAMPLE_API
K = IB_EXAMPLE_DB
L = IB_DEV
M = IB_REPLICATION
N = IB_REPL_MANAGER
O = IB_REPL_SERVER
P = IB_CONNECTIVITY
Q = IB_ODBC_CLIENT
R = IB_JDBC
S = IB_JDBC_CLIENT
T = IB_JDBC_SERVER
Example: Set Variable IBOPTIONS to AB
(Installs the Interbase Server and Client files)
IBSRCDIR String, The Path to the Insterbase source files, usually a temp directory that WISE have unpacked the files to.
IBDESTDIR (Optional) String, The Directory in which Interbase is installed, If this variable is empty, the interbase installation uses a default directory.
Out variables (Used by the IBWISE.DLL to return results to WISE)
IBUIFILE String, the uninstall file that should be used with IBUNINST.EXE
IBSTATUS String, a status text that contains the error text if the installation didn't complete ok. If there was no error during the installation, this string contains 'Success'.
Example on how to set these variables, install the Interbase source files and start the installation.
Copy the code below and insert it into your WISE script.
(Don't forget to change the source path to the IB Files on your computer)
item: Open/Close INSTALL.LOG
Flags=00000001
end
item: Create Directory
Pathname=%TEMP%\INTERBASE\
end
item: Install File
Source=C:\install\InterBaseServer\*.*
Destination=%TEMP%\INTERBASE\
Flags=0000000110100010
end
item: Install File
Source=C:\install\IBWISE\Ibwise.dll
Destination=%TEMP%\INTERBASE\Ibwise.dll
Flags=0000000010100010
end
item: Open/Close INSTALL.LOG
end
item: Set Variable
Variable=IBINSTALLMODE
Value=R
end
item: Set Variable
Variable=IBOPTIONS
Value=A
end
item: Set Variable
Variable=IBSRCDIR
Value=%TEMP%\INTERBASE\
end
item: Call DLL Function
Pathname=%TEMP%\INTERBASE\IBWISE.DLL
Function Name=InstallInterbase
Variables Added=IBUIFILE,IBSTATUS
Return Variable=0
Flags=00000100
end
item: Open/Close INSTALL.LOG
Flags=00000001
end
item: Delete File
Pathname=%TEMP%\INTERBASE
Flags=00000100
end
item: Open/Close INSTALL.LOG
end
--------------------------------------------------------------------------------
The IBWISE.DLL file and it's source code (Delphi)
The code below is for Borland delphi and shows how the IBWISE.DLL is built.
You can download the fully source here
IBWISE.DPR
library IBWISE;
uses
SysUtils,
Classes,
IBWiseUnit in 'IBWiseUnit.pas',
StatusFormUnit in 'StatusFormUnit.pas' {StatusForm};
exports
InstallInterbase,
GetIBInstallDir;
{$R *.RES}
begin
end.
IBWiseUnit.pas
unit IBWiseUnit;
//
// WISE InstallIBServer version 1.1 by Magnus Flysj
// flysjo@algonet.se
// Copyright 2001, Magnus Flysj
//
interface
uses WinTypes, WinProcs, SysUtils, WinSvc;
//[Wise]
Type
ParamRec = record
wStructLen: DWORD; { The length of the structure }
hMainWnd: HWND; { Handle to main window }
wMaxReplaces: DWORD; { Maximum number of replaces }
wRepNameWidth: DWORD; { The width of a replace name }
wRepStrWidth: DWORD; { The width of each replace string }
wCurrReps: DWORD; { Current number of replace strings }
szRepName: PChar; { The actual replace names }
szRepStr: PChar; { The actual replace values }
wRunMode: DWORD; { The installation mode }
fLogFile: DWORD; { A file handle to the log file }
szParam: PChar; { String parameter from Wise Installation System }
end;
//[Interbase]
OPTIONS_HANDLE = Integer;
POPTIONS_HANDLE = ^OPTIONS_HANDLE;
MSG_NO = Longint;
OPT = Longint;
TEXT = PChar;
FP_ERROR = function(msg: MSG_NO; data: Pointer; error_msg: TEXT): Integer; stdcall;
FP_STATUS = function(status: integer; data: Pointer; const status_msg: TEXT): Integer; stdcall;
TIsc_install_clear_options = function (pHandle: POPTIONS_HANDLE):MSG_NO; stdcall;
TIsc_install_execute = function (Handle: OPTIONS_HANDLE; src_dir, dest_dir: TEXT;
status_func: FP_STATUS; status_data: Pointer;
error_func: FP_ERROR; error_data: Pointer;
uninstal_file_name: TEXT):MSG_NO; stdcall;
TIsc_install_get_info = function (info_type :integer; option :OPT; info_buffer : Pointer;
buf_len : Cardinal): MSG_NO; stdcall;
TIsc_install_get_message = function (Handle: OPTIONS_HANDLE; message_no: MSG_NO;
message_txt: Pointer; message_len: Cardinal):
MSG_NO; stdcall;
TIsc_install_load_external_text = function (msg_file_name: TEXT):MSG_NO; stdcall;
TIsc_install_precheck = function (Handle: OPTIONS_HANDLE; src_dir, dest_dir: TEXT): MSG_NO; stdcall;
TIsc_install_set_option = function (pHandle: POPTIONS_HANDLE; option: OPT): MSG_NO; stdcall;
TIsc_uninstall_execute = function (uninstall_file_name: TEXT; status_func: FP_STATUS;
status_data: pointer; error_func: FP_ERROR; error_data: pointer): MSG_NO; stdcall;
TIsc_uninstall_precheck = function (uninstall_file_name: TEXT):MSG_NO; stdcall;
TIsc_install_unset_option = function (pHandle: POPTIONS_HANDLE; option: OPT):MSG_NO; stdcall;
const
IB_INSTALL_DLL = 'ibinstall.dll';
{ These are the values the FP_ERROR routine can return. }
isc_install_fp_retry = -1;
isc_install_fp_continue = 0;
isc_install_fp_abort = 1;
{ isc_install_get_info info_types }
isc_install_info_destination = 1;
isc_install_info_opspace = 2;
isc_install_info_opname = 3;
isc_install_info_opdescription = 4;
ISC_INSTALL_MAX_MESSAGE_LEN = 300;
ISC_INSTALL_MAX_MESSAGES = 200;
ISC_INSTALL_MAX_PATH = MAX_PATH;
{ Basic Components used to install InterBase }
INTERBASE = 1000;
IB_SERVER = 1001;
IB_CLIENT = 1002;
IB_CMD_TOOLS = 1003;
IB_CMD_TOOLS_DB_MGMT = 1004;
IB_CMD_TOOLS_USR_MGMT = 1005;
IB_CMD_TOOLS_DB_QUERY = 1006;
IB_GUI_TOOLS = 1007;
IB_DOC = 1011;
IB_EXAMPLES = 1012;
IB_EXAMPLE_API = 1013;
IB_EXAMPLE_DB = 1014;
IB_DEV = 1015;
IB_REPLICATION = 1016;
IB_REPL_MANAGER = 1017;
IB_REPL_SERVER = 1018;
IB_CONNECTIVITY = 1101;
IB_ODBC_CLIENT = 1102;
IB_JDBC = 1110;
IB_JDBC_CLIENT = 1103;
IB_JDBC_SERVER = 1105;
{ Error and warning codes }
isc_install_optlist_empty = -1;
isc_install_actlist_empty = -2;
isc_install_fp_copy_delayed = -3;
isc_install_fp_delete_delayed = -4;
isc_install_option_not_found = -5;
isc_install_msg_version = -6;
isc_install_cant_load_msg = -7;
isc_install_invalid_msg = -8;
isc_install_invalid_tbl = -9;
isc_install_cant_create_msg = -10;
isc_install_handle_not_allocated = -11;
isc_install_odbc_comp_notfound = -12;
isc_install_cant_delete = -13;
isc_install_cant_rmdir = -14;
isc_install_key_nonempty = -15;
isc_install_success = 0;
{ File and directory related errors }
isc_install_path_not_valid = 1;
isc_install_path_not_exists = 2;
isc_install_cant_write = 3;
isc_install_type_unknown = 4;
isc_install_cant_move_file = 5;
isc_install_device_not_valid = 6;
isc_install_data_truncated = 7;
isc_install_cant_get_temp = 8;
isc_install_no_file = 9;
isc_install_cant_load_lib = 10;
isc_install_cant_lookup_lib = 11;
isc_install_file_exists = 12;
isc_install_cant_open_log = 13;
isc_install_write_error = 14;
isc_install_read_error = 15;
isc_install_invalid_log = 16;
isc_install_cant_read = 17;
isc_install_no_diskspace = 18;
isc_install_cant_create_dir = 19;
isc_install_msg_syntax = 20;
isc_install_fp_delete_error = 21;
isc_install_fp_rename_error = 22;
isc_install_fp_copy_error = 23;
{ Precheck related errors }
isc_install_system_not_supported = 24;
isc_install_server_running = 25;
isc_install_classic_found = 26;
isc_install_no_privileges = 27;
isc_install_cant_get_free_space = 28;
isc_install_guardian_running = 29;
isc_install_invalid_option = 30;
isc_install_invalid_handle = 31;
isc_install_message_not_found = 32;
{ TCP/IP services related }
isc_install_no_stack = 33;
isc_install_cant_add_service = 34;
isc_install_invalid_port = 35;
isc_install_invalid_service = 36;
isc_install_no_proto = 37;
isc_install_no_services_entry = 38;
isc_install_sock_error = 39;
isc_install_conversion_error = 40;
{ Operations errors }
isc_install_cant_copy = 41;
isc_install_no_mem = 42;
isc_install_queue_failed = 43;
isc_install_invalid_param = 44;
isc_install_fp_error_exception = 45;
isc_install_fp_status_exception = 46;
isc_install_user_aborted = 47;
{ Registry related errors }
isc_install_key_exists = 48;
isc_install_cant_create_key = 49;
isc_install_cant_set_value = 50;
isc_install_cant_open_key = 51;
isc_install_cant_delete_key = 52;
isc_install_cant_query_key = 53;
isc_install_cant_delete_value = 54;
{ OS services related errors }
isc_install_service_existed = 55;
isc_install_cant_create_service = 56;
isc_install_cant_open_service = 57;
isc_install_cant_query_service = 58;
isc_install_service_running = 59;
isc_install_cant_delete_service = 60;
isc_install_cant_open_manager = 61;
isc_install_system_error = 62;
isc_install_com_regfail = 63;
isc_install_dcom_required = 64;
{ ODBC installation errors }
isc_install_odbc_general = 65;
isc_install_core_version = 66;
isc_install_drv_version = 67;
isc_install_tran_version = 68;
//
type
TIBWiseInstall = class;
TIBInstallOption = ( opINTERBASE, opIB_SERVER, opIB_CLIENT, opIB_CMD_TOOLS,
opIB_CMD_TOOLS_DB_MGMT, opIB_CMD_TOOLS_USR_MGMT,
opIB_CMD_TOOLS_DB_QUERY, opIB_GUI_TOOLS, opIB_DOC,
opIB_EXAMPLES, opIB_EXAMPLE_API, opIB_EXAMPLE_DB,
opIB_DEV, opIB_REPLICATION, opIB_REPL_MANAGER,
opIB_REPL_SERVER, opIB_CONNECTIVITY, opIB_ODBC_CLIENT,
opIB_JDBC, opIB_JDBC_CLIENT, opIB_JDBC_SERVER );
TIBInstallOptions = set of TIBInstallOption;
TIBInstallError = function(Handle : HWND; Caller : TIBWiseInstall; Msg: Longint;
Error_msg: string; var Handled : boolean) : integer;
TIBInstallStatus = procedure(Handle : HWND; Caller : TIBWiseInstall;
Status : integer; const Status_msg : string);
TIBWiseInstall = class(TObject)
constructor Create;
destructor Destroy; override;
private
FDLLInst : HInst;
Isc_install_clear_options : TIsc_install_clear_options;
Isc_install_execute : TIsc_install_execute;
Isc_install_get_info : TIsc_install_get_info;
Isc_install_get_message : TIsc_install_get_message;
Isc_install_load_external_text : TIsc_install_load_external_text;
Isc_install_precheck : TIsc_install_precheck;
Isc_install_set_option : TIsc_install_set_option;
Isc_uninstall_execute : TIsc_uninstall_execute;
Isc_uninstall_precheck : TIsc_uninstall_precheck;
Isc_install_unset_option : TIsc_install_unset_option;
FDestDirectory : string;
FSourceDirectory : string;
FIBHandle : POPTIONS_HANDLE;
FHWND : HWND;
FIBInstallOptions : TIBInstallOptions;
FIBInstallError : TIBInstallError;
FIBInstallStatus : TIBInstallStatus;
FLastError : MSG_NO;
FStartAfterInstall : boolean;
FUninstallFile : string;
FSilent : boolean;
procedure SetOptions;
public
function Install : boolean;
function PreCheck : boolean;
function GetErrorDescription(Error : MSG_NO) : string;
property WindowHandle : HWND read FHWND write FHWND;
property UninstallFile : string read FUninstallFile;
property Silent : boolean read FSilent write FSilent;
property StartAfterInstall : boolean read FStartAfterInstall write FStartAfterInstall;
property LastError : MSG_NO read FLastError;
property DestDirectory : string read FDestDirectory write FDestDirectory;
property SourceDirectory : string read FSourceDirectory write FSourceDirectory;
property IBInstallOptions : TIBInstallOptions read FIBInstallOptions write FIBInstallOptions;
property OnInstallError : TIBInstallError read FIBInstallError write FIBInstallError;
property OnInstallStatus : TIBInstallStatus read FIBInstallStatus write FIBInstallStatus;
end;
//
procedure GetVariable(var DLLParams: ParamRec; const VarName: string; var VarValue: string); export;
procedure SetVariable(var DLLParams: ParamRec; const VarName: string; const NewValue: string); export;
function InstallInterbase(var DLLParams: ParamRec): LongBool; pascal; export;
function GetIBInstallDir(var DLLParams: ParamRec): LongBool; pascal; export;
var DLLHandle : HInst;
implementation
uses Registry, ErrorFormUnit, StatusFormUnit;
//
function FixPath(path : string) : string;
begin
if IsPathDelimiter(Path,length(path)) then result := path else result := path + '\';
end;
function GetFileVersion(filename : string; var VerBlk : VS_FIXEDFILEINFO) : boolean;
var InfoSize,puLen : DWord;
Pt,InfoPtr : Pointer;
begin
InfoSize := GetFileVersionInfoSize(PChar(filename),puLen);
fillchar(VerBlk,sizeof(VS_FIXEDFILEINFO),0);
if InfoSize 0 then begin
GetMem(Pt,InfoSize);
GetFileVersionInfo(PChar(filename),0,InfoSize,Pt);
VerQueryValue(Pt,'\',InfoPtr,puLen);
move(InfoPtr^,VerBlk,sizeof(VS_FIXEDFILEINFO));
FreeMem(Pt);
result := true;
end else result := false;
end;
function IsNT : boolean;
var osv : TOSVERSIONINFO;
begin
fillchar(osv,sizeof(TOSVERSIONINFO),0);
osv.dwOSVersionInfoSize := sizeof(TOSVERSIONINFO);
GetVersionEx(osv);
if (osv.dwPlatformId = VER_PLATFORM_WIN32_NT) then result := true else result := false;
end;
function ServiceStart(sMachine, sService : string ) : boolean;
var schm, schs : SC_Handle;
ss : TServiceStatus;
psTemp : PChar;
dwChkP : DWord;
begin
ss.dwCurrentState := 0;
schm := OpenSCManager(PChar(sMachine),Nil,SC_MANAGER_CONNECT);
if(schm 0)then begin
schs := OpenService(schm,PChar(sService),SERVICE_START or SERVICE_QUERY_STATUS);
if (schs 0) then begin
psTemp := Nil;
if (StartService(schs,0,psTemp)) then begin
if (QueryServiceStatus(schs,ss)) then begin
while (SERVICE_RUNNING ss.dwCurrentState) do begin
dwChkP := ss.dwCheckPoint;
Sleep(ss.dwWaitHint);
if (not QueryServiceStatus(schs,ss)) then begin
break;
end;
if (ss.dwCheckPoint break;
end;
end;
end;
end;
CloseServiceHandle(schs);
end;
CloseServiceHandle(schm);
end;
Result := SERVICE_RUNNING = ss.dwCurrentState;
end;
function ServiceStop(sMachine, sService : string ) : boolean;
var schm, schs : SC_Handle;
ss : TServiceStatus;
dwChkP : DWord;
begin
schm := OpenSCManager(PChar(sMachine),Nil,SC_MANAGER_CONNECT);
if(schm 0)then begin
schs := OpenService(schm,PChar(sService),SERVICE_STOP or SERVICE_QUERY_STATUS);
if(schs 0)then begin
if (ControlService(schs,SERVICE_CONTROL_STOP,ss)) then begin
if (QueryServiceStatus(schs,ss)) then begin
while (SERVICE_STOPPED ss.dwCurrentState) do begin
dwChkP := ss.dwCheckPoint;
Sleep(ss.dwWaitHint);
if (not QueryServiceStatus(schs,ss))then begin
break;
end;
if (ss.dwCheckPoint break;
end;
end;
end;
end;
CloseServiceHandle(schs);
end;
CloseServiceHandle(schm);
end;
Result := (SERVICE_STOPPED = ss.dwCurrentState);
end;
function GetInterbaseServerDirectory : string;
var Filename : string;
Reg : TRegistry;
begin
Filename := '';
Reg := TRegistry.Create(KEY_READ);
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.KeyExists('Software\InterBase Corp\InterBase\CurrentVersion') then begin
if Reg.OpenKeyReadOnly('Software\InterBase Corp\InterBase\CurrentVersion') then begin
Filename := FixPath(Reg.ReadString('ServerDirectory'))+'ibguard.exe';
Reg.CloseKey;
end;
end else begin
if Reg.KeyExists('Software\Borland\InterBase\CurrentVersion') then begin
if Reg.OpenKeyReadOnly('Software\Borland\InterBase\CurrentVersion') then begin
Filename := FixPath(Reg.ReadString('ServerDirectory'))+'ibguard.exe';
Reg.CloseKey;
end;
end;
end;
finally
Reg.free;
end;
result := filename;
end;
//
procedure GetVariable(var DLLParams: ParamRec; const VarName: string; var VarValue: string);
var i: Integer;
szVarName: array[0..255] of char;
begin
VarValue := '';
szVarName[0] := '%';
StrPCopy(@szVarName[1],VarName);
StrCat(szVarName,'%');
for i := 0 to DLLParams.wCurrReps do begin
if (StrComp(szVarName,@DLLParams.szRepName[i * DLLParams.wRepNameWidth]) = 0) then begin
VarValue := StrPas(@DLLParams.szRepStr[i * DLLParams.wRepStrWidth]);
Exit;
end;
end;
end;
//
procedure SetVariable(var DLLParams: ParamRec; const VarName: string; const NewValue: string);
var i: Integer;
szVarName: array[0..255] of char;
begin
szVarName[0] := '%';
StrPCopy(@szVarName[1],VarName);
StrCat(szVarName,'%');
for i := 0 to DLLParams.wCurrReps do begin
if (StrComp(szVarName,@DLLParams.szRepName[i * DLLParams.wRepNameWidth]) = 0) then begin
StrPCopy(@DLLParams.szRepStr[i * DLLParams.wRepStrWidth],NewValue);
Exit;
end;
end;
StrCopy(@DLLParams.szRepName[DLLParams.wCurrReps * DLLParams.wRepNameWidth],szVarName);
StrPCopy(@DLLParams.szRepStr[DLLParams.wCurrReps * DLLParams.wRepStrWidth],NewValue);
DLLParams.wCurrReps := DLLParams.wCurrReps + 1;
end;
//
function InterbaseVersion : cardinal;
var Filename : string;
fileinfo : VS_FIXEDFILEINFO;
begin
result := 0;
filename := GetInterbaseServerDirectory;
if FileExists(Filename) then begin
if GetFileVersion(filename,fileinfo) then begin
result := fileinfo.dwProductVersionMS;
end;
end;
end;
//
function InterbaseRunning : boolean;
begin
result := boolean(FindWindow('IB_Server','InterBase Server')
or FindWindow('IB_Guard','InterBase Guardian'));
end;
//
function ShutDownInterbase : boolean;
var IBSRVHandle,IBGARHandle : THandle;
begin
if IsNT then begin
ServiceStop('','InterBaseGuardian');
end else begin
IBGARHandle := FindWindow('IB_Guard','InterBase Guardian');
if IBGARHandle 0 then begin
PostMessage(IBGARHandle,31,0,0);
PostMessage(IBGARHandle,16,0,0);
end;
IBSRVHandle := FindWindow('IB_Server','InterBase Server');
if IBSRVHandle 0 then begin
PostMessage(IBSRVHandle,31,0,0);
PostMessage(IBSRVHandle,16,0,0);
end;
end;
result := (boolean(FindWindow('IB_Server','InterBase Server')
or FindWindow('IB_Guard','InterBase Guardian')) = false);
end;
//
function StartInterbase : boolean;
var Filename : string;
begin
filename := GetInterbaseServerDirectory;
if FileExists(Filename) then begin
if IsNT then begin
ServiceStart('','InterBaseGuardian');
end else begin
WinExec(pchar(Filename),0);
end;
end;
result := boolean(FindWindow('IB_Server','InterBase Server')
or FindWindow('IB_Guard','InterBase Guardian'));
end;
//
function InterbaseInstalled : boolean;
var Filename : string;
Running : boolean;
begin
Running := InterbaseRunning;
if Running = false then begin
filename := GetInterbaseServerDirectory;
if FileExists(Filename) then begin
result := true;
end else result := false;
end else result := true;
end;
//
function IBOptionsFromString(Str : String) : TIBInstallOptions;
begin
result := [];
if Str = '' then result := [opINTERBASE];
if (pos('A',Str) 0) then result := result + [opIB_SERVER];
if (pos('B',Str) 0) then result := result + [opIB_CLIENT];
if (pos('C',Str) 0) then result := result + [opIB_CMD_TOOLS];
if (pos('D',Str) 0) then result := result + [opIB_CMD_TOOLS_DB_MGMT];
if (pos('E',Str) 0) then result := result + [opIB_CMD_TOOLS_USR_MGMT];
if (pos('F',Str) 0) then result := result + [opIB_CMD_TOOLS_DB_QUERY];
if (pos('G',Str) 0) then result := result + [opIB_GUI_TOOLS];
if (pos('H',Str) 0) then result := result + [opIB_DOC];
if (pos('I',Str) 0) then result := result + [opIB_EXAMPLES];
if (pos('J',Str) 0) then result := result + [opIB_EXAMPLE_API];
if (pos('K',Str) 0) then result := result + [opIB_EXAMPLE_DB];
if (pos('L',Str) 0) then result := result + [opIB_DEV];
if (pos('M',Str) 0) then result := result + [opIB_REPLICATION];
if (pos('N',Str) 0) then result := result + [opIB_REPL_MANAGER];
if (pos('O',Str) 0) then result := result + [opIB_REPL_SERVER];
if (pos('P',Str) 0) then result := result + [opIB_CONNECTIVITY];
if (pos('Q',Str) 0) then result := result + [opIB_ODBC_CLIENT];
if (pos('R',Str) 0) then result := result + [opIB_JDBC];
if (pos('S',Str) 0) then result := result + [opIB_JDBC_CLIENT];
if (pos('T',Str) 0) then result := result + [opIB_JDBC_SERVER];
end;
//
// TIBWiseInstall class by Magnus Flysj 2001
//
constructor TIBWiseInstall.Create;
var DestDir : TEXT;
DLLPath : pchar;
IBDLL : string;
begin
inherited Create;
OnInstallError := nil;
OnInstallStatus := nil;
GetMem(FIBHandle,4);
FIBHandle^ := 0;
FIBInstallOptions := [opINTERBASE];
FSourceDirectory := '';
FStartAfterInstall := false;
FUninstallFile := '';
FSilent := false;
IBDLL := '';
DLLPath := StrAlloc(255);
fillchar(DLLPath^,255,0);
try
GetModuleFilename(HInstance,DLLPath,255);
IBDLL := fixpath(ExtractFilePath(DLLPath)) + IB_INSTALL_DLL;
finally
StrDispose(DLLPath);
end;
FDLLInst := LoadLibrary(pchar(IBDLL));
if FDLLInst 0 then begin
@Isc_install_clear_options := GetProcAddress(FDLLInst,'isc_install_clear_options');
@Isc_install_execute := GetProcAddress(FDLLInst,'isc_install_execute');
@Isc_install_get_info := GetProcAddress(FDLLInst,'isc_install_get_info');
@Isc_install_get_message := GetProcAddress(FDLLInst,'isc_install_get_message');
@Isc_install_load_external_text := GetProcAddress(FDLLInst,'isc_install_load_external_text');
@Isc_install_precheck := GetProcAddress(FDLLInst,'isc_install_precheck');
@Isc_install_set_option := GetProcAddress(FDLLInst,'isc_install_set_option');
@Isc_uninstall_execute := GetProcAddress(FDLLInst,'isc_uninstall_execute');
@Isc_uninstall_precheck := GetProcAddress(FDLLInst,'isc_uninstall_precheck');
@Isc_install_unset_option := GetProcAddress(FDLLInst,'isc_install_unset_option');
end else halt;
DestDir := StrAlloc(255);
fillchar(DestDir^,255,0);
try
if Assigned(isc_install_get_info) then begin
isc_install_get_info(isc_install_info_destination,0,DestDir,255);
FDestDirectory := DestDir;
end;
finally
StrDispose(DestDir);
end;
end;
destructor TIBWiseInstall.Destroy;
begin
if FIBHandle^ 0 then isc_install_clear_options(FIBHandle);
FreeMem(FIBHandle,4);
if FDLLInst 0 then FreeLibrary(FDLLInst);
inherited Destroy;
end;
function IB_FP_ERROR(msg: MSG_NO; data: Pointer; error_msg: TEXT): Integer; stdcall;
var IBWiseInstall : TIBWiseInstall;
Handled : boolean;
begin
Handled := true;
IBWiseInstall := TIBWiseInstall(data);
if Assigned(IBWiseInstall) then begin
if not IBWiseInstall.Silent then begin
if Assigned(IBWiseInstall.OnInstallError) then result := IBWiseInstall.OnInstallError(IBWiseInstall.FHWND,IBWiseInstall,msg,Error_msg,Handled) else handled := false;
if handled = false then result := isc_install_fp_abort;
end else result := isc_install_fp_abort;
end else result := isc_install_fp_abort;
end;
function IB_FP_STATUS(status: integer; data: Pointer; const status_msg: TEXT): Integer; stdcall;
var IBWiseInstall : TIBWiseInstall;
begin
IBWiseInstall := TIBWiseInstall(data);
result := status;
if Assigned(IBWiseInstall) then begin
if not IBWiseInstall.Silent then begin
if Assigned(IBWiseInstall.OnInstallStatus) then IBWiseInstall.OnInstallStatus(IBWiseInstall.FHWND,IBWiseInstall,Status,Status_Msg);
end;
end;
end;
procedure TIBWiseInstall.SetOptions;
begin
if Assigned(isc_install_clear_options) then isc_install_clear_options(FIBHandle);
if Assigned(isc_install_set_option) then begin
if (FIBInstallOptions = []) then isc_install_set_option(FIBHandle,INTERBASE);
if (opIB_SERVER in FIBInstallOptions) then isc_install_set_option(FIBHandle,IB_SERVER);
if (opIB_CLIENT in FIBInstallOptions) then isc_install_set_option(FIBHandle,IB_CLIENT);
if (opIB_CMD_TOOLS in FIBInstallOptions) then isc_install_set_option(FIBHandle,IB_CMD_TOOLS);
if (opIB_CMD_TOOLS_DB_MGMT in FIBInstallOptions) then isc_install_set_option(FIBHandle,IB_CMD_TOOLS_DB_MGMT);
if (opIB_CMD_TOOLS_USR_MGMT in FIBInstallOptions) then isc_install_set_option(FIBHandle,IB_CMD_TOOLS_USR_MGMT);
if (opIB_CMD_TOOLS_DB_QUERY in FIBInstallOptions) then isc_install_set_option(FIBHandle,IB_CMD_TOOLS_DB_QUERY);
if (opIB_GUI_TOOLS in FIBInstallOptions) then isc_install_set_option(FIBHandle,IB_GUI_TOOLS);
if (opIB_DOC in FIBInstallOptions) then isc_install_set_option(FIBHandle,IB_DOC);
if (opIB_EXAMPLES in FIBInstallOptions) then isc_install_set_option(FIBHandle,IB_EXAMPLES);
if (opIB_EXAMPLE_API in FIBInstallOptions) then isc_install_set_option(FIBHandle,IB_EXAMPLE_API);
if (opIB_EXAMPLE_DB in FIBInstallOptions) then isc_install_set_option(FIBHandle,IB_EXAMPLE_DB);
if (opIB_DEV in FIBInstallOptions) then isc_install_set_option(FIBHandle,IB_DEV);
if (opIB_REPLICATION in FIBInstallOptions) then isc_install_set_option(FIBHandle,IB_REPLICATION);
if (opIB_REPL_MANAGER in FIBInstallOptions) then isc_install_set_option(FIBHandle,IB_REPL_MANAGER);
if (opIB_REPL_SERVER in FIBInstallOptions) then isc_install_set_option(FIBHandle,IB_REPL_SERVER);
if (opIB_CONNECTIVITY in FIBInstallOptions) then isc_install_set_option(FIBHandle,IB_CONNECTIVITY);
if (opIB_ODBC_CLIENT in FIBInstallOptions) then isc_install_set_option(FIBHandle,IB_ODBC_CLIENT);
if (opIB_JDBC in FIBInstallOptions) then isc_install_set_option(FIBHandle,IB_JDBC);
if (opIB_JDBC_CLIENT in FIBInstallOptions) then isc_install_set_option(FIBHandle,IB_JDBC_CLIENT);
if (opIB_JDBC_SERVER in FIBInstallOptions) then isc_install_set_option(FIBHandle,IB_JDBC_SERVER);
end;
end;
function TIBWiseInstall.PreCheck : boolean;
begin
SetOptions;
FLastError := isc_install_precheck(FIBHandle^,pchar(FSourceDirectory),pchar(FDestDirectory));
if FLastError isc_install_success then result := false else result := true;
end;
function TIBWiseInstall.Install : boolean;
var UnIPFile : pchar;
begin
if InterbaseRunning then begin
FLastError := isc_install_server_running;
result := false;
end else begin
if PreCheck then begin
UnIPFile := StrAlloc(255);
try
Fillchar(UnIPFile^,255,0);
FLastError := isc_install_execute(FIBHandle^,pchar(FSourceDirectory),pchar(FDestDirectory),@IB_FP_STATUS,self,@IB_FP_ERROR,self,UnIPFile);
if FLastError isc_install_success then result := false else begin
FUninstallFile := UnIPFile;
result := true;
end;
if StartAfterInstall then StartInterbase;
finally
StrDispose(UnIPFile);
end;
end else result := false;
end;
end;
function TIBWiseInstall.GetErrorDescription(Error : MSG_NO) : string;
var Msgtext : TEXT;
begin
Msgtext := StrAlloc(255);
Fillchar(Msgtext^,255,0);
try
isc_install_get_message(FIBHANDLE^,Error,Msgtext,255);
result := Msgtext;
finally
StrDispose(Msgtext);
end;
end;
//
function IBInstallError(Handle : HWND; Caller : TIBWiseInstall; Msg: Longint; Error_msg: string; var Handled : boolean) : integer;
var ErrMess : String;
ErrRes : integer;
Shwnd : HWND;
begin
if Assigned(StatusForm) then begin
if StatusForm.Visible then begin
Shwnd := StatusForm.Handle
end else Shwnd := Handle;
end else Shwnd := Handle;
ErrMess := 'Database Installation Error '+inttostr(Msg)+#13#10+Error_msg;
ErrRes := MessageBox(Shwnd,Pchar(ErrMess),'Database Installation Error',MB_ICONERROR+MB_ABORTRETRYIGNORE);
result := isc_install_fp_abort;
Case ErrRes of
IDABORT: result := isc_install_fp_abort;
IDIGNORE: result := isc_install_fp_continue;
IDRETRY: result := isc_install_fp_retry;
end;
Handled := true;
end;
procedure IBInstallStatus(Handle : HWND; Caller : TIBWiseInstall; Status : integer; const Status_msg : string);
begin
if Assigned(StatusForm) then begin
StatusForm.Progress := Status;
StatusForm.Status := Status_msg;
StatusForm.BringToFront;
StatusForm.Show;
end;
end;
//
// InstallIBServer returns IBStatus = 'Success' upon success otherwise it
// contains the error that ibinstall.dll reports.
//
function InstallInterbase(var DLLParams: ParamRec): LongBool; pascal; export;
var IBWiseInstall : TIBWiseInstall;
IBInstallMode : string;
IBDestDirectory : string;
IBSourceDirectory : string;
IBOPTIONS : string;
IBStatus : string;
IBUninstallfile : string;
begin
IBWiseInstall := TIBWiseInstall.Create;
IBStatus := 'DLLError';
try
GetVariable(DLLParams,'IBINSTALLMODE',IBInstallMode);
GetVariable(DLLParams,'IBDESTDIR',IBDestDirectory);
GetVariable(DLLParams,'IBSRCDIR',IBSourceDirectory);
GetVariable(DLLParams,'IBOPTIONS',IBOPTIONS);
IBWiseInstall.WindowHandle := DLLParams.hMainWnd;
IBWiseInstall.IBInstallOptions := IBOptionsFromString(IBOPTIONS);
IBWiseInstall.Silent := (pos('S',IBInstallMode) 0);
IBWiseInstall.StartAfterInstall := (pos('R',IBInstallMode) 0);
if IBDestDirectory '' then IBWiseInstall.DestDirectory := IBDestDirectory;
IBWiseInstall.SourceDirectory := IBSourceDirectory;
IBWiseInstall.OnInstallError := IBInstallError;
IBWiseInstall.OnInstallStatus := IBInstallStatus;
StatusForm := TStatusForm.CreateParented(DLLParams.hMainWnd);
try
try
if IBWiseInstall.Install then begin
IBStatus := 'Success';
IBUninstallfile := IBWiseInstall.UninstallFile;
end else begin
IBStatus := IBWiseInstall.GetErrorDescription(IBWiseInstall.LastError);
end;
result := true;
except
result := false;
end;
finally
StatusForm.free;
end;
finally
SetVariable(DLLParams,'IBUIFILE',IBUninstallfile);
SetVariable(DLLParams,'IBSTATUS',IBStatus);
IBWiseInstall.free;
end;
end;
function GetIBInstallDir(var DLLParams: ParamRec): LongBool; pascal; export;
var IBWiseInstall : TIBWiseInstall;
begin
IBWiseInstall := TIBWiseInstall.Create;
try
try
SetVariable(DLLParams,'IBDestDirectory',IBWiseInstall.DestDirectory);
result := true;
except
result := false;
end;
finally
IBWiseInstall.free;
end;
end;
end.
--------------------------------------------------------------------------------
Where to find Interbase and more inforamtion
More information about WISE solutions can be found at WISE solutions homepage:
http://www.wisesolutions.com
Interbase can be downloaded freely from Borland Interbase homepage:
http://www.borland.com/interbase/downloads/
More webpages about Interbase can be found here:
http://www.borland.com/interbase/websites.html
More information about the API in the IBINSTALL.DLL can be found in the Interbase Developer Docs:
ftp://ftpc.inprise.com/pub/interbase/techpubs/ib_b60_doc.zip
Any questions about IBWISE.DLL and it's code can be passed to:
flysjo@algonet.se
]]>