1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:

// Minimale Client Installation. Eintrag in Win Services Datei
// ________________________________________________________________________________________________________
procedure CheckGDS;
var txtDatei      : TextFile;
    strDummy,
    strWin, strBak: String;
    blnGefunden, blnAdmin   : Boolean;
    srcDatei,
    dstDatei      : TFileStream;    // Source & Destination

  // Wie lautet das Windows Verzeichnis?
  function  WinDir:String;
  var intLen:Integer;
  begin
    SetLength(Result, MAX_PATH+1);
    intLen := GetWindowsDirectory(pChar(Result), Length(Result)-1);
    SetLength(Result, intLen)
  end{WinDir};

  // Hat der User Administrationsrechte?
  function IsAdmin:Boolean;
  const cstTestKey = 'Software\CheckGDS';
  begin
    Result := False;
    with TRegistry.Create do
      try
        Rootkey:= HKEY_LOCAL_MACHINE;
        if OpenKey(cstTestKey, True) then begin
          Result := True;
          CloseKey;
          DeleteKey(cstTestKey);
        end{if};
      finally
        Free;
      end{try};
  end{GetIsAdmin};

  // Ist die GDS32.DLL verfÜgbar?
  function IsIBClient:Boolean;
  var IBLibrary: THandle;
  begin
    IBLibrary := LoadLibrary('GDS32.DLL');
    Result := IBLibrary <> 0;
    if Result then FreeLibrary(IBLibrary);
  end{IsIBClient};

begin
  blnGefunden:=False;
  // Ermittlung der Windowsversion und somit der Position der Datei "services"
  strWin:=WinDir;
  // Wo liegt die Datei services?
  if Win32Platform = VER_PLATFORM_WIN32_NT then begin
    // WinNT oder 2000
      strBak:=strWin+'\system32\drivers\etc\services_gds.bak';
      strWin:=strWin+'\system32\drivers\etc\services';
      blnAdmin:=True; // Administrationsrechte ?
  end else begin
    // Windows 95,98,ME
    strBak:=strWin+'\services_gds.bak';
    strWin:=strWin+'\services';
    blnAdmin:=True;
  end;

  // Kontrollieren der Dateiposition
  if fileExists(strWin) then begin
    AssignFile(txtDatei,strWin);
    reset(txtDatei);
    strDummy:='';
    repeat
      readln(txtDatei,strDummy);
      if POS('gds_db',strDummy)>0 then begin
        blnGefunden:=True;
        Break;
      end;
    until eof(txtDatei);
    CloseFile(txtDatei);
    if not blnGefunden then begin
    if blnAdmin then begin
        // Sicherungskopie erstellen
        srcDatei := TFileStream.Create(strWin, fmOpenRead );
        try
          dstDatei := TFileStream.Create( strBak, fmOpenWrite or fmCreate );
        except
          srcDatei.Free;
          exit;
        end;
        try
          dstDatei.CopyFrom(srcDatei, srcDatei.Size ) ;
        except
          dstDatei.Free;
          srcDatei.Free;
          exit;
        end;
        dstDatei.Free;
        srcDatei.Free;
        // gds Eintrag wird erg?zt
        AssignFile(txtDatei, strWin);
        Append(txtDatei);
        writeln(txtDatei,'gds_db           3050/tcp               # InterBase Client');
        { Hier steht Code, der ein Flush vor dem Schlie?n der Datei erfordert. }
        Flush(txtDatei);  { Sicherstellen, da?der Text tats?hlich in die Datei geschrieben wird. }
        CloseFile(txtDatei);
      end else
        MessageDlg('Sie verfÜgen nicht Über Administrationsrechte!'+#13+#10+''+#13+#10+
                   'Daher k?nen die notwendigen Eintragungen nicht durchgefÜhrt '+#13+#10+
                   'werden!'+#13+#10+''+#13+#10+'Melden Sie sich als Administrator noch einmal an!',
                   mtError, [mbAbort], 0);

    end;
  end else begin
    // services wurde nicht gefunden
    MessageDlg('Die Datei services konnte an der Position'+#13+#10+strWin+#13+#10+
               'nicht gefunden werden!', mtError, [mbAbort], 0);
    Halt;
  end;
  // GDS32.DLL kann nicht angesprochen werden
  if not IsIBClient then begin
    MessageDlg('Die Bibliothek GDS32.DLL kann nicht angesprochen werden!', mtError, [mbAbort], 0);
    Halt;
  end;
end;