ALpMontana
КЯaL´da TaNıMaM КuяaL´da
Database İle İlgili Tüm kodlar
TTable ve TQuery deki tüm kodlar ve sorgulamalar..
Herkese faydası olacak bilgiler mevcut..
VERİ TABANI
Bu başlık altında, Delphi programlarında veri tabanı ve veri erişiminde kullanılan bileşenler ile ilgili püf noktaları ve gerekli kod örnekleri yer almaktadır.
TTABLE/TQUERY ÜZERİNDE ARTTIRARAK ARAMA
TEdit kullanarak, TTable üzerinde arttırmalı arama yapmak için, Tedid bileşeninin OnChange olay yordamına, aşağıdaki kod yazılır.
procedure TForm1.Edit1Change(Sender: TObject);
begin
With Edit1 do
if Text <> " then
Table1.FindNearest([Text]);
end;
Bu türlü bir arama Tquerry üzerinde yapılacaksa,
procedure TForm1.Edit1Change(Sender: TObject);
begin
With Edit1 do
if Text <> " then begin
Query1.Filter := 'code = "'+Edit1.Text+"";
Query1.FindFirst;
end;
end;
veya
procedure TForm1.Edit1Change(Sender: TObject);
begin
With Edit1 do
if Text <> " then
Query1.Locate('code',Edit1.Text,[loPartialKey]);
end;
Paradox-Tablo yaratılması
Kod içerisinden bir Paradox tablosu şu şekilde yaratılır.
with TTable.create(self) do begin
DatabaseName := 'C:\temp';
TableName := 'FOO';
TableType := ttParadox;
with FieldDefs do Begin
Add('Age', ftInteger, 0, True);
Add('Name', ftString, 25, False);
Add('Weight', ftFloat, 0, False);
End;
IndexDefs.Add('MainIndex','IntField', [ixPrimary,
ixUnique]);
CreateTable;
End;
DBMemo içeriğinin başka bir DBMemo bileşenine aktarılması
DBMemo6.Lines:=DBMemo5.Lines.Assign;
TDBNavigator bileşenin, kod içerisinden kontrol edilmesi
procedure TForm1.DBNavigator1Click(Sender: TObject; Button:
TNavigateBtn);
var
BtnName: string;
begin
case Button of
nbFirst : BtnName := 'nbFirst';
nbPrior : BtnName := 'nbPrior';
nbNext : BtnName := 'nbNext';
nbLast : BtnName := 'nbLast';
nbInsert : BtnName := 'nbInsert';
nbDelete : BtnName := 'nbDelete';
nbEdit : BtnName := 'nbEdit';
nbPost : BtnName := 'nbPost';
nbCancel : BtnName := 'nbCancel';
nbRefresh: BtnName := 'nbRefresh';
end;
MessageDlg(BtnName + ' button clicked.', mtInformation,
[mbOK], 0);
end;
DBMEMO İÇERİSİNDE BİR METNİN ARANMASI
procedure Tform1.FindDialog1Find(Sender: TObject);
var Buff, P, FT : PChar;
BuffLen : Word;
begin
With Sender as TFindDialog do
begin
GetMem(FT, Length(FindText) + 1);
StrPCopy(FT, FindText);
BuffLen:= DBMemo1.GetTextLen + 1;
GetMem(Buff,BuffLen);
DBMemo1.GetTextBuf(Buff,BuffLen);
P:= Buff + DBMemo1.SelStart + DBMemo1.SelLength;
P:= StrPos(P, FT);
if P = NIL then MessageBeep(0)
else
begin
DBMemo1.SelStart:= P - Buff;
DBMemo1.SelLength:= Length(FindText);
end;
FreeMem(FT, Length(FindText) + 1);
FreeMem(Buff,BuffLen);
DBMemo1.SetFocus;
end;
end;
Şekil 1 : Form1
kod örneği 1 : form1.dfm
object Form1: TForm1
Left = 200
Top = 108
Width = 696
Height = 445
Caption = 'Form1'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
PixelsPerInch = 96
TextHeight = 13
object DBMemo1: TDBMemo
Left = 16
Top = 152
Width = 657
Height = 193
DataField = 'Notes'
DataSource = DataSource1
TabOrder = 0
OnDblClick = DBMemo1DblClick
end
object DBGrid1: TDBGrid
Left = 16
Top = 16
Width = 657
Height = 120
DataSource = DataSource1
TabOrder = 1
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
object DBNavigator1: TDBNavigator
Left = 432
Top = 352
Width = 240
Height = 25
TabOrder = 2
end
object DataSource1: TDataSource
DataSet = Table1
Left = 138
Top = 364
end
object Table1: TTable
Active = True
DatabaseName = 'dbdemos'
TableName = 'BIOLIFE.DB'
Left = 220
Top = 366
end
object FindDialog1: TFindDialog
OnFind = FindDialog1Find
Left = 40
Top = 360
end
end
kod örneği 2 : unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs,StdCtrls, Grids, DBGrids, Db, DBTables,
DBCtrls, ExtCtrls;
type
TForm1 = class(TForm)
DBMemo1: TDBMemo;
DataSource1: TDataSource;
Table1: TTable;
DBGrid1: TDBGrid;
FindDialog1: TFindDialog;
DBNavigator1: TDBNavigator;
procedure FindDialog1Find(Sender: TObject);
procedure DBMemo1DblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure Tform1.FindDialog1Find(Sender: TObject);
var Buff, P, FT : PChar;
BuffLen : Word;
begin
With Sender as TFindDialog do
begin
GetMem(FT, Length(FindText) + 1);
StrPCopy(FT, FindText);
BuffLen:= DBMemo1.GetTextLen + 1;
GetMem(Buff,BuffLen);
DBMemo1.GetTextBuf(Buff,BuffLen);
P:= Buff + DBMemo1.SelStart + DBMemo1.SelLength;
P:= StrPos(P, FT);
if P = NIL then MessageBeep(0)
else
begin
DBMemo1.SelStart:= P - Buff;
DBMemo1.SelLength:= Length(FindText);
end;
FreeMem(FT, Length(FindText) + 1);
FreeMem(Buff,BuffLen);
DBMemo1.SetFocus;
end;
end;
procedure TForm1.DBMemo1DblClick(Sender: TObject);
begin
finddialog1.execute;
end;
end.
BİR TABLONUN ALAN BİLGİLERİNİN ELDE EDİLMESİ
Ttable bileşeninden yola çıkarak, bağlı olduğu tablonun alan bilgileri "FieldDefs" özelliği sayesinde elde edilebilir. GetFieldNames davranışı alan isimlerini, GetIndexNames davranışı ise tabloda mevcut olan indeks isimlerini döndürür.
Şekil 2 : form1
kod örneği 3 : form1.dfm
object Form1: TForm1
Left = 200
Top = 108
Width = 425
Height = 340
Caption = 'Form1'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 16
Top = 136
Width = 43
Height = 13
Caption = 'İndeksler'
end
object Label2: TLabel
Left = 16
Top = 0
Width = 32
Height = 13
Caption = 'Alanlar'
end
object Label3: TLabel
Left = 232
Top = 0
Width = 122
Height = 13
Caption = 'Alan isimleri ve uzunlukları'
end
object Memo1: TMemo
Left = 232
Top = 16
Width = 169
Height = 249
Lines.Strings = ( 'Memo1')
TabOrder = 0
end
object Button1: TButton
Left = 240
Top = 272
Width = 153
Height = 25
Caption = 'Alan isimleri ve uzunlukları'
TabOrder = 1
OnClick = Button1Click
end
object Button2: TButton
Left = 16
Top = 272
Width = 201
Height = 25
Caption = 'Alan ve İndeks isimleri '
TabOrder = 2
OnClick = Button2Click
end
object ListBox1: TListBox
Left = 16
Top = 16
Width = 201
Height = 113
ItemHeight = 13
TabOrder = 3
end
object ListBox2: TListBox
Left = 16
Top = 152
Width = 201
Height = 113
ItemHeight = 13
TabOrder = 4
end
object Table1: TTable
DatabaseName = 'dbdemos'
TableName = 'ANIMALS.DBF'
Left = 104
Top = 72
end
kod örneği 4 : unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs,StdCtrls, Db, DBTables;
type
TForm1 = class(TForm)
Memo1: TMemo;
Table1: TTable;
Button1: TButton;
Button2: TButton;
ListBox1: TListBox;
ListBox2: TListBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure ShowFields;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.ShowFields;
var
i : Word;
begin
Memo1.Lines.Clear;
Table1.FieldDefs.Update;
for i := 0 to Table1.FieldDefs.Count - 1 do
With Table1.FieldDefs.Items do
Memo1.Lines.Add(Name + ' - ' + IntToStr(Size));
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
showfields;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
If Table1.State = dsInactive then Table1.Open;
Table1.GetFieldNames(listbox1.items);
Table1.GetIndexNames(listbox2.items);
end;
end.
TDBGRİD BİLEŞENİ ÜZERİNDE, KAYIT SIRALAMA
Eğer bir Interbase tablosu ile çalışılıyor ise, Dbgrid üzerinde seçilen kolon başlığına göre verilerin sıralanması
mümkündür.
procedure TForm1.DBGrid1CellClick(Column: TColumn);
begin
if checkbox1.checked then
with dbgrid1.datasource.dataset as ttable do
indexfieldnames:=column.field.fieldname;
end;
MEVCUT TABLODAKİ KOLONLARIN ELENMESİ
Bir tablodaki alanların "Visible" özelliğine "False" değeri verilerek, istenmeyen alanların görüntülenmesi engellenir.
Table1.FieldByName(<saklanacak alanb adı>).Visible := False;
veya
Table1.Field[<saklanacak alan no>].Visible := false;
BİR TABLODAKİ TMEMOFİELD TİPLİ BİR ALAN İÇERİĞİNİN
TMEMO BİLEŞENİNE AKTARILMASI
Procedure TMemoToTMemoField;
begin
TMemoField.Assign( TMemo.Lines );
end;
Procedure TMemoFieldToTMemo;
VAR aBlobStream : TBlobStream;
Begin
aBlobStream :=
TBlobStream.Create(tblobfield(table1.fieldbyname('Notes')),
bmRead);
Memo1.Lines.LoadFromStream( aBlobStream );
aBlobStream.Free;
end;
BİR PARADOX TABLOSUNA İKİNCİ İNDEKS EKLENMESİ
Table1.AddIndex('<indeks adı>', 'CustNo;CustName',
[ixDescending]);
DBGrid kolonları üzerinde dolaşma
dbgrid1.selectedindex:=dbgrid1.selectedindex+1;
dbgrid1.setfocus;
DETAYI OLAN BİR TABLODAN KAYIT SİLME
Master-Detay ilişki içerisindeki tablolarda, detayı olan bir ana kayıt silindiğinde, detaylar ortada kalır. Ana kayıt olmadığına göre detaylara da ihtiyaç yoktur. Bu nedenle ana kayıt silinmeden önce detayları silmek gerekir.
Table1 ana tabloya, Table2 de Detay tabloya bağlı kabul edilirse, Table1' den bir kayıt silinmek istendiğinde önce Table2' deki detaylar temizlenecektir aşağıdaki örnek bunu göstermektedir.
procedure TForm1.Table1BeforeDelete(DataSet: TDataset)
begin
with Table2 do begin
DisableControls;
First;
While not EOF do
Delete;
EnableControls;
end;
end;
DBGRİD VE MEMO ALANLAR
DBGrid bileşeninde Memo/Blob alanlar <memo> olarak gösterilir. Aşağıdaki örnekte bu tür alanların da metin olarak görüntülenmesi sağlanmaktadır. Table bileşeni üzerine yüklenen kolonlardan NOTES alanı MEMO tipindedir. Bu alanın GetText yordamında Blob2Str fonksiyonu kullanılarak, alandaki veri görünür hale getirilmektedir.
procedure TForm1.Table1NotesGetText(Sender: TField; var Text:
String;
DisplayText: Boolean);
begin
Text := Blob2Str(TMemoField(Sender));
end;
Blob2Str fonksiyonu:
function Blob2Str(TheField : TMemoField): String;
var
Buffer: PChar;
MemSize: Integer;
tmp:string;
begin
if TheField.IsNull then
Result := " else
with TBlobStream.Create(TheField, bmRead) do
begin
MemSize := Size;
Inc(MemSize); Buffer := AllocMem(MemSize);
Read(Buffer^, memsize);
Free;
end;
result:=strpas(buffer);
end;
TABLO İÇERİĞİNİN TSTRİNGRİD BİLEŞENİNE DOLDURULMASI
Tablo içeriğinin TstrinGrid bileşenine doldurulması şu şekilde olur.
table.first;
row := 0;
grid.rowcount := table.recordCount;
while not table.eof do begin
for i := 0 to table.fieldCount-1 do
grid.cells[i,row] := table.fields.asString;
inc (row);
table.next;
end;
TTABLE VEYA TQUERY ÜZERİNDEN KAYIT NUMARASININ BULUNMASI
Dataset Paradox veya dBASE tablosuna bağlı ise kayıt numarasını bulmak, birkaç BDE fonksiyon kullanmak
suretiyle mümkündür. Ancak SQL tabanlı veri tabanı sunumcularında, sunumcunun kendisi buna imkan
vermiyorsa, bu bilgi elde edilemez. Aşağıdaki fonksiyon parametre olarak bir Ttable bileşeni almakta ve gösterdiği Paradox/dBase tablosunudan kayıt numarasını, başarısız olduğunda ise 0 değerini döndürmektedir. Bu fonksiyonun döndürdüğü kayıt numarası, kaydın tablodaki fiziksel yeri ile ilgilidir. İndeks tanımlanmış bir TTable veya "Order by" ile sıraya sokulmuş bir sorgu kümesi döndüren Tquery bileşeninde, hatalı değer döndüğü sanılmamalıdır.
uses
DbiProcs, DbiTypes, DBConsts;
function Form1.Recno( oTable: TTable ): Longint;
var
rError: DBIResult;
rRecProp: RECprops;
szErrMsg: DBIMSG;
begin
Result := 0;
try
oTable.UpdateCursorPos;
rError := DbiGetRecord( oTable.Handle, dbiNOLOCK, nil,
@rRecProp );
if rError = DBIERR_NONE then
Result := rRecProp.iPhyRecNum
else
case rError of
DBIERR_BOF: Result := 1;
DBIERR_EOF: Result := oTable.RecordCount + 1;
else
begin
DbiGetErrorString( rError, szErrMsg );
ShowMessage( StrPas( szErrMsg ));
end;
end;
except
on E: EDBEngineError do ShowMessage( E.Message );
end;
end;
Şekil 3 : Form1
kod örneği 5 : form1.dfm
object Form1: TForm1
Left = 200
Top = 108
Width = 451
Height = 250
Caption = 'Form1'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 112
Top = 16
Width = 32
Height = 13
Caption = 'Label1'
end
object Label2: TLabel
Left = 32
Top = 16
Width = 49
Height = 13
Caption = 'Kayıt No : '
end
object DBGrid1: TDBGrid
Left = 16
Top = 32
Width = 417
Height = 120
DataSource = DataSource1
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
object DBNavigator1: TDBNavigator
Left = 192
Top = 168
Width = 240
Height = 25
DataSource = DataSource1
TabOrder = 1
end
object DataSource1: TDataSource
DataSet = Table1
Left = 88
Top = 168
end
object Table1: TTable
Active = True
AfterScroll = Table1AfterScroll
DatabaseName = 'dbdemos'
TableName = 'ANIMALS.DBF'
Left = 16
Top = 168
end
end
kod örneği 6 : unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs,StdCtrls, ExtCtrls, DBCtrls, Grids, DBGrids,
Db, DBTables;
type
TForm1 = class(TForm)
DataSource1: TDataSource;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
Label1: TLabel;
Label2: TLabel;
Table1: TTable;
function Recno( oTable: Ttable): Longint;
procedure Table1AfterScroll(DataSet: TDataSet);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
DbiProcs, DbiTypes, DBConsts;
{$R *.DFM}
function TForm1.Recno( oTable: Ttable): Longint;
var
rError: DBIResult;
rRecProp: RECprops;
szErrMsg: DBIMSG;
begin
Result := 0;
try
oTable.UpdateCursorPos;
rError := DbiGetRecord( oTable.Handle, dbiNOLOCK, nil,
@rRecProp );
if rError = DBIERR_NONE then
Result := rRecProp.iPhyRecNum
else
case rError of
DBIERR_BOF: Result := 1;
DBIERR_EOF: Result := oTable.RecordCount + 1;
else
begin
DbiGetErrorString( rError, szErrMsg );
ShowMessage( StrPas( szErrMsg ));
end;
end;
except
on E: EDBEngineError do ShowMessage( E.Message );
end;
end;
procedure TForm1.Table1AfterScroll(DataSet: TDataSet);
begin
label1.caption:=inttostr(recno(table1));
end;
end.
DBASE TABLOLARINDAN SİLİNMİŞ KAYITLARIN ATILMASI
Bu işlem için DBIPackTable. İsimli BDE fonksiyonu kullanılır. Örnek kod şu şekildedir.
uses
DbiProcs, DbiTypes, DBConsts;
procedure TForm1.Button1Click(Sender: TObject);
var
Error: DbiResult;
ErrorMsg: String;
Special: DBIMSG;
begin
table1.Active := False;
try
Table1.Exclusive := True;
Table1.Active := True;
Error := DbiPackTable(Table1.DBHandle, Table1.Handle,
nil, szdBASE, True);
Table1.Active := False;
Table1.Exclusive := False;
finally
Table1.Active := True;
end;
case Error of
DBIERR_NONE:
ErrorMsg := 'Tamam';
DBIERR_INVALIDPARAM:
ErrorMsg := 'Tablo belirsiz' +
'name is NULL';
DBIERR_INVALIDHNDL:
ErrorMsg := 'Veri tabanı belirsiz';
DBIERR_NOSUCHTABLE:
ErrorMsg := 'Tablo adı belirsiz';
DBIERR_UNKNOWNTBLTYPE:
ErrorMsg := 'Tablo tipi belirsiz';
DBIERR_NEEDEXCLACCESS:
ErrorMsg := 'Tablo exclusive modda değil';
else
DbiGetErrorString(Error, Special);
ErrorMsg := '[' + IntToStr(Error) + ']: ' + Special;
end;
MessageDlg(ErrorMsg, mtWarning, [mbOk], 0);
end;
UYGULAMA İÇERİSİNDEN BDE KOD ADI (ALİAS) YARATILMASI
procedure createalias(aliasname, servername, servertype,
filename:string);
var
List: TStringList;
lang,
user,
pdox : string;
begin
lang:='ANTURK';
user:='SYSDBA';
pdox:='PARADOX';
List := TStringList.Create;
with List do
begin
Clear;
if servertype='INTRBASE' then
begin
Add(Format('SERVER NAME=%s',[filename]));
Add(Format('LANGDRIVER=%s',[lang]));
Add(Format('USER NAME=%s',[user]));
end;
if servertype='STANDART' then
begin
Add(Format('DEFAULT DRIVER=%s',[pdox]));
Add(Format('PATH=%s',[filename]));
end;
end;
if session.isalias(aliasname) then
Session.ModifyAlias(aliasname, List)
else
Session.addAlias(aliasname,servertype, List);
Session.SaveConfigFile;
List.Free;
end;
BDE KOD ADI (ALİAS) PARAMETRELERİNİN ELDE EDİLMESİ
Session.GetAliasParams('DBDEMOS',listbox1.items);
BİR DBASE (.DBF) TABLOSUNDAKİ SİLİNMİŞ KAYITLARIN GÖRÜNTÜLENMESİ
dBase tablolarındaki silinmiş kayıtların görünür hale getirilmesi için DBISetProp fonksiyonu kullanılır.
procedure SetDelete(oTable:TTable; Value: Boolean);
var
rslt: DBIResult;
szErrMsg: DBIMSG;
begin
try
oTable.DisableControls;
try
rslt := DbiSetProp(hDBIObj(oTable.Handle),
curSOFTDELETEON,
LongInt(Value));
if rslt <> DBIERR_NONE then
begin
DbiGetErrorString(rslt, szErrMsg);
raise Exception.Create(StrPas(szErrMsg));
end;
except
on E: EDBEngineError do ShowMessage(E.Message);
on E: Exception do ShowMessage(E.Message);
end;
finally
oTable.Refresh;
oTable.EnableControls;
end;
end;
Şekil 4 : Örnek uygulama form yapısı
kod örneği 7: Form1.dfm
object Form1: TForm1
Left = 200
Top = 108
Width = 559
Height = 293
Caption = 'Form1'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
PixelsPerInch = 96
TextHeight = 13
object DBGrid1: TDBGrid
Left = 8
Top = 8
Width = 409
Height = 177
DataSource = DataSource1
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
object DBNavigator1: TDBNavigator
Left = 8
Top = 200
Width = 240
Height = 25
DataSource = DataSource1
TabOrder = 1
end
object Button1: TButton
Left = 432
Top = 8
Width = 113
Height = 25
Caption = 'Silinenleri göster'
TabOrder = 2
OnClick = Button1Click
end
object Button2: TButton
Left = 432
Top = 40
Width = 113
Height = 25
Caption = 'Silinenleri sakla'
TabOrder = 3
OnClick = Button2Click
end
object Table1: TTable
Active = True
DatabaseName = 'dbdemos'
TableName = 'ANIMALS.DBF'
Left = 440
Top = 80
end
object DataSource1: TDataSource
DataSet = Table1
Left = 488
Top = 80
end
end
kod örneği 8 : unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ExtCtrls, DBCtrls, Grids, DBGrids,
Db, DBTables;
type
TForm1 = class(TForm)
Table1: TTable;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
DbiProcs, DbiTypes, DBConsts;
{$R *.DFM}
procedure SetDelete(oTable:TTable; Value: Boolean);
var
rslt: DBIResult;
szErrMsg: DBIMSG;
begin
try
oTable.DisableControls;
try
rslt := DbiSetProp(hDBIObj(oTable.Handle),
curSOFTDELETEON,
LongInt(Value));
if rslt <> DBIERR_NONE then
begin
DbiGetErrorString(rslt, szErrMsg);
raise Exception.Create(StrPas(szErrMsg));
end;
except
on E: EDBEngineError do ShowMessage(E.Message);
on E: Exception do ShowMessage(E.Message);
end;
finally
oTable.Refresh;
oTable.EnableControls;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetDelete(Table1, TRUE);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
SetDelete(Table1, False);
end;
end.
TTable ve TQuery deki tüm kodlar ve sorgulamalar..
Herkese faydası olacak bilgiler mevcut..
VERİ TABANI
Bu başlık altında, Delphi programlarında veri tabanı ve veri erişiminde kullanılan bileşenler ile ilgili püf noktaları ve gerekli kod örnekleri yer almaktadır.
TTABLE/TQUERY ÜZERİNDE ARTTIRARAK ARAMA
TEdit kullanarak, TTable üzerinde arttırmalı arama yapmak için, Tedid bileşeninin OnChange olay yordamına, aşağıdaki kod yazılır.
procedure TForm1.Edit1Change(Sender: TObject);
begin
With Edit1 do
if Text <> " then
Table1.FindNearest([Text]);
end;
Bu türlü bir arama Tquerry üzerinde yapılacaksa,
procedure TForm1.Edit1Change(Sender: TObject);
begin
With Edit1 do
if Text <> " then begin
Query1.Filter := 'code = "'+Edit1.Text+"";
Query1.FindFirst;
end;
end;
veya
procedure TForm1.Edit1Change(Sender: TObject);
begin
With Edit1 do
if Text <> " then
Query1.Locate('code',Edit1.Text,[loPartialKey]);
end;
Paradox-Tablo yaratılması
Kod içerisinden bir Paradox tablosu şu şekilde yaratılır.
with TTable.create(self) do begin
DatabaseName := 'C:\temp';
TableName := 'FOO';
TableType := ttParadox;
with FieldDefs do Begin
Add('Age', ftInteger, 0, True);
Add('Name', ftString, 25, False);
Add('Weight', ftFloat, 0, False);
End;
IndexDefs.Add('MainIndex','IntField', [ixPrimary,
ixUnique]);
CreateTable;
End;
DBMemo içeriğinin başka bir DBMemo bileşenine aktarılması
DBMemo6.Lines:=DBMemo5.Lines.Assign;
TDBNavigator bileşenin, kod içerisinden kontrol edilmesi
procedure TForm1.DBNavigator1Click(Sender: TObject; Button:
TNavigateBtn);
var
BtnName: string;
begin
case Button of
nbFirst : BtnName := 'nbFirst';
nbPrior : BtnName := 'nbPrior';
nbNext : BtnName := 'nbNext';
nbLast : BtnName := 'nbLast';
nbInsert : BtnName := 'nbInsert';
nbDelete : BtnName := 'nbDelete';
nbEdit : BtnName := 'nbEdit';
nbPost : BtnName := 'nbPost';
nbCancel : BtnName := 'nbCancel';
nbRefresh: BtnName := 'nbRefresh';
end;
MessageDlg(BtnName + ' button clicked.', mtInformation,
[mbOK], 0);
end;
DBMEMO İÇERİSİNDE BİR METNİN ARANMASI
procedure Tform1.FindDialog1Find(Sender: TObject);
var Buff, P, FT : PChar;
BuffLen : Word;
begin
With Sender as TFindDialog do
begin
GetMem(FT, Length(FindText) + 1);
StrPCopy(FT, FindText);
BuffLen:= DBMemo1.GetTextLen + 1;
GetMem(Buff,BuffLen);
DBMemo1.GetTextBuf(Buff,BuffLen);
P:= Buff + DBMemo1.SelStart + DBMemo1.SelLength;
P:= StrPos(P, FT);
if P = NIL then MessageBeep(0)
else
begin
DBMemo1.SelStart:= P - Buff;
DBMemo1.SelLength:= Length(FindText);
end;
FreeMem(FT, Length(FindText) + 1);
FreeMem(Buff,BuffLen);
DBMemo1.SetFocus;
end;
end;
Şekil 1 : Form1
kod örneği 1 : form1.dfm
object Form1: TForm1
Left = 200
Top = 108
Width = 696
Height = 445
Caption = 'Form1'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
PixelsPerInch = 96
TextHeight = 13
object DBMemo1: TDBMemo
Left = 16
Top = 152
Width = 657
Height = 193
DataField = 'Notes'
DataSource = DataSource1
TabOrder = 0
OnDblClick = DBMemo1DblClick
end
object DBGrid1: TDBGrid
Left = 16
Top = 16
Width = 657
Height = 120
DataSource = DataSource1
TabOrder = 1
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
object DBNavigator1: TDBNavigator
Left = 432
Top = 352
Width = 240
Height = 25
TabOrder = 2
end
object DataSource1: TDataSource
DataSet = Table1
Left = 138
Top = 364
end
object Table1: TTable
Active = True
DatabaseName = 'dbdemos'
TableName = 'BIOLIFE.DB'
Left = 220
Top = 366
end
object FindDialog1: TFindDialog
OnFind = FindDialog1Find
Left = 40
Top = 360
end
end
kod örneği 2 : unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs,StdCtrls, Grids, DBGrids, Db, DBTables,
DBCtrls, ExtCtrls;
type
TForm1 = class(TForm)
DBMemo1: TDBMemo;
DataSource1: TDataSource;
Table1: TTable;
DBGrid1: TDBGrid;
FindDialog1: TFindDialog;
DBNavigator1: TDBNavigator;
procedure FindDialog1Find(Sender: TObject);
procedure DBMemo1DblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure Tform1.FindDialog1Find(Sender: TObject);
var Buff, P, FT : PChar;
BuffLen : Word;
begin
With Sender as TFindDialog do
begin
GetMem(FT, Length(FindText) + 1);
StrPCopy(FT, FindText);
BuffLen:= DBMemo1.GetTextLen + 1;
GetMem(Buff,BuffLen);
DBMemo1.GetTextBuf(Buff,BuffLen);
P:= Buff + DBMemo1.SelStart + DBMemo1.SelLength;
P:= StrPos(P, FT);
if P = NIL then MessageBeep(0)
else
begin
DBMemo1.SelStart:= P - Buff;
DBMemo1.SelLength:= Length(FindText);
end;
FreeMem(FT, Length(FindText) + 1);
FreeMem(Buff,BuffLen);
DBMemo1.SetFocus;
end;
end;
procedure TForm1.DBMemo1DblClick(Sender: TObject);
begin
finddialog1.execute;
end;
end.
BİR TABLONUN ALAN BİLGİLERİNİN ELDE EDİLMESİ
Ttable bileşeninden yola çıkarak, bağlı olduğu tablonun alan bilgileri "FieldDefs" özelliği sayesinde elde edilebilir. GetFieldNames davranışı alan isimlerini, GetIndexNames davranışı ise tabloda mevcut olan indeks isimlerini döndürür.
Şekil 2 : form1
kod örneği 3 : form1.dfm
object Form1: TForm1
Left = 200
Top = 108
Width = 425
Height = 340
Caption = 'Form1'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 16
Top = 136
Width = 43
Height = 13
Caption = 'İndeksler'
end
object Label2: TLabel
Left = 16
Top = 0
Width = 32
Height = 13
Caption = 'Alanlar'
end
object Label3: TLabel
Left = 232
Top = 0
Width = 122
Height = 13
Caption = 'Alan isimleri ve uzunlukları'
end
object Memo1: TMemo
Left = 232
Top = 16
Width = 169
Height = 249
Lines.Strings = ( 'Memo1')
TabOrder = 0
end
object Button1: TButton
Left = 240
Top = 272
Width = 153
Height = 25
Caption = 'Alan isimleri ve uzunlukları'
TabOrder = 1
OnClick = Button1Click
end
object Button2: TButton
Left = 16
Top = 272
Width = 201
Height = 25
Caption = 'Alan ve İndeks isimleri '
TabOrder = 2
OnClick = Button2Click
end
object ListBox1: TListBox
Left = 16
Top = 16
Width = 201
Height = 113
ItemHeight = 13
TabOrder = 3
end
object ListBox2: TListBox
Left = 16
Top = 152
Width = 201
Height = 113
ItemHeight = 13
TabOrder = 4
end
object Table1: TTable
DatabaseName = 'dbdemos'
TableName = 'ANIMALS.DBF'
Left = 104
Top = 72
end
kod örneği 4 : unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs,StdCtrls, Db, DBTables;
type
TForm1 = class(TForm)
Memo1: TMemo;
Table1: TTable;
Button1: TButton;
Button2: TButton;
ListBox1: TListBox;
ListBox2: TListBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure ShowFields;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.ShowFields;
var
i : Word;
begin
Memo1.Lines.Clear;
Table1.FieldDefs.Update;
for i := 0 to Table1.FieldDefs.Count - 1 do
With Table1.FieldDefs.Items do
Memo1.Lines.Add(Name + ' - ' + IntToStr(Size));
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
showfields;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
If Table1.State = dsInactive then Table1.Open;
Table1.GetFieldNames(listbox1.items);
Table1.GetIndexNames(listbox2.items);
end;
end.
TDBGRİD BİLEŞENİ ÜZERİNDE, KAYIT SIRALAMA
Eğer bir Interbase tablosu ile çalışılıyor ise, Dbgrid üzerinde seçilen kolon başlığına göre verilerin sıralanması
mümkündür.
procedure TForm1.DBGrid1CellClick(Column: TColumn);
begin
if checkbox1.checked then
with dbgrid1.datasource.dataset as ttable do
indexfieldnames:=column.field.fieldname;
end;
MEVCUT TABLODAKİ KOLONLARIN ELENMESİ
Bir tablodaki alanların "Visible" özelliğine "False" değeri verilerek, istenmeyen alanların görüntülenmesi engellenir.
Table1.FieldByName(<saklanacak alanb adı>).Visible := False;
veya
Table1.Field[<saklanacak alan no>].Visible := false;
BİR TABLODAKİ TMEMOFİELD TİPLİ BİR ALAN İÇERİĞİNİN
TMEMO BİLEŞENİNE AKTARILMASI
Procedure TMemoToTMemoField;
begin
TMemoField.Assign( TMemo.Lines );
end;
Procedure TMemoFieldToTMemo;
VAR aBlobStream : TBlobStream;
Begin
aBlobStream :=
TBlobStream.Create(tblobfield(table1.fieldbyname('Notes')),
bmRead);
Memo1.Lines.LoadFromStream( aBlobStream );
aBlobStream.Free;
end;
BİR PARADOX TABLOSUNA İKİNCİ İNDEKS EKLENMESİ
Table1.AddIndex('<indeks adı>', 'CustNo;CustName',
[ixDescending]);
DBGrid kolonları üzerinde dolaşma
dbgrid1.selectedindex:=dbgrid1.selectedindex+1;
dbgrid1.setfocus;
DETAYI OLAN BİR TABLODAN KAYIT SİLME
Master-Detay ilişki içerisindeki tablolarda, detayı olan bir ana kayıt silindiğinde, detaylar ortada kalır. Ana kayıt olmadığına göre detaylara da ihtiyaç yoktur. Bu nedenle ana kayıt silinmeden önce detayları silmek gerekir.
Table1 ana tabloya, Table2 de Detay tabloya bağlı kabul edilirse, Table1' den bir kayıt silinmek istendiğinde önce Table2' deki detaylar temizlenecektir aşağıdaki örnek bunu göstermektedir.
procedure TForm1.Table1BeforeDelete(DataSet: TDataset)
begin
with Table2 do begin
DisableControls;
First;
While not EOF do
Delete;
EnableControls;
end;
end;
DBGRİD VE MEMO ALANLAR
DBGrid bileşeninde Memo/Blob alanlar <memo> olarak gösterilir. Aşağıdaki örnekte bu tür alanların da metin olarak görüntülenmesi sağlanmaktadır. Table bileşeni üzerine yüklenen kolonlardan NOTES alanı MEMO tipindedir. Bu alanın GetText yordamında Blob2Str fonksiyonu kullanılarak, alandaki veri görünür hale getirilmektedir.
procedure TForm1.Table1NotesGetText(Sender: TField; var Text:
String;
DisplayText: Boolean);
begin
Text := Blob2Str(TMemoField(Sender));
end;
Blob2Str fonksiyonu:
function Blob2Str(TheField : TMemoField): String;
var
Buffer: PChar;
MemSize: Integer;
tmp:string;
begin
if TheField.IsNull then
Result := " else
with TBlobStream.Create(TheField, bmRead) do
begin
MemSize := Size;
Inc(MemSize); Buffer := AllocMem(MemSize);
Read(Buffer^, memsize);
Free;
end;
result:=strpas(buffer);
end;
TABLO İÇERİĞİNİN TSTRİNGRİD BİLEŞENİNE DOLDURULMASI
Tablo içeriğinin TstrinGrid bileşenine doldurulması şu şekilde olur.
table.first;
row := 0;
grid.rowcount := table.recordCount;
while not table.eof do begin
for i := 0 to table.fieldCount-1 do
grid.cells[i,row] := table.fields.asString;
inc (row);
table.next;
end;
TTABLE VEYA TQUERY ÜZERİNDEN KAYIT NUMARASININ BULUNMASI
Dataset Paradox veya dBASE tablosuna bağlı ise kayıt numarasını bulmak, birkaç BDE fonksiyon kullanmak
suretiyle mümkündür. Ancak SQL tabanlı veri tabanı sunumcularında, sunumcunun kendisi buna imkan
vermiyorsa, bu bilgi elde edilemez. Aşağıdaki fonksiyon parametre olarak bir Ttable bileşeni almakta ve gösterdiği Paradox/dBase tablosunudan kayıt numarasını, başarısız olduğunda ise 0 değerini döndürmektedir. Bu fonksiyonun döndürdüğü kayıt numarası, kaydın tablodaki fiziksel yeri ile ilgilidir. İndeks tanımlanmış bir TTable veya "Order by" ile sıraya sokulmuş bir sorgu kümesi döndüren Tquery bileşeninde, hatalı değer döndüğü sanılmamalıdır.
uses
DbiProcs, DbiTypes, DBConsts;
function Form1.Recno( oTable: TTable ): Longint;
var
rError: DBIResult;
rRecProp: RECprops;
szErrMsg: DBIMSG;
begin
Result := 0;
try
oTable.UpdateCursorPos;
rError := DbiGetRecord( oTable.Handle, dbiNOLOCK, nil,
@rRecProp );
if rError = DBIERR_NONE then
Result := rRecProp.iPhyRecNum
else
case rError of
DBIERR_BOF: Result := 1;
DBIERR_EOF: Result := oTable.RecordCount + 1;
else
begin
DbiGetErrorString( rError, szErrMsg );
ShowMessage( StrPas( szErrMsg ));
end;
end;
except
on E: EDBEngineError do ShowMessage( E.Message );
end;
end;
Şekil 3 : Form1
kod örneği 5 : form1.dfm
object Form1: TForm1
Left = 200
Top = 108
Width = 451
Height = 250
Caption = 'Form1'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 112
Top = 16
Width = 32
Height = 13
Caption = 'Label1'
end
object Label2: TLabel
Left = 32
Top = 16
Width = 49
Height = 13
Caption = 'Kayıt No : '
end
object DBGrid1: TDBGrid
Left = 16
Top = 32
Width = 417
Height = 120
DataSource = DataSource1
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
object DBNavigator1: TDBNavigator
Left = 192
Top = 168
Width = 240
Height = 25
DataSource = DataSource1
TabOrder = 1
end
object DataSource1: TDataSource
DataSet = Table1
Left = 88
Top = 168
end
object Table1: TTable
Active = True
AfterScroll = Table1AfterScroll
DatabaseName = 'dbdemos'
TableName = 'ANIMALS.DBF'
Left = 16
Top = 168
end
end
kod örneği 6 : unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs,StdCtrls, ExtCtrls, DBCtrls, Grids, DBGrids,
Db, DBTables;
type
TForm1 = class(TForm)
DataSource1: TDataSource;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
Label1: TLabel;
Label2: TLabel;
Table1: TTable;
function Recno( oTable: Ttable): Longint;
procedure Table1AfterScroll(DataSet: TDataSet);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
DbiProcs, DbiTypes, DBConsts;
{$R *.DFM}
function TForm1.Recno( oTable: Ttable): Longint;
var
rError: DBIResult;
rRecProp: RECprops;
szErrMsg: DBIMSG;
begin
Result := 0;
try
oTable.UpdateCursorPos;
rError := DbiGetRecord( oTable.Handle, dbiNOLOCK, nil,
@rRecProp );
if rError = DBIERR_NONE then
Result := rRecProp.iPhyRecNum
else
case rError of
DBIERR_BOF: Result := 1;
DBIERR_EOF: Result := oTable.RecordCount + 1;
else
begin
DbiGetErrorString( rError, szErrMsg );
ShowMessage( StrPas( szErrMsg ));
end;
end;
except
on E: EDBEngineError do ShowMessage( E.Message );
end;
end;
procedure TForm1.Table1AfterScroll(DataSet: TDataSet);
begin
label1.caption:=inttostr(recno(table1));
end;
end.
DBASE TABLOLARINDAN SİLİNMİŞ KAYITLARIN ATILMASI
Bu işlem için DBIPackTable. İsimli BDE fonksiyonu kullanılır. Örnek kod şu şekildedir.
uses
DbiProcs, DbiTypes, DBConsts;
procedure TForm1.Button1Click(Sender: TObject);
var
Error: DbiResult;
ErrorMsg: String;
Special: DBIMSG;
begin
table1.Active := False;
try
Table1.Exclusive := True;
Table1.Active := True;
Error := DbiPackTable(Table1.DBHandle, Table1.Handle,
nil, szdBASE, True);
Table1.Active := False;
Table1.Exclusive := False;
finally
Table1.Active := True;
end;
case Error of
DBIERR_NONE:
ErrorMsg := 'Tamam';
DBIERR_INVALIDPARAM:
ErrorMsg := 'Tablo belirsiz' +
'name is NULL';
DBIERR_INVALIDHNDL:
ErrorMsg := 'Veri tabanı belirsiz';
DBIERR_NOSUCHTABLE:
ErrorMsg := 'Tablo adı belirsiz';
DBIERR_UNKNOWNTBLTYPE:
ErrorMsg := 'Tablo tipi belirsiz';
DBIERR_NEEDEXCLACCESS:
ErrorMsg := 'Tablo exclusive modda değil';
else
DbiGetErrorString(Error, Special);
ErrorMsg := '[' + IntToStr(Error) + ']: ' + Special;
end;
MessageDlg(ErrorMsg, mtWarning, [mbOk], 0);
end;
UYGULAMA İÇERİSİNDEN BDE KOD ADI (ALİAS) YARATILMASI
procedure createalias(aliasname, servername, servertype,
filename:string);
var
List: TStringList;
lang,
user,
pdox : string;
begin
lang:='ANTURK';
user:='SYSDBA';
pdox:='PARADOX';
List := TStringList.Create;
with List do
begin
Clear;
if servertype='INTRBASE' then
begin
Add(Format('SERVER NAME=%s',[filename]));
Add(Format('LANGDRIVER=%s',[lang]));
Add(Format('USER NAME=%s',[user]));
end;
if servertype='STANDART' then
begin
Add(Format('DEFAULT DRIVER=%s',[pdox]));
Add(Format('PATH=%s',[filename]));
end;
end;
if session.isalias(aliasname) then
Session.ModifyAlias(aliasname, List)
else
Session.addAlias(aliasname,servertype, List);
Session.SaveConfigFile;
List.Free;
end;
BDE KOD ADI (ALİAS) PARAMETRELERİNİN ELDE EDİLMESİ
Session.GetAliasParams('DBDEMOS',listbox1.items);
BİR DBASE (.DBF) TABLOSUNDAKİ SİLİNMİŞ KAYITLARIN GÖRÜNTÜLENMESİ
dBase tablolarındaki silinmiş kayıtların görünür hale getirilmesi için DBISetProp fonksiyonu kullanılır.
procedure SetDelete(oTable:TTable; Value: Boolean);
var
rslt: DBIResult;
szErrMsg: DBIMSG;
begin
try
oTable.DisableControls;
try
rslt := DbiSetProp(hDBIObj(oTable.Handle),
curSOFTDELETEON,
LongInt(Value));
if rslt <> DBIERR_NONE then
begin
DbiGetErrorString(rslt, szErrMsg);
raise Exception.Create(StrPas(szErrMsg));
end;
except
on E: EDBEngineError do ShowMessage(E.Message);
on E: Exception do ShowMessage(E.Message);
end;
finally
oTable.Refresh;
oTable.EnableControls;
end;
end;
Şekil 4 : Örnek uygulama form yapısı
kod örneği 7: Form1.dfm
object Form1: TForm1
Left = 200
Top = 108
Width = 559
Height = 293
Caption = 'Form1'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
PixelsPerInch = 96
TextHeight = 13
object DBGrid1: TDBGrid
Left = 8
Top = 8
Width = 409
Height = 177
DataSource = DataSource1
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
object DBNavigator1: TDBNavigator
Left = 8
Top = 200
Width = 240
Height = 25
DataSource = DataSource1
TabOrder = 1
end
object Button1: TButton
Left = 432
Top = 8
Width = 113
Height = 25
Caption = 'Silinenleri göster'
TabOrder = 2
OnClick = Button1Click
end
object Button2: TButton
Left = 432
Top = 40
Width = 113
Height = 25
Caption = 'Silinenleri sakla'
TabOrder = 3
OnClick = Button2Click
end
object Table1: TTable
Active = True
DatabaseName = 'dbdemos'
TableName = 'ANIMALS.DBF'
Left = 440
Top = 80
end
object DataSource1: TDataSource
DataSet = Table1
Left = 488
Top = 80
end
end
kod örneği 8 : unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ExtCtrls, DBCtrls, Grids, DBGrids,
Db, DBTables;
type
TForm1 = class(TForm)
Table1: TTable;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
DbiProcs, DbiTypes, DBConsts;
{$R *.DFM}
procedure SetDelete(oTable:TTable; Value: Boolean);
var
rslt: DBIResult;
szErrMsg: DBIMSG;
begin
try
oTable.DisableControls;
try
rslt := DbiSetProp(hDBIObj(oTable.Handle),
curSOFTDELETEON,
LongInt(Value));
if rslt <> DBIERR_NONE then
begin
DbiGetErrorString(rslt, szErrMsg);
raise Exception.Create(StrPas(szErrMsg));
end;
except
on E: EDBEngineError do ShowMessage(E.Message);
on E: Exception do ShowMessage(E.Message);
end;
finally
oTable.Refresh;
oTable.EnableControls;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetDelete(Table1, TRUE);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
SetDelete(Table1, False);
end;
end.
BİR TABLODAKİ ALAN SAYISININ BULUNMASI
Ttable bileşenini kullanarak, bir tablodaki alan sayısının bulunması için TableX.fieldcount Özelliğinden faydalanılabilir. Ancak tablo alanlarının bir kısmı, ttable bileşeni üzerine yüklenmişse fieldcount özelliği
sadece yüklenen alan sayısını getirir. Alanları ttable üzerine kısmen yüklenmiş olan bir tablonun, gerçek alan sayısının bulunabilmesi için, aşağıdaki fonksiyon kullanılabilir. Bu kodun kullanılabilmesi için, form üzerine yerleştirileni ttable bileşenine, bağlandığı tablo alanlarının bir kısmı yüklenmelidir.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs,
StdCtrls, Db, DBTables,
DbiErrs, DbiTypes, DbiProcs ,bde;
type
TForm1 = class(TForm)
{
Alanlar yüklendiğinde, tanımları buraya yerleşecektir.
}
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function GetFieldCount(T: TTable): Integer;
var
curProp: CURProps;
bWasOpen: Boolean;
begin
Result := 0; {Just in case something goes wrong.}
bWasOpen := T.Active;
try
if not bWasOpen then
T.Open;
Check(DbiGetCursorProps(T.Handle, curProp));
Result := curProp.iFields;
finally
if not bWasOpen then
T.Close;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
showmessage(inttostr(table1.fieldcount));
showmessage(inttostr(GetFieldCount(table1)));
end;
end.
BİR TABLODAKİ VERİNİN, BAŞKA BİR TABLOYA EKLENMESİ
Aynı yapıdaki iki ayrı tablo muhteviyatının, birleştirilmesi için kullanılabilecek olan bu fonksiyon, <SourceTable> isimli tablodaki verileri, <DestinationTable> isimli tabloya kopyalamaktadır. Bu yöntemle veriler, farklı veri tabanları arasında da taşınabilir.
Function AddTables(
const
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestinationTable: string): Boolean;
Var
BMode : TBatchMode;
Begin
If IsTableKeyed(DestDatabaseName,DestinationTable) Then
Begin
If IsTableKeyed(SourceDatabaseName,SourceTable) Then
Begin
BMode := BatAppendUpdate;
End
Else
Begin
BMode := BatAppend;
End;
End
Else
Begin
BMode := BatAppend;
End;
Result := DBRecordMove(SourceDatabaseName,SourceTable,
DestDatabaseName,DestinationTable,BMode);
End;
SORGUDAN TABLO YARATILMASI
Karmaşık sorgular sonucunda toplanan veriler, bu fonksiyon yardımıyla yaratılan bir tablo içerisine doldurulabilir.
Function DBCreateTableFromQuery(
Query: TQuery;
NewTableName,
TableDatabaseName: String): Boolean;
var
D : TTable;
ActiveWas : Boolean;
begin
D := nil;
try
{The Source Table}
ActiveWas := Query.Active;
Query.Active := true;
D := TTable.Create(nil);
D.Active := False;
D.DatabaseName := TableDatabaseName;
D.TableName := NewTableName;
D.ReadOnly := False;
D.BatchMove(Query,batCopy);
Query.Active := ActiveWas;
Result := True;
finally
D.Free;
end;
End;
SORGUDAN TABLOYA VERİ AKTARIMI
Bir sorgu neticesinde elde edilen veriler, bu fonksiyon kullanılarak, mevcut bir tabloya aktarılabilir.
Procedure DBAddQueryToTable(
DataSet : TQuery;
const
DestDatabaseName,
DestinationTable: string);
var
DTable : TTable;
BMove : TBatchMove;
begin
DTable := TTable.Create(nil);
BMove := TBatchMove.Create(nil);
Try
DataSet.Active := True;
DTable.DatabaseName := DestDatabaseName;
DTable.TableName := DestinationTable;
DTable.Active := True;
BMove.AbortOnKeyViol := False;
BMove.AbortOnProblem := False;
BMove.ChangedTableName := 'CTable';
BMove.Destination := DTable;
BMove.KeyViolTableName := 'KTable';
BMove.Mode := batAppend;
BMove.ProblemTableName := 'PTable';
BMove.Source := DataSet;
BMove.Execute;
Finally
DTable.Active := False;
DTable.Free;
BMove.Free;
End;
End;
TABLODAKİ BİR ALANA AİT VERİLERİN, BAŞKA BİR ALANA KOPYALANMASI
Bir tabloda bulunan alanlardan bir içerisinde bulunan veriler, başka bir alana kopyalanacağı zaman, aşağıdaki fonksiyon kullanılabilir.
function DBCopyFieldAToB(
DatabaseName,
TableName,
SourceField,
DestField: String): Boolean;
var
Query : TQuery;
CursorWas : TCursor;
Sess : TSession;
begin
CursorWas := Screen.Cursor;
Sess := DBSessionCreateNew;
Sess.Active := True;
Query := TQuery.Create(sess);
Query.SessionName := Sess.SessionName;
Sess.Active := True;
Query.Active := False;
Query.RequestLive := True;
try
Result := False;
Query.DatabaseName := DatabaseName;
Query.SQL.Clear;
Query.SQL.Add('Select ');
Query.SQL.Add(SourceField+',');
Query.SQL.Add(DestField);
Query.SQL.Add('From '+TableName);
Query.Open;
Query.First;
While Not Query.EOF Do
Begin
ProgressScreenCursor;
Try
Query.Edit;
Query.FieldByName(DestField).AsString :=
Query.FieldByName(SourceField).AsString;
Query.Post;
Except
End;
Query.Next;
End;
Result := True;
finally
Query.Free;
Screen.Cursor := CursorWas;
Sess.Active := False;
end;
end;
TABLO KOPYALAMA
Bir tablo olduğu gibi , başka bir veri tabanına veya aynı veri tabanına kopyalanabilir. <DestTable> isimli bir tablo mevcutsa, eskisi silinir. Bu fonksiyon oldukça güçlü bir veri taşıma aracıdır. Tablolar, BDE tarafından desteklenen, herhangi bir veri tabanı ortamından, başka bir veri tabanı ortamına kopyalanabilir. Aşağıdaki örnekte, "DBDemos" veri tabanındaki "Customer.db" isimli tablo, "Sybase" veri tabanına kopyalanmaktadır.,
Tablo yapısı, <SourceTable> tablosundan alınmak suretiyle, karşı tarafta yeni bir tablo yaratılmaktadır. Tarafların, lokalde veya uzakta olmaları fark etmez. Eğer karşı tarafta aynı adı taşıyan bir tablo varsa, silinir ve yerine yenisi yaratılır.
Function DBCreateTableBorrowStr(
SourceDatabaseName : String;
SourceTableName : String;
DestDatabaseName : String;
DestTableName : String): Boolean;
Var
S : TTable;
D : TTable;
i,j : Integer;
IMax : Integer;
IndexName : String;
IndexFields : String;
IndexFields2 : String;
Q : TQuery;
IDXO : TIndexOptions;
Begin
S := TTable.Create(nil);
D := TTable.Create(nil);
Try
Try
S.Active := False;
S.DatabaseName := SourceDatabaseName;
S.TableName := SourceTableName;
S.TableType := ttDefault;
S.Active := True;
D.DatabaseName := DestDatabaseName;
D.TableName := DestTableName;
D.TableType := ttDefault;
D.FieldDefs.Assign(S.FieldDefs);
D.CreateTable;
{Similar method could be used to create the indices}
{D.IndexDefs.Assign(S.IndexDefs);}
S.IndexDefs.Update;
D.IndexDefs.Update;
D.IndexDefs.Clear;
D.IndexDefs.Update;
For i := 0 To S.IndexDefs.Count - 1 Do
Begin
If Pos('.DB',UpperCase(DestTableName)) > 0 Then
Begin
{Paradox or DBase Tables}
If S.IndexDefs.Items.Name = " Then
Begin
If Pos('.DB',UpperCase(DestTableName)) = 0 Then
Begin
IndexName := DestTableName+IntToStr(i);
End
Else
Begin
IndexName := ";
End;
End
Else
Begin
IndexName := DestTableName+IntToStr(i);
End;
IndexFields := S.IndexDefs.Items.Fields;
D.AddIndex(IndexName,IndexFields,
S.IndexDefs.Items.Options);
D.IndexDefs.Update;
End
Else
Begin
{Non Local Tables}
Q := TQuery.Create(nil);
Try
S.IndexDefs.Update;
D.IndexDefs.Update;
D.IndexDefs.Clear;
D.IndexDefs.Update;
IMax := S.IndexDefs.Count - 1;
For j := 0 To IMax Do
Begin
Q. Active := False;
Q.DatabaseName := DestDatabaseName;
IndexName := DestTableName+IntToStr(i);
IndexFields := S.IndexDefs.Items.Fields;
IndexFields2 :=
ReplaceCharInString(IndexFields,';',',');
Q.SQL.Clear;
Q.SQL.Add('Create');
If ixUnique in S. IndexDefs.Items[j].Options
Then Begin
Q.SQL.Add('Unique');
End;
If ixDescending in S.IndexDefs.Items[j].Options
Then Begin
Q.SQL.Add('Desc');
End
Else
Begin
Q.SQL.Add('Asc');
End;
Q.SQL.Add('Index');
Q.SQL.Add(IndexName);
Q.SQL.Add('On');
Q.SQL.Add(DestTableName);
Q.SQL.Add('(');
Q.SQL.Add(IndexFields2);
Q.SQL.Add(')');
Try
Q.ExecSql;
D.IndexDefs.Update;
D.AddIndex(IndexName,IndexFields,
S.IndexDefs.Items[j].Options);
D.IndexDefs.Update;
Except
On E : EDBEngineError Do
Begin
If E.Message = 'Invalid array of index
descriptors.'
Then Begin
Try
D.IndexDefs.Update;
D.DeleteIndex(IndexName);
D.IndexDefs.Update;
Except
End;
End
Else
Begin
Try
D.IndexDefs.Update;
IDXO := D.IndexDefs.Items[j].Options;
Except
End;
End;
End;
End;
End;
//i:= IMax;
Finally
Q.Free;
End;
End;
End;
S.Active := False;
Result := True;
Finally
S.Free;
D.Free;
End;
Except
On E : Exception Do
Begin
ShowMessage('DBCreateTableBorrowStr Error:
'+E.Message);
Result := False;
End;
End;
End;
TABLO SİLME
Herhangi bir veri tabanından tablo silmek gerektiğinde, aşağıdaki fonksiyon kullanılabilir.
Function DBDropTable(const DatabaseName, TableName :
string):Boolean;
var Query : TQuery;
begin
Result := False;
If Not IsTable(DatabaseName, TableName) Then
Begin
Exit;
End;
Query := TQuery.Create(nil);
try
Query.DatabaseName := DatabaseName;
Query.SQL.Clear;
Query.SQL.Add('Drop Table ');
If (Pos('.DB', UpperCase(TableName)) > 0) Or
(Pos('.DBF',UpperCase(TableName)) > 0) Then
Begin
Query.Sql.Add('"'+TableName+'"');
End
Else
Begin
Query.Sql.Add(TableName);
End;
Result := True;
Try
Query.ExecSQL;
Except
Result := False;
End;
finally
Query.Free;
end;
end;
ALAN ADININ BULUNMASI
Sıra numarası verilen bir tablo alanının alan adı bu fonksiyonla alınabilir.
Function DBFieldNameByNo(
DatabaseName : String;
TableName : String;
FieldNo : Integer): String;
Var
Table : TTable;
Begin
Result := ";
If Not IsTable(DatabaseName, TableName) Then Exit;
If FieldNo < 0 Then Exit;
If FieldNo >= DBNFields(DatabaseName, TableName) Then Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active := False;
Table.DatabaseName := DatabaseName;
Table.TableName := TableName;
Table.Active := True;
Result := Table.FieldDefs[FieldNo].Name;
Except
End;
Finally
Table.Free;
End;
End;
ORTAK ALAN İSİMLERİ
Bu fonksiyonda, her iki tabloda da mevcut olan alan isimleri, aralarına konan virgüllerle ayrılmış olarak dönerler.
Function DBFieldNamesCommonToString(
DatabaseName1 : String;
TableName1 : String;
DatabaseName2 : String;
TableName2 : String): String;
Var
List1 : TStringList;
List2 : TStringList;
i : Integer;
Suffix: String;
Begin
Result := ";
List1 := TStringList.Create();
List2 := TStringList.Create();
Try
DBFieldNamesToTStrings(
DatabaseName1,
TableName1,
List1);
For i := 0 To List1.Count - 1 Do
Begin
List1 := UpperCase(List1);
End;
DBFieldNamesToTStrings(
DatabaseName2,
TableName2,
List2);
For i := 0 To List2.Count - 1 Do
Begin
List2 := UpperCase(List2);
End;
For i := 0 To List1.Count - 1 Do
Begin
If Result = " Then
Begin
Suffix := ";
End
Else
Begin
Suffix := ', ';
End;
If List2.IndexOf(List1) <> -1 Then
Begin
Result := Result + Suffix + List1;
End;
End;
Finally
List1.Free;
List2.Free;
End;
End;
TABLODAKİ ALAN İSİMLERİ
Bu fonksiyon, tablodaki alanlara ait isimleri, bir Tstrings nesnesi içerisine doldurur.
Function DBFieldNamesToTStrings(
DatabaseName : String;
TableName : String;
Strings : TStrings): Boolean;
Var
Table : TTable;
FieldNo : Integer;
Begin
Result := False;
If Not IsTable(DatabaseName, TableName) Then Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active := False;
Table.DatabaseName := DatabaseName;
Table.TableName := TableName;
Table.Active := True;
Strings.Clear;
For FieldNo := 0 To Table.FieldDefs.Count -1 Do
Begin
Strings.Add(Table.FieldDefs[FieldNo].Name);
End;
Result := True;
Except
End;
Finally
Table.Free;
End;
End;
ALAN NUMARASI
Bu fonksiyon, adı bilinen bir alanın, tablo içerisindeki sırasını bulur.
Function DBFieldNo(DatabaseName, TableName, FieldName:
String): Integer;
Var
Table : TTable;
FieldIndex : Integer;
FieldNumber: Integer;
Begin
Result := -1;
If Not IsTable(DatabaseName, TableName) Then Exit;
If Not IsField(DatabaseName, TableName, FieldName) Then
Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active := False;
Table.DatabaseName := DatabaseName;
Table.TableName := TableName;
Table.Active := True;
FieldIndex :=
Table.FieldDefs.IndexOf(FieldName);
FieldNumber :=
Table.FieldDefs[FieldIndex].FieldNo;
Result := FieldNumber;
Except
End;
Finally
Table.Free;
End;
End;
ALAN UZUNLUĞU
Tablo içerisindeki bir alanın, uzunluğu, bu fonksiyon ile bulunur.
Function DBFieldSize(DatabaseName, TableName, FieldName:
String): Integer;
Var
Table : TTable;
FieldIndex : Integer;
FieldSize : Integer;
Begin
Result := 0;
If Not IsTable(DatabaseName, TableName) Then Exit;
If Not IsField(DatabaseName, TableName, FieldName) Then
Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active := False;
Table.DatabaseName := DatabaseName;
Table.TableName := TableName;
Table.Active := True;
FieldIndex :=
Table.FieldDefs.IndexOf(FieldName);
FieldSize :=
Table.FieldDefs[FieldIndex].Size;
Result := FieldSize;
Except
End;
Finally
Table.Free;
End;
End;
ALAN TİPLERİ
Adı bilinen bir alanın tipini bulmak için aşağıdaki fonksiyon kullanılabilir.
Function TypeField(DatabaseName, TableName, FieldName:
String): String;
Var
Table : TTable;
FieldIndex : Integer;
FieldType : TFieldType;
Begin
Result := ";
If Not IsTable(DatabaseName, TableName) Then Exit;
If Not IsField(DatabaseName, TableName, FieldName) Then
Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active := False;
Table.DatabaseName := DatabaseName;
Table.TableName := TableName;
Table.Active := True;
FieldIndex :=
Table.FieldDefs.IndexOf(FieldName);
FieldType :=
Table.FieldDefs[FieldIndex].DataType;
If FieldType=ftUnknown Then Result := 'Unknown';
If FieldType=ftString Then Result := 'String';
If FieldType=ftSmallInt Then Result := 'SmallInt';
If FieldType=ftInteger Then Result := 'Integer';
If FieldType=ftWord Then Result := 'Word';
If FieldType=ftBoolean Then Result := 'Boolean';
If FieldType=ftFloat Then Result := 'Float';
If FieldType=ftCurrency Then Result := 'Currency';
If FieldType=ftBCD Then Result := 'BCD';
If FieldType=ftDate Then Result := 'Date';
If FieldType=ftTime Then Result := 'Time';
If FieldType=ftDateTime Then Result := 'DateTime';
If FieldType=ftBytes Then Result := 'Bytes';
If FieldType=ftVarBytes Then Result := 'VarBytes';
If FieldType=ftBlob Then Result := 'Blob';
If FieldType=ftMemo Then Result := 'Memo';
If FieldType=ftGraphic Then Result := 'Graphic';
{$IFDEF WIN32}
If FieldType=ftAutoInc Then Result := 'AutoInc';
If FieldType=ftFmtMemo Then Result := 'FmtMemo';
If FieldType=ftParadoxOle Then Result :=
'ParadoxOle';
If FieldType=ftDBaseOle Then Result := 'DBaseOle';
If FieldType=ftTypedBinary Then Result :=
'TypedBinary';
{$ENDIF}
Except
End;
Finally
Table.Free;
End;
End;
Ttable bileşenini kullanarak, bir tablodaki alan sayısının bulunması için TableX.fieldcount Özelliğinden faydalanılabilir. Ancak tablo alanlarının bir kısmı, ttable bileşeni üzerine yüklenmişse fieldcount özelliği
sadece yüklenen alan sayısını getirir. Alanları ttable üzerine kısmen yüklenmiş olan bir tablonun, gerçek alan sayısının bulunabilmesi için, aşağıdaki fonksiyon kullanılabilir. Bu kodun kullanılabilmesi için, form üzerine yerleştirileni ttable bileşenine, bağlandığı tablo alanlarının bir kısmı yüklenmelidir.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs,
StdCtrls, Db, DBTables,
DbiErrs, DbiTypes, DbiProcs ,bde;
type
TForm1 = class(TForm)
{
Alanlar yüklendiğinde, tanımları buraya yerleşecektir.
}
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function GetFieldCount(T: TTable): Integer;
var
curProp: CURProps;
bWasOpen: Boolean;
begin
Result := 0; {Just in case something goes wrong.}
bWasOpen := T.Active;
try
if not bWasOpen then
T.Open;
Check(DbiGetCursorProps(T.Handle, curProp));
Result := curProp.iFields;
finally
if not bWasOpen then
T.Close;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
showmessage(inttostr(table1.fieldcount));
showmessage(inttostr(GetFieldCount(table1)));
end;
end.
BİR TABLODAKİ VERİNİN, BAŞKA BİR TABLOYA EKLENMESİ
Aynı yapıdaki iki ayrı tablo muhteviyatının, birleştirilmesi için kullanılabilecek olan bu fonksiyon, <SourceTable> isimli tablodaki verileri, <DestinationTable> isimli tabloya kopyalamaktadır. Bu yöntemle veriler, farklı veri tabanları arasında da taşınabilir.
Function AddTables(
const
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestinationTable: string): Boolean;
Var
BMode : TBatchMode;
Begin
If IsTableKeyed(DestDatabaseName,DestinationTable) Then
Begin
If IsTableKeyed(SourceDatabaseName,SourceTable) Then
Begin
BMode := BatAppendUpdate;
End
Else
Begin
BMode := BatAppend;
End;
End
Else
Begin
BMode := BatAppend;
End;
Result := DBRecordMove(SourceDatabaseName,SourceTable,
DestDatabaseName,DestinationTable,BMode);
End;
SORGUDAN TABLO YARATILMASI
Karmaşık sorgular sonucunda toplanan veriler, bu fonksiyon yardımıyla yaratılan bir tablo içerisine doldurulabilir.
Function DBCreateTableFromQuery(
Query: TQuery;
NewTableName,
TableDatabaseName: String): Boolean;
var
D : TTable;
ActiveWas : Boolean;
begin
D := nil;
try
{The Source Table}
ActiveWas := Query.Active;
Query.Active := true;
D := TTable.Create(nil);
D.Active := False;
D.DatabaseName := TableDatabaseName;
D.TableName := NewTableName;
D.ReadOnly := False;
D.BatchMove(Query,batCopy);
Query.Active := ActiveWas;
Result := True;
finally
D.Free;
end;
End;
SORGUDAN TABLOYA VERİ AKTARIMI
Bir sorgu neticesinde elde edilen veriler, bu fonksiyon kullanılarak, mevcut bir tabloya aktarılabilir.
Procedure DBAddQueryToTable(
DataSet : TQuery;
const
DestDatabaseName,
DestinationTable: string);
var
DTable : TTable;
BMove : TBatchMove;
begin
DTable := TTable.Create(nil);
BMove := TBatchMove.Create(nil);
Try
DataSet.Active := True;
DTable.DatabaseName := DestDatabaseName;
DTable.TableName := DestinationTable;
DTable.Active := True;
BMove.AbortOnKeyViol := False;
BMove.AbortOnProblem := False;
BMove.ChangedTableName := 'CTable';
BMove.Destination := DTable;
BMove.KeyViolTableName := 'KTable';
BMove.Mode := batAppend;
BMove.ProblemTableName := 'PTable';
BMove.Source := DataSet;
BMove.Execute;
Finally
DTable.Active := False;
DTable.Free;
BMove.Free;
End;
End;
TABLODAKİ BİR ALANA AİT VERİLERİN, BAŞKA BİR ALANA KOPYALANMASI
Bir tabloda bulunan alanlardan bir içerisinde bulunan veriler, başka bir alana kopyalanacağı zaman, aşağıdaki fonksiyon kullanılabilir.
function DBCopyFieldAToB(
DatabaseName,
TableName,
SourceField,
DestField: String): Boolean;
var
Query : TQuery;
CursorWas : TCursor;
Sess : TSession;
begin
CursorWas := Screen.Cursor;
Sess := DBSessionCreateNew;
Sess.Active := True;
Query := TQuery.Create(sess);
Query.SessionName := Sess.SessionName;
Sess.Active := True;
Query.Active := False;
Query.RequestLive := True;
try
Result := False;
Query.DatabaseName := DatabaseName;
Query.SQL.Clear;
Query.SQL.Add('Select ');
Query.SQL.Add(SourceField+',');
Query.SQL.Add(DestField);
Query.SQL.Add('From '+TableName);
Query.Open;
Query.First;
While Not Query.EOF Do
Begin
ProgressScreenCursor;
Try
Query.Edit;
Query.FieldByName(DestField).AsString :=
Query.FieldByName(SourceField).AsString;
Query.Post;
Except
End;
Query.Next;
End;
Result := True;
finally
Query.Free;
Screen.Cursor := CursorWas;
Sess.Active := False;
end;
end;
TABLO KOPYALAMA
Bir tablo olduğu gibi , başka bir veri tabanına veya aynı veri tabanına kopyalanabilir. <DestTable> isimli bir tablo mevcutsa, eskisi silinir. Bu fonksiyon oldukça güçlü bir veri taşıma aracıdır. Tablolar, BDE tarafından desteklenen, herhangi bir veri tabanı ortamından, başka bir veri tabanı ortamına kopyalanabilir. Aşağıdaki örnekte, "DBDemos" veri tabanındaki "Customer.db" isimli tablo, "Sybase" veri tabanına kopyalanmaktadır.,
Tablo yapısı, <SourceTable> tablosundan alınmak suretiyle, karşı tarafta yeni bir tablo yaratılmaktadır. Tarafların, lokalde veya uzakta olmaları fark etmez. Eğer karşı tarafta aynı adı taşıyan bir tablo varsa, silinir ve yerine yenisi yaratılır.
Function DBCreateTableBorrowStr(
SourceDatabaseName : String;
SourceTableName : String;
DestDatabaseName : String;
DestTableName : String): Boolean;
Var
S : TTable;
D : TTable;
i,j : Integer;
IMax : Integer;
IndexName : String;
IndexFields : String;
IndexFields2 : String;
Q : TQuery;
IDXO : TIndexOptions;
Begin
S := TTable.Create(nil);
D := TTable.Create(nil);
Try
Try
S.Active := False;
S.DatabaseName := SourceDatabaseName;
S.TableName := SourceTableName;
S.TableType := ttDefault;
S.Active := True;
D.DatabaseName := DestDatabaseName;
D.TableName := DestTableName;
D.TableType := ttDefault;
D.FieldDefs.Assign(S.FieldDefs);
D.CreateTable;
{Similar method could be used to create the indices}
{D.IndexDefs.Assign(S.IndexDefs);}
S.IndexDefs.Update;
D.IndexDefs.Update;
D.IndexDefs.Clear;
D.IndexDefs.Update;
For i := 0 To S.IndexDefs.Count - 1 Do
Begin
If Pos('.DB',UpperCase(DestTableName)) > 0 Then
Begin
{Paradox or DBase Tables}
If S.IndexDefs.Items.Name = " Then
Begin
If Pos('.DB',UpperCase(DestTableName)) = 0 Then
Begin
IndexName := DestTableName+IntToStr(i);
End
Else
Begin
IndexName := ";
End;
End
Else
Begin
IndexName := DestTableName+IntToStr(i);
End;
IndexFields := S.IndexDefs.Items.Fields;
D.AddIndex(IndexName,IndexFields,
S.IndexDefs.Items.Options);
D.IndexDefs.Update;
End
Else
Begin
{Non Local Tables}
Q := TQuery.Create(nil);
Try
S.IndexDefs.Update;
D.IndexDefs.Update;
D.IndexDefs.Clear;
D.IndexDefs.Update;
IMax := S.IndexDefs.Count - 1;
For j := 0 To IMax Do
Begin
Q. Active := False;
Q.DatabaseName := DestDatabaseName;
IndexName := DestTableName+IntToStr(i);
IndexFields := S.IndexDefs.Items.Fields;
IndexFields2 :=
ReplaceCharInString(IndexFields,';',',');
Q.SQL.Clear;
Q.SQL.Add('Create');
If ixUnique in S. IndexDefs.Items[j].Options
Then Begin
Q.SQL.Add('Unique');
End;
If ixDescending in S.IndexDefs.Items[j].Options
Then Begin
Q.SQL.Add('Desc');
End
Else
Begin
Q.SQL.Add('Asc');
End;
Q.SQL.Add('Index');
Q.SQL.Add(IndexName);
Q.SQL.Add('On');
Q.SQL.Add(DestTableName);
Q.SQL.Add('(');
Q.SQL.Add(IndexFields2);
Q.SQL.Add(')');
Try
Q.ExecSql;
D.IndexDefs.Update;
D.AddIndex(IndexName,IndexFields,
S.IndexDefs.Items[j].Options);
D.IndexDefs.Update;
Except
On E : EDBEngineError Do
Begin
If E.Message = 'Invalid array of index
descriptors.'
Then Begin
Try
D.IndexDefs.Update;
D.DeleteIndex(IndexName);
D.IndexDefs.Update;
Except
End;
End
Else
Begin
Try
D.IndexDefs.Update;
IDXO := D.IndexDefs.Items[j].Options;
Except
End;
End;
End;
End;
End;
//i:= IMax;
Finally
Q.Free;
End;
End;
End;
S.Active := False;
Result := True;
Finally
S.Free;
D.Free;
End;
Except
On E : Exception Do
Begin
ShowMessage('DBCreateTableBorrowStr Error:
'+E.Message);
Result := False;
End;
End;
End;
TABLO SİLME
Herhangi bir veri tabanından tablo silmek gerektiğinde, aşağıdaki fonksiyon kullanılabilir.
Function DBDropTable(const DatabaseName, TableName :
string):Boolean;
var Query : TQuery;
begin
Result := False;
If Not IsTable(DatabaseName, TableName) Then
Begin
Exit;
End;
Query := TQuery.Create(nil);
try
Query.DatabaseName := DatabaseName;
Query.SQL.Clear;
Query.SQL.Add('Drop Table ');
If (Pos('.DB', UpperCase(TableName)) > 0) Or
(Pos('.DBF',UpperCase(TableName)) > 0) Then
Begin
Query.Sql.Add('"'+TableName+'"');
End
Else
Begin
Query.Sql.Add(TableName);
End;
Result := True;
Try
Query.ExecSQL;
Except
Result := False;
End;
finally
Query.Free;
end;
end;
ALAN ADININ BULUNMASI
Sıra numarası verilen bir tablo alanının alan adı bu fonksiyonla alınabilir.
Function DBFieldNameByNo(
DatabaseName : String;
TableName : String;
FieldNo : Integer): String;
Var
Table : TTable;
Begin
Result := ";
If Not IsTable(DatabaseName, TableName) Then Exit;
If FieldNo < 0 Then Exit;
If FieldNo >= DBNFields(DatabaseName, TableName) Then Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active := False;
Table.DatabaseName := DatabaseName;
Table.TableName := TableName;
Table.Active := True;
Result := Table.FieldDefs[FieldNo].Name;
Except
End;
Finally
Table.Free;
End;
End;
ORTAK ALAN İSİMLERİ
Bu fonksiyonda, her iki tabloda da mevcut olan alan isimleri, aralarına konan virgüllerle ayrılmış olarak dönerler.
Function DBFieldNamesCommonToString(
DatabaseName1 : String;
TableName1 : String;
DatabaseName2 : String;
TableName2 : String): String;
Var
List1 : TStringList;
List2 : TStringList;
i : Integer;
Suffix: String;
Begin
Result := ";
List1 := TStringList.Create();
List2 := TStringList.Create();
Try
DBFieldNamesToTStrings(
DatabaseName1,
TableName1,
List1);
For i := 0 To List1.Count - 1 Do
Begin
List1 := UpperCase(List1);
End;
DBFieldNamesToTStrings(
DatabaseName2,
TableName2,
List2);
For i := 0 To List2.Count - 1 Do
Begin
List2 := UpperCase(List2);
End;
For i := 0 To List1.Count - 1 Do
Begin
If Result = " Then
Begin
Suffix := ";
End
Else
Begin
Suffix := ', ';
End;
If List2.IndexOf(List1) <> -1 Then
Begin
Result := Result + Suffix + List1;
End;
End;
Finally
List1.Free;
List2.Free;
End;
End;
TABLODAKİ ALAN İSİMLERİ
Bu fonksiyon, tablodaki alanlara ait isimleri, bir Tstrings nesnesi içerisine doldurur.
Function DBFieldNamesToTStrings(
DatabaseName : String;
TableName : String;
Strings : TStrings): Boolean;
Var
Table : TTable;
FieldNo : Integer;
Begin
Result := False;
If Not IsTable(DatabaseName, TableName) Then Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active := False;
Table.DatabaseName := DatabaseName;
Table.TableName := TableName;
Table.Active := True;
Strings.Clear;
For FieldNo := 0 To Table.FieldDefs.Count -1 Do
Begin
Strings.Add(Table.FieldDefs[FieldNo].Name);
End;
Result := True;
Except
End;
Finally
Table.Free;
End;
End;
ALAN NUMARASI
Bu fonksiyon, adı bilinen bir alanın, tablo içerisindeki sırasını bulur.
Function DBFieldNo(DatabaseName, TableName, FieldName:
String): Integer;
Var
Table : TTable;
FieldIndex : Integer;
FieldNumber: Integer;
Begin
Result := -1;
If Not IsTable(DatabaseName, TableName) Then Exit;
If Not IsField(DatabaseName, TableName, FieldName) Then
Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active := False;
Table.DatabaseName := DatabaseName;
Table.TableName := TableName;
Table.Active := True;
FieldIndex :=
Table.FieldDefs.IndexOf(FieldName);
FieldNumber :=
Table.FieldDefs[FieldIndex].FieldNo;
Result := FieldNumber;
Except
End;
Finally
Table.Free;
End;
End;
ALAN UZUNLUĞU
Tablo içerisindeki bir alanın, uzunluğu, bu fonksiyon ile bulunur.
Function DBFieldSize(DatabaseName, TableName, FieldName:
String): Integer;
Var
Table : TTable;
FieldIndex : Integer;
FieldSize : Integer;
Begin
Result := 0;
If Not IsTable(DatabaseName, TableName) Then Exit;
If Not IsField(DatabaseName, TableName, FieldName) Then
Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active := False;
Table.DatabaseName := DatabaseName;
Table.TableName := TableName;
Table.Active := True;
FieldIndex :=
Table.FieldDefs.IndexOf(FieldName);
FieldSize :=
Table.FieldDefs[FieldIndex].Size;
Result := FieldSize;
Except
End;
Finally
Table.Free;
End;
End;
ALAN TİPLERİ
Adı bilinen bir alanın tipini bulmak için aşağıdaki fonksiyon kullanılabilir.
Function TypeField(DatabaseName, TableName, FieldName:
String): String;
Var
Table : TTable;
FieldIndex : Integer;
FieldType : TFieldType;
Begin
Result := ";
If Not IsTable(DatabaseName, TableName) Then Exit;
If Not IsField(DatabaseName, TableName, FieldName) Then
Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active := False;
Table.DatabaseName := DatabaseName;
Table.TableName := TableName;
Table.Active := True;
FieldIndex :=
Table.FieldDefs.IndexOf(FieldName);
FieldType :=
Table.FieldDefs[FieldIndex].DataType;
If FieldType=ftUnknown Then Result := 'Unknown';
If FieldType=ftString Then Result := 'String';
If FieldType=ftSmallInt Then Result := 'SmallInt';
If FieldType=ftInteger Then Result := 'Integer';
If FieldType=ftWord Then Result := 'Word';
If FieldType=ftBoolean Then Result := 'Boolean';
If FieldType=ftFloat Then Result := 'Float';
If FieldType=ftCurrency Then Result := 'Currency';
If FieldType=ftBCD Then Result := 'BCD';
If FieldType=ftDate Then Result := 'Date';
If FieldType=ftTime Then Result := 'Time';
If FieldType=ftDateTime Then Result := 'DateTime';
If FieldType=ftBytes Then Result := 'Bytes';
If FieldType=ftVarBytes Then Result := 'VarBytes';
If FieldType=ftBlob Then Result := 'Blob';
If FieldType=ftMemo Then Result := 'Memo';
If FieldType=ftGraphic Then Result := 'Graphic';
{$IFDEF WIN32}
If FieldType=ftAutoInc Then Result := 'AutoInc';
If FieldType=ftFmtMemo Then Result := 'FmtMemo';
If FieldType=ftParadoxOle Then Result :=
'ParadoxOle';
If FieldType=ftDBaseOle Then Result := 'DBaseOle';
If FieldType=ftTypedBinary Then Result :=
'TypedBinary';
{$ENDIF}
Except
End;
Finally
Table.Free;
End;
End;
