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:

procedure Tform1.reggds32;
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;					

1:

DM.IBFirma.Databasename:=(GetExtractFilePath(Paramstring(0))+'\db\xxx.gdb');