Get all foreignkeys in use in a given table (MS SQL Server)

——————————————————————–

The system stored procedure “sp_fkeys ([tablename])” will only give
a list of foreign key references to the given table.
The “GetForeignKeys” function above will give you the list of fields
that are “foreign hold” from other tables.

Try out: You’ll need an AdoConnection to your DB …

Tested with: Delphi 7(Ent) und WinXP

——————————————————————–

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGrids, DB, ADODB, StdCtrls, DBCtrls;

type
  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    Memo1: TMemo;
    BStart: TButton;
    procedure BStartClick(Sender: TObject);
  private
    procedure GetForeignKeys(sTableName: string;
      MyConnection: TADOConnection;
      var SlForeignKeyName,
      SlKeysActTable,
      SlKeysForeignTable,
      SlForeignKeyTable: TStringList);
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

(* Get foreign keys *)
procedure TForm1.GetForeignKeys(sTableName: string;
  MyConnection: TADOConnection;
  var SlForeignKeyName,
  SlKeysActTable,
  SlKeysForeignTable,
  SlForeignKeyTable: TStringList);
var
  MySelectQuery, MyRecordQuery: TADOQuery;
  i: Integer;
  SlKeysAct, SlKeysFor: TStringList;
  sConstraintName, sForeignKeys, sForeignTable: string;

  (* Schlüssel ermitteln *)
  procedure GetKeys(sKeyList: string; fAct: Boolean);
  var
    i: Integer;
    sKey: string;
  begin
    i := 0;
    repeat
      Inc(i);
      if sKeyList[i] <> ',' then
      begin
        sKey := sKey + sKeyList[i];
      end
      else
      begin
        if fAct then
        begin
          SlKeysAct.Add(sKey);
        end
        else
        begin
          SlKeysFor.Add(sKey);
        end;
        if (Length(sKey) + 1) < i then
        begin
          if sKey[(i + 1)] = ' ' then
          begin
            Inc(i);
          end;
        end;
        sKey := '';
      end;
    until (i = Length(sKeyList));
    if sKey <> '' then
    begin
      if fAct then
      begin
        SlKeysAct.Add(sKey);
      end
      else
      begin
        SlKeysFor.Add(sKey);
      end;
    end;
  end;

  procedure GetForeignKeyFieldsAndTable(sSQL: string);
  var
    i: Integer;
    sValue: string;
    iPos: Integer;
    fAddValue: Boolean;
    fInFields: Boolean;
  begin
    if Length(sSQL) >= 10 then
    begin
      (* REFERENCES entfernen *)
      sValue := Copy(sSQL, 1, 10);
      if AnsiUpperCase(sValue) = 'REFERENCES' then
      begin
        Delete(sSQL, 1, 11);
      end;
      i         := 0;
      iPos      := 0;
      sValue    := '';
      fInFields := False;
      repeat
        Inc(i);
        fAddValue := False;
        (* "normal" lesen *)
        if (sSQL[i] <> '.') and
          (sSQL[i] <> ' ') and
          (sSQL[i] <> '(') and
          (sSQL[i] <> ')') and
          (fInFields = False) then
        begin
          sValue    := sValue + sSQL[i];
          fAddValue := True;
        end;
        (* In Felder *)
        if sSQL[i] = '(' then
        begin
          fInFields := True;
        end;
        if (fInFields) and (sSQL[i] <> '(') and (sSQL[i] <> ')') then
        begin
          sValue := sValue + sSQL[i];
        end;
        (* Felder verlassen *)
        if sSQL[i] = ')' then
        begin
          fInFields := False;
        end;
        if (fAddValue = False) and (fInFields = False) then
        begin
          case iPos of
            (* Datenbank *)
            0:
              begin
                sValue := '';
                Inc(iPos);
              end;
            (* Ower *)
            1:
              begin
                sValue := '';
                Inc(iPos);
              end;
            (* Tabelle *)
            2:
              begin
                sForeignTable := sValue;
                sValue        := '';
                Inc(iPos);
              end;
            (* Felder *)
            3:
              begin
                sForeignKeys := sValue;
                sValue       := '';
                Inc(iPos);
              end;
            else
              begin
              end;
          end;
        end;
      until (i = Length(sSQL));
    end;
  end;
begin
  try
    MySelectQuery := TADOQuery.Create(Application);
    with MySelectQuery do
    begin
      Name       := 'MyHelpSelectQuery';
      Connection := MyConnection;
      SQL.Add('sp_help ' + sTableName);
      Active := True;
    end;
    try
      MyRecordQuery := TADOQuery.Create(Application);
      with MySelectQuery do
      begin
        Name       := 'MyHelpRecordQuery';
        Connection := MyConnection;
        Recordset  := MySelectQuery.NextRecordset(i);
        Recordset  := MySelectQuery.NextRecordset(i);
        Recordset  := MySelectQuery.NextRecordset(i);
        Recordset  := MySelectQuery.NextRecordset(i);
        Recordset  := MySelectQuery.NextRecordset(i);
        if MySelectQuery.State = dsBrowse then
        begin
          Recordset := MySelectQuery.NextRecordset(i);
          if FindField('Constraint_Type') <> nil then
          begin
            SlKeysAct := TStringList.Create;
            SlKeysFor := TStringList.Create;
            try
              while not EOF do
              begin
                if AnsiUpperCase(FieldByName('Constraint_Type').AsString) =
                  AnsiUpperCase('FOREIGN KEY') then
                begin
                  SlKeysAct.Clear;
                  (* In einzelne Felder teilen *)
                  GetKeys(FieldByName('Constraint_Keys').AsString, True);
                  (* Constraint festhalten *)
                  sConstraintName := FieldByName('Constraint_Name').AsString;
                  (* Referenz steht im nنchsten Datensatz *)
                  Next;
                  (* Tabelle und Felder auflِsen *)
                  GetForeignKeyFieldsAndTable(FieldByName('Constraint_Keys').AsString);
                  (* In einzelne Felder teilen *)
                  SlKeysFor.Clear;
                  GetKeys(sForeignKeys, False);
                  for i := 0 to (SlKeysAct.Count - 1) do
                  begin
                    SlForeignKeyName.Add(sConstraintName);

                    SlKeysActTable.Add(SlKeysAct.Strings[i]);

                    SlKeysForeignTable.Add(SlKeysFor.Strings[i]);

                    SlForeignKeyTable.Add(sForeignTable);
                  end;
                end;
                Next;
              end;
            finally
              FreeAndNil(SlKeysAct);
              FreeAndNil(SlKeysFor);
            end;
          end;
        end;
      end;

    finally
      FreeAndNil(MyRecordQuery);
    end;
  finally
    FreeAndNil(MySelectQuery);
  end;
end;

procedure TForm1.BStartClick(Sender: TObject);
var
  SlForeignKeyName, SlKeysActTable, SlKeysForeignTable, SlForeignKeyTable: TStringList;
  i: Integer;
begin
  try
    SlForeignKeyName   := TStringList.Create;
    SlKeysActTable     := TStringList.Create;
    SlKeysForeignTable := TStringList.Create;
    SlForeignKeyTable  := TStringList.Create;
    GetForeignKeys('Kundendaten',      // Tabellenname
      ADOConnection1,     // ADO-Connection
      SlForeignKeyName,   // Fremdschlüsselname
      SlKeysActTable,     // Alle Schlüsselfelder der aktuellen Tabelle
      SlKeysForeignTable, // Alle Fremdschlüsselfelder
      SlForeignKeyTable); // Fremdschlüsseltabellenname
    (* Ins Memo schreiben ... *)
    for i := 0 to (SlForeignKeyName.Count - 1) do
    begin
      if i > 0 then
      begin
        Memo1.Lines.Add('');
      end;
      Memo1.Lines.Add(SlForeignKeyName.Strings[i]);
      Memo1.Lines.Add(SlKeysActTable.Strings[i]);
      Memo1.Lines.Add(SlKeysForeignTable.Strings[i]);
      Memo1.Lines.Add(SlForeignKeyTable.Strings[i]);
    end;
  finally
    FreeAndNil(SlForeignKeyName);
    FreeAndNil(SlKeysActTable);
    FreeAndNil(SlKeysForeignTable);
    FreeAndNil(SlForeignKeyTable);
  end;
end;

end.