[VRO]

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;
  //  Likely values for installed versions of InterBase are:
  //  [6,2,0,nnn]   Firebird 1.0.0
  //  [6,2,2,nnn]   Firebird 1.0.2
  //  [6,0,n,n]     InterBase 6.0
  //  [6,5,n,n]     InterBase 6.5
  //  [7,0,n,n]     InterBase 7.0

  FirebirdVer: Array of Integer;
  //  Likely values for installed versions of Firebird are:
  //  [6,2,0,nnn]   Firebird 1.0.0
  //  [6,2,2,nnn]   Firebird 1.0.2
  //  [6,2,3,nnn]   Firebird 1.0.3
  //  [1,5,0,nnnn]  Firebird 1.5.0

  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;
// gds32 and fbclient get registered twice as shared libraries.
// This appears to be a bug in InnoSetup. It only appears to affect
// libraries the first time they are registered, and it only seems
// to affect stuff in the {sys} directory. To work around this we
// check the count before install and after install.
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;
  //Check if Winsock 2 is installed (win 95 only)
  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;

  //Look for a running version of Firebird
  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;
  
  //Check the shared library count.
  if ( result=true ) then
    GetSharedLibCountAtStart;
  
end;

procedure DeInitializeSetup();
var
  ErrCode: Integer;
begin
  // Did the install fail because winsock 2 was not installed?
  if Winsock2Failure then
    // Ask user if they want to visit the Winsock2 update web page.
    if MsgBox(sWinsock2Web, mbInformation, MB_YESNO) = idYes then
      // User wants to visit the web page
      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;
//Check if Firebird installed, get version info to global var and return root dir
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;
//Check if InterBase installed, get version info to global var and return root dir
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;

//This function tries to find an existing install of Firebird 1.5
//If it succeeds it suggests that directory for the install
//Otherwise it suggests the default for Fb 1.5
function InstallDir(Default: String): String;
var
  InstallRootDir,
  InterBaseRootDir,
  FirebirdRootDir: String;
begin
  InstallRootDir := '';

  // Try to find the value of "RootDirectory" in the Firebird
  // registry settings. This is either where Fb 1.0 exists or Fb 1.5
  InterBaseRootDir:=GetInterBaseDir;
  FirebirdRootDir:=GetFirebirdDir;
  
  if (FirebirdRootDir <> '') and ( FirebirdRootDir = InterBaseRootDir ) then  //Fb 1.0 must be installed so don't overwrite it.
    InstallRootDir := Default;
    
  if (( InstallRootDir = '' ) and
      ( FirebirdRootDir = Default )) then // Fb 1.5 is already installed,
    InstallRootDir := Default;             // so we offer to install over it

  if (( InstallRootDir = '') and
      ( FirebirdVer[0] = 1 ) and ( FirebirdVer[1] = 5 ) ) then   // Firebird 1.5 is installed
    InstallRootDir := FirebirdRootDir;                            // but the user has changed the default

  // if we haven't found anything then try the FIREBIRD env var
  // User may have preferred location for Firebird, but has possibly
  // uninstalled previous version
  if (InstallRootDir = '') then
    InstallRootDir:=getenv('FIREBIRD');
    
  //if no existing locations found make sure we default to the default.
  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}');
  //Now start the app as
  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 user has chosen to install an app and run it automatically set up the registry accordingly
    //so that the server or guardian starts evertime they login.
    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
    //Check that the shared lib count is correct.
    SetSharedLibCountAtEnd;

end;

function FirebirdOneRunning: boolean;
var
  i: Integer;
begin
  result := false;
  
  //Look for a running copy of InterBase or Firebird 1.0.
  i:=0;
  i:=FindWindowByClassName('IB_Server') ;
  if ( i<>0 ) then
    result := true;
    
end;

function StartEngine: boolean;
begin
  result := not FirebirdOneRunning;
end;

function RemoveThisVersion: boolean;
//check if we are still the current version before removing
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