Wise - fazendo a instalacao do banco de dados firebird junto com o wise do programa

Top  Previous  Next

Question/Problem/Abstract:

 

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 < dwChkP) then begin 

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 < dwChkP) then begin 

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..255of 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..255of 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