Fórum Distribuição DBExpress Interbase #264704

gds_db           3050/tcp                  # InterBase Server

[Run]
// --> Se o foi selecionada a instalação "Cliente"
Filename: Firebird-1.5.2.4731-Win32.exe; Parameters: "/SP- /VERYSILENT /DIR=""C:\Firebird"" /GROUP=""Firebird 1.5.2"" /COMPONENTS=""ClientComponent"" /COPYFBCLIENT"; Flags: waituntilidle runminimized; Components: ComponenteCliente

// --> Se o foi selecionada a instalação "Servidor" :
Filename: Firebird-1.5.2.4731-Win32.exe; Parameters: "/SP- /VERYSILENT /DIR=""C:\Firebird"" /GROUP=""Firebird 1.5.2"" /COMPONENTS=""SuperServerComponent, ServerComponent, DevAdminComponent, ClientComponent"" /COPYFBCLIENT"; Flags: waituntilidle runminimized; Components: ComponenteServidor

// --> E em qualquer uma das duas, o registro da midas :
Filename: regsvr32.exe; Parameters: midas.dll /s; Flags: waituntilidle runminimized

program Set3050;

uses Windows, SysUtils, Classes, ShlObj;

type
  DirectoryType = (_WINDOWS, _SYSTEM{, _TEMP, _CURRENT});

function GetDirectory(Dir: DirectoryType): string;
var Path: array [0..MAX_PATH] of Char;
begin
  case Dir of
    _WINDOWS: GetWindowsDirectory(Path, Sizeof(Path));
    _SYSTEM : GetSystemDirectory(Path, Sizeof(Path));
//    _TEMP   : GetTempPath(Sizeof(Path), Path);
//    _CURRENT: GetCurrentDirectory(Sizeof(Path), Path);
  end;
  Result := StrPas(Path)+´\´;
end;

function ExtractWord(N: Integer; const S: string; const WordDelims: TSysCharSet): string;
var C, I, X: Integer;
begin
  C := 0;
  I := 1;
  X := 0;
  while (I <= Length(S)) and (C <> N) do begin
    while (I <= Length(S)) and (S[I] in WordDelims) do Inc(I);
    if I <= Length(S) then Inc(C);
    if C <> N then
      while (I <= Length(S)) and not (S[I] in WordDelims) do Inc(I)
    else X := I;
  end;
  I := X;
  C := 0;
  if I <> 0 then
    while (I <= Length(S)) and not(S[I] in WordDelims) do begin
      Inc(C);
      SetLength(Result, C);
      Result[C] := S[I];
      Inc(I);
    end;
  SetLength(Result, C);
end;

const ServFile = ´Services´;
      NtServFile = ´Drivers\Etc\´+ServFile;
      gds_db = ´gds_db´;
      ServRow = gds_db+´           3050/tcp´;

var FilePth: String;
    Lst: TStrings;
    i: Integer;

begin
  FilePth := GetDirectory(_SYSTEM)+NtServFile;
  if not FileExists(FilePth) then begin
    FilePth := GetDirectory(_WINDOWS)+ServFile;
    if not FileExists(FilePth) then begin
      // throw Exeption - TCP/IP not installed! You must install TCP/IP support as first.
      Exit;
    end;
  end;
  Lst := TStringList.Create;
 try
  Lst.LoadFromFile(FilePth);
  for i:=Lst.Count-1 downto 0 do
    if LowerCase(ExtractWord(1,Lst.Strings[i],[´ ´,9]))=gds_db then Exit;
  Lst.Add(ServRow);
  Lst.SaveToFile(FilePth);
 finally
   Lst.Free;
 end;
  SHChangeNotify(SHCNE_UPDATEITEM, SHCNF_PATH, PChar(FilePth), nil);
  SHChangeNotify(SHCNE_UPDATEDIR, SHCNF_PATH or SHCNF_FLUSH, PChar(ExtractFilePath(FilePth)), nil);
end.