20-06-19, 02:27 AM
Get List of active users in Sql Server
كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOQuery1.SQL.Add('Exec SP_WHO');
ADOQuery1.Active := True;
end;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.Create Tables Detial/Master in Sql Server 2000 With Code
كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOCommand1.CommandText := 'Create Table MasterTable ' +
'(FieldName Primary Key);';
ADOCommand1.Execute;
ADOCommand1.CommandText := 'Create Table Detailtable ' +
'(Fieldname Primary Key Refrenced Mastertable(Fieldname));';
ADOCommand1.Execute;
end;Connect To Sql Server 2000
كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOConnection1.ConnectionString := 'Server=Hostname;DataBase=DatabaseName';
ADOConnection1.Open('UserName', 'Password');
ADOConnection1.Connected := True;
end;Adapt DateTime values for SQL-Server or Access formats
كود :
{---------------------------------------------------------------------
Dieser Tip ist als Verbesserung zum ursprünglichen Artikel
http://www.swissdelphicenter.ch/de/showcode.php?id=1423
gedacht.
Die folgende Funktionen wandeln einen DateTime Wert
(unabhنngig vom eingestelltem Datumsformat) in einen
für den SQL-Server verstنndlichen String um.
----------------------------------------------------------------------
Please also take a look at the initial tip:
http://www.swissdelphicenter.ch/de/showcode.php?id=1423
the following functions converts a datatime value
(independant of the dateformat) to a string that
is readably by the SQL Server
---------------------------------------------------------------------}
function DateTimeToSQLServerDateTimeString(Value: TDateTime): string;
begin
Result := '{ ts' + QuotedStr(FormatDateTime('yyyy-mm-dd hh":"nn":"ss.z', Value)) + ' }';
end;
function DateTimeToSQLServerDateString(Value: TDateTime): string;
begin
Result := '{ d' + QuotedStr(FormatDateTime('yyyy-mm-dd', Value)) + ' }';
end;
function DateTimeToSQLServerTimeString(Value: TDateTime): string;
begin
Result := '{ t' + QuotedStr(FormatDateTime('hh":"nn":"ss.z', Value)) + ' }';
end;
{
dito für die Jet-Engine (Access-Datenbank)
also for the Jet-Engine (Access database)
}
function DateTimeToAccessDateTimeString(Value: TDateTime): string;
function FloatToStrEx(const Value: Extended; const DecSep: Char): string;
var
OldSep: Char;
begin
OldSep := DecimalSeparator;
try
DecimalSeparator := DecSep;
Result := FloatToStr(Value);
finally
DecimalSeparator := OldSep;
end;
end;
begin
// Da Access (Jet-Engine) ein Datum als Double speichert...
// because Access (Jet-Engine) stores a date as a double...
Result := FloatToStrEx(Value, '.');
end;