Gracias Raul por tu repuesta, pero en el código de esta página en la parte de code:
Código Delphi
[-]
[code]
program Setup;
const
sWinSock2 = 'ws2_32.dll';
sNoWinsock2 = 'Please Install Winsock 2 Update before continuing';
sMSWinsock2Update = 'http://www.microsoft.com/windows95/downloads/contents/WUAdminTools/S_WUNetworkingTools/W95Sockets2/Default.asp';
sWinsock2Web = 'Winsock 2 is not installed.'#13#13'Would you like to Visit the Winsock 2 Update Home Page?';
ProductVersion = 'PRODUCT_VER_STRING';
var
Winsock2Failure: Boolean;
InterBaseVer: Array of Integer;
FirebirdVer: Array of Integer;
fbclientStartCount,
gds32StartCount : Integer;
procedure GetSharedLibCountAtStart;
var
dw: Cardinal;
begin
if RegQueryDWordValue(HKEY_LOCAL_MACHINE,
'SOFTWARE\Microsoft\Windows\CurrentVersion\SharedDLLs','C:\WINNT\System32\fbclient.dll', dw) then
fbclientStartCount := dw
else
fbclientStartCount := 0;
if RegQueryDWordValue(HKEY_LOCAL_MACHINE,
'SOFTWARE\Microsoft\Windows\CurrentVersion\SharedDLLs','C:\WINNT\System32\gds32.dll', dw) then
gds32StartCount := dw
else
gds32StartCount := 0;
end;
procedure SetSharedLibCountAtEnd;
var
dw: cardinal;
begin
if RegQueryDWordValue(HKEY_LOCAL_MACHINE,
'SOFTWARE\Microsoft\Windows\CurrentVersion\SharedDLLs','C:\WINNT\System32\fbclient.dll', dw) then begin
if (( dw - fbclientStartCount ) > 1 ) then begin
dw := fbclientStartCount + 1 ;
RegWriteDWordValue(HKEY_LOCAL_MACHINE,
'SOFTWARE\Microsoft\Windows\CurrentVersion\SharedDLLs','C:\WINNT\System32\fbclient.dll', dw);
end;
end;
if RegQueryDWordValue(HKEY_LOCAL_MACHINE,
'SOFTWARE\Microsoft\Windows\CurrentVersion\SharedDLLs','C:\WINNT\System32\gds32.dll', dw) then begin
if (( dw - gds32StartCount ) > 1 ) then begin
dw := gds32StartCount + 1 ;
RegWriteDWordValue(HKEY_LOCAL_MACHINE,
'SOFTWARE\Microsoft\Windows\CurrentVersion\SharedDLLs','C:\WINNT\System32\gds32.dll', dw);
end;
end;
end;
function CheckWinsock2(): Boolean;
begin
Result := True;
if (not UsingWinNt) and (not FileExists(AddBackslash(GetSystemDir) + sWinSock2)) then begin
Winsock2Failure := True;
Result := False;
end
else
Winsock2Failure := False;
end;
function InitializeSetup(): Boolean;
var
i: Integer;
begin
result := true;
if not CheckWinsock2 then
exit;
i:=FindWindowByClassName('FB_Disabled');
if ( i=0 ) then
i:=FindWindowByClassName('FB_Server');
if ( i<>0 ) then begin
result := false;
MsgBox('An existing Firebird Server is running. You must close the '+
'application or stop the service before continuing.', mbError, MB_OK);
end;
if ( result=true ) then
GetSharedLibCountAtStart;
end;
procedure DeInitializeSetup();
var
ErrCode: Integer;
begin
if Winsock2Failure then
if MsgBox(sWinsock2Web, mbInformation, MB_YESNO) = idYes then
InstShellExec(sMSWinsock2Update, '', '', SW_SHOWNORMAL, ErrCode);
end;
procedure DecodeVersion( verstr: String; var verint: array of Integer );
var
i,p: Integer; s: string;
begin
verint := [0,0,0,0];
i := 0;
while ( (Length(verstr) > 0) and (i < 4) ) do
begin
p := pos('.', verstr);
if p > 0 then
begin
if p = 1 then s:= '0' else s:= Copy( verstr, 1, p - 1 );
verint[i] := StrToInt(s);
i := i + 1;
verstr := Copy( verstr, p+1, Length(verstr));
end
else
begin
verint[i] := StrToInt( verstr );
verstr := '';
end;
end;
end;
function GetInstalledVersion(ADir: String): Array of Integer;
var
AString: String;
VerInt: Array of Integer;
begin
if (ADir<>'') then begin
GetVersionNumbersString( ADir+'\bin\gbak.exe', Astring);
DecodeVersion(AString, VerInt);
end;
result := VerInt;
end;
function GetFirebirdDir: string;
var
FirebirdDir: String;
begin
FirebirdVer := [0,0,0,0];
RegQueryStringValue(HKEY_LOCAL_MACHINE,
'SOFTWARE\FirebirdSQL\Firebird\CurrentVersion','RootDirectory', FirebirdDir);
if (FirebirdDir<>'') then
FirebirdVer:=GetInstalledVersion(FirebirdDir);
end;
function GetInterBaseDir: string;
var
InterBaseDir: String;
begin
InterBaseVer := [0,0,0,0];
RegQueryStringValue(HKEY_LOCAL_MACHINE,
'SOFTWARE\Borland\InterBase\CurrentVersion','RootDirectory', InterBaseDir);
if (InterBaseDir<>'') then
InterBaseVer:=GetInstalledVersion(InterBaseDir);
end;
function InstallDir(Default: String): String;
var
InstallRootDir,
InterBaseRootDir,
FirebirdRootDir: String;
begin
InstallRootDir := '';
InterBaseRootDir:=GetInterBaseDir;
FirebirdRootDir:=GetFirebirdDir;
if (FirebirdRootDir <> '') and ( FirebirdRootDir = InterBaseRootDir ) then InstallRootDir := Default;
if (( InstallRootDir = '' ) and
( FirebirdRootDir = Default )) then InstallRootDir := Default;
if (( InstallRootDir = '') and
( FirebirdVer[0] = 1 ) and ( FirebirdVer[1] = 5 ) ) then InstallRootDir := FirebirdRootDir;
if (InstallRootDir = '') then
InstallRootDir:=getenv('FIREBIRD');
if (InstallRootDir = '') then
InstallRootDir := Default;
Result := ExpandConstant(InstallRootDir);
end;
function UseGuardian(Default: String): String;
begin
if ShouldProcessEntry('ServerComponent', 'UseGuardianTask')= srYes then
Result := '1'
else
Result := '0';
end;
function ServiceStartFlags(Default: String): String;
var
classic: String;
begin
classic := '';
#ifdef classic_server_install
classic := ' -classic';
#endif
Result := '';
if ShouldProcessEntry('ServerComponent', 'UseGuardianTask')= srYes then begin
if ShouldProcessEntry('ServerComponent', 'AutoStartTask')= srYes then
Result := ' -auto ' + classic + ' -g '
else
Result := classic + ' -g ';
end
else
if ShouldProcessEntry('ServerComponent', 'AutoStartTask')= srYes then
Result := ' -auto ';
end;
function InstallGuardianIcon(): Boolean;
begin
result := false;
if ShouldProcessEntry('ServerComponent', 'UseApplicationTask')= srYes then
if ShouldProcessEntry('ServerComponent', 'UseGuardianTask')= srYes then
result := true;
end;
function InstallServerIcon(): Boolean;
begin
result := false;
if ShouldProcessEntry('ServerComponent', 'UseApplicationTask')= srYes then
if ShouldProcessEntry('ServerComponent', 'UseGuardianTask')= srNo then
result := true;
end;
function StartApp(Default: String): String;
var
AppPath: String;
begin
AppPath:=ExpandConstant('{app}');
if ShouldProcessEntry('ServerComponent', 'UseGuardianTask')= srYes then
Result := AppPath+'\bin\fbguard.exe'
else
#ifdef classic_server_install
Result := AppPath+'\bin\fb_inet_server.exe';
#else
Result := AppPath+'\bin\fbserver.exe';
#endif
end;
procedure CurStepChanged(CurStep: Integer);
var
AppStr: String;
begin
if ( CurStep=csFinished ) then begin
if (ShouldProcessEntry('ServerComponent', 'AutoStartTask')= srYes) and
( ShouldProcessEntry('ServerComponent', 'UseApplicationTask')= srYes ) then begin
AppStr := StartApp('')+' -a';
RegWriteStringValue (HKLM, 'SOFTWARE\Microsoft\Windows\CurrentVersion\Run', 'Firebird', AppStr);
end;
end;
if ( CurStep=csFinished ) then
SetSharedLibCountAtEnd;
end;
function FirebirdOneRunning: boolean;
var
i: Integer;
begin
result := false;
i:=0;
i:=FindWindowByClassName('IB_Server') ;
if ( i<>0 ) then
result := true;
end;
function StartEngine: boolean;
begin
result := not FirebirdOneRunning;
end;
function RemoveThisVersion: boolean;
var
VersionStr: string;
begin
result := false;
if RegQueryStringValue(HKEY_LOCAL_MACHINE,
'SOFTWARE\FirebirdSQL\Firebird\CurrentVersion','Version', VersionStr ) then
if (pos(ProductVersion,VersionStr)>0) then
result := true;
end;
begin
end.
dichas instrucciones son:
INstShellExec(,,,,) y ShouldProcessEntry.
¿Sabes como solucionarlo?
De antemano gracias por el Script