Zugriff auf Firebird-Server mit Delphi: Beispiel
unit DlgDBC2004Main;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
StdCtrls, ExtCtrls, Forms, ComCtrls, ActnList, Buttons, DB, JvUIBDataSet,
JvUIB, SynEditHighlighter, SynHighlighterSQL, SynEdit, SynMemo, Grids,
DBGrids, DBCtrls;
type
TDBCDialog = class(TForm)
Label2: TLabel;
LRowCount: TLabel;
LRecCount: TLabel;
Label4: TLabel;
LZeit2: TLabel;
JvUIBQuery: TJvUIBQuery;
RBTImplizit: TRadioButton;
RBTExplizit: TRadioButton;
ActBeginnTransaction: TAction;
ActCommit: TAction;
ActRollback: TAction;
BitBtn5: TBitBtn;
BitBtn6: TBitBtn;
BitBtn7: TBitBtn;
cbRetaining: TCheckBox;
procedure PutSQLResult(Sender: TObject);
procedure PutSQLNoResult(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure JvUIBDataSetAfterScroll(DataSet: TDataSet);
procedure JvUIBDataSetBeforeScroll(DataSet: TDataSet);
procedure ChangeTransaction(Sender: TObject);
procedure ActBeginnTransactionExecute(Sender: TObject);
procedure ActCommitExecute(Sender: TObject);
procedure ActRollbackExecute(Sender: TObject);
published
PCDBCampus: TPageControl;
TSSelect: TTabSheet;
TSInsert: TTabSheet;
TSStoredProcedure: TTabSheet;
TSTransaktion: TTabSheet;
Splitter1: TSplitter;
PnResult: TPanel;
DBNavigator1: TDBNavigator;
DBGrid1: TDBGrid;
PnStatusResult: TPanel;
Label1: TLabel;
LZeit: TLabel;
SMSelect1: TSynMemo;
SynSQLSyn: TSynSQLSyn;
SMSelect2: TSynMemo;
SMInsertSelect: TSynMemo;
SynMemo1: TSynMemo;
SynMemo2: TSynMemo;
SynMemo3: TSynMemo;
SynMemo4: TSynMemo;
SynMemo5: TSynMemo;
DataSourceDisplay: TDataSource;
JvUIBDataBase: TJvUIBDataBase;
JvUIBTransaction: TJvUIBTransaction;
JvUIBDataSet: TJvUIBDataSet;
TSAction: TTabSheet;
BitBtn1: TBitBtn;
ActionList: TActionList;
ActConnect: TAction;
ActDisconnect: TAction;
BitBtn2: TBitBtn;
ActExecute: TAction;
BitBtn3: TBitBtn;
ActInit: TAction;
BitBtn4: TBitBtn;
procedure ActInitExecute(Sender: TObject);
procedure ActConnectExecute(Sender: TObject);
procedure ActDisconnectExecute(Sender: TObject);
procedure ActExecuteExecute(Sender: TObject);
private
sStart,sEnd : TTime;
FExecSql: Boolean;
procedure SetExecSql(const Value: Boolean);
public
property ExecSql : Boolean read FExecSql write SetExecSql;
end;
var
DBCDialog: TDBCDialog;
implementation
uses
Dialogs, JvUIBLib;
{$R *.DFM}
procedure TDBCDialog.ActInitExecute(Sender: TObject);
VAR
Wo : Integer;
Role : string;
begin
LZeit2.Caption:='';
LZeit.Caption:='Verbinde...';
Screen.Cursor:=crSQLWait;
ActDisconnect.Execute;
ExecSql:=False;
// Zuerst Database mit PArametern versehen
with JvUIBDataBase do begin
DatabaseName:='dbphoenix.rrze.uni-erlangen.de:campus2004';
UserName:='DBCAMPUS'; // ersetzen Sie den Benutzernamen durch einen gültigen DB-Account!
Password:='*******';
CharacterSet:=csISO8859_1;
SQLDialect:=3;
// Für die role fehlt das Property...
// Aber man kann sie über Params trotzdem setzen
Wo:=Params.IndexOf('sql_role_name=');
Role:=Format('%s=%s',['sql_role_name','DEMO']);
if Wo <> -1 then
Params[Wo]:=Role
else
Params.Add(Role);
end;
// Die Transaktion muss mit der Datenbank verbunden werden
with JvUIBTransaction do begin
DataBase:=JvUIBDataBase;
end;
// Das DataSet muss mit Datenbank und Transkation verbunden werden ...
with JvUIBDataSet do begin
Database:=JvUIBDataBase;
Transaction:=JvUIBTransaction;
end;
// ... ebenso die Query
with JvUIBQuery do begin
Database:=JvUIBDataBase;
Transaction:=JvUIBTransaction;
end;
Screen.Cursor:=crDefault;
LZeit.Caption:='Initialisiert';
end;
procedure TDBCDialog.ActConnectExecute(Sender: TObject);
begin
try
JvUIBDataBase.Connected:=True;
except
ON E:Exception DO
Application.ShowException(E);
end;
if JvUIBDataBase.Connected then
LZeit.Caption:='Verbunden mit DBCampus-Datenbank'
else
LZeit.Caption:='Fehler beim Verbinden mit DBCampus-Datenbank';
LZeit2.Caption:='';
PnResult.Visible:=True;
end;
procedure TDBCDialog.ActDisconnectExecute(Sender: TObject);
begin
try
try
JvUIBDataSet.Close;
finally
JvUIBDataBase.Connected:=False;
end
except
ON E:Exception DO
Application.ShowException(E);
end;
if not JvUIBDataBase.Connected then
LZeit.Caption:='Nicht mehr verbunden mit DBCampus-Datenbank'
else
LZeit.Caption:='Fehler beim Lösen der Verbinden mit DBCampus-Datenbank';
LZeit2.Caption:='';
PnResult.Visible:=False;
end;
procedure TDBCDialog.ActExecuteExecute(Sender: TObject);
VAR
Start,Ende : TTime;
begin
JvUIBDataSetBeforeScroll(nil);
Screen.Cursor:=crSQLWait;
// Nur zur Faulheit und um den Status von Transaktionen zu überprüfen
if RBTExplizit.Checked and not JvUIBTransaction.InTransaction then
ActBeginnTransaction.Execute;
// Erstmal schliessen
JvUIBDataSet.Active:=False;
LZeit.Caption:='Führe SQL aus...';
// Zeitmessung
Start:=Now;
// Schauen, ob es überhaupt ein SQL-Statment gibt
if JvUIBDataSet.SQL.Text = '' then
MessageDlg('Bitte SQL eingeben!', mtError, [mbOK], 0)
else begin
try
// "EXECUTE PROCEDURE" für Strored Procedures;
if FExecSql then begin
JvUIBQuery.SQL.Text:=JvUIBDataSet.SQL.Text;
JvUIBQuery.Execute;
end else
// "SELECT" für andere
JvUIBDataSet.Active:=True;
Ende:=Now; // Zeitmessung
LZeit.Caption:=FormatDateTime('nn:ss.zzz',Ende-Start); // Zeit ausgeben
except
ON E: EUIBError do begin
Screen.Cursor:=crDefault;
// Spezielle Exception-Klasse mit Fehler-Codes
MessageDlg('UIB-SQL Fehler: '+E.Message, mtError, [mbOK], 0);
// Details an Stelle von Zeit ausgeben:
// GDS Code ist Fehlermeldung der Datenbank
// SQL Code ist Fehlermeldung des SQL-Parsers
LZeit.Caption:='Fehler: GDS: '+IntToStr(E.ErrorCode)+' SQL: '+IntToStr(E.SQLCode);
end;
ON E: Exception do begin
Screen.Cursor:=crDefault;
// Andere Fehler, die keine EUIBErrors sind:
Application.ShowException(E);
LZeit.Caption:='Fehler!';
end;
end;
end;
// Anzeige der betroffenen Zeilen
if ExecSql then begin
// Aus der Query
LRowCount.Caption:=IntToStr(JvUIBQuery.RowsAffected);
LRecCount.Caption:='-';
end else begin
// Aus dem DataSet
LRowCount.Caption:=IntToStr(JvUIBDataSet.RowsAffected); // Sollte immer 0 sein
LRecCount.Caption:=IntToStr(JvUIBDataSet.RecordCount); // Anzahl der gefetchten records
end;
Screen.Cursor:=crDefault;
end;
procedure TDBCDialog.SetExecSql(const Value: Boolean);
begin
FExecSql := Value;
end;
procedure TDBCDialog.PutSQLResult(Sender: TObject);
begin
JvUIBDataSet.SQL.Text:=(Sender AS TSynMemo).Text;
ExecSql := False;
ActExecute.Execute;
end;
procedure TDBCDialog.PutSQLNoResult(Sender: TObject);
begin
JvUIBDataSet.SQL.Text:=(Sender AS TSynMemo).Text;
ExecSql := True;
ActExecute.Execute;
end;
procedure TDBCDialog.FormCreate(Sender: TObject);
begin
LZeit.Caption:='';
LZeit2.Caption:='';
LRowCount.Caption:='-';
LRecCount.Caption:='-';
PCDBCampus.ActivePageIndex:=0;
RBTImplizit.Checked:=True;
PnResult.Visible:=False;
end;
procedure TDBCDialog.JvUIBDataSetAfterScroll(DataSet: TDataSet);
begin
SEnd:=Now;
LZeit2.Caption:='Scroll-Time: '+FormatDateTime('nn:ss.zzz',SStart-SEnd);
LRecCount.Caption:=IntToStr(JvUIBDataSet.RecordCount);
Screen.Cursor:=crDefault;
end;
procedure TDBCDialog.JvUIBDataSetBeforeScroll(DataSet: TDataSet);
begin
SStart:=Now;
Screen.Cursor:=crSQLWait;
end;
procedure TDBCDialog.ChangeTransaction(Sender: TObject);
begin
Screen.Cursor:=crSQLWait;
JvUIBTransaction.Commit;
if RBTImplizit.Checked then begin
JvUIBTransaction.AutoStart:=True;
JvUIBTransaction.AutoStop:=True;
end else begin
JvUIBTransaction.AutoStart:=False;
JvUIBTransaction.AutoStop:=False;
end;
Screen.Cursor:=crDefault;
end;
procedure TDBCDialog.ActBeginnTransactionExecute(Sender: TObject);
begin
Screen.Cursor:=crSQLWait;
JvUIBTransaction.StartTransaction;
Screen.Cursor:=crDefault;
end;
procedure TDBCDialog.ActCommitExecute(Sender: TObject);
begin
Screen.Cursor:=crSQLWait;
if cbRetaining.Checked then
JvUIBTransaction.CommitRetaining
else
JvUIBTransaction.Commit;
Screen.Cursor:=crDefault;
end;
procedure TDBCDialog.ActRollbackExecute(Sender: TObject);
begin
Screen.Cursor:=crSQLWait;
if cbRetaining.Checked then
JvUIBTransaction.RollBackRetaining
else
JvUIBTransaction.RollBack;
Screen.Cursor:=crdefault;
end;
end.
zum Seitenanfang
Navigation ausblenden
