Bir Paradox tablosunun yeniden anahtarlanması
Mevcut bir Paradox tablosu, aşağıdaki fonksiyon kullanılarak yeniden anahtarlanabilir.
Function DBParadoxCreateNKeys(
DatabaseName : String;
TableName : String;
NKeys : Integer): Boolean;
Var
T : TTable;
T2 : TTable;
i : Integer;
TempDBName : String;
TempTblNam : String;
TempTblStub: String;
KeysString : String;
Begin
Result := False;
{Select a temporary table name}
TempTblStub := 'qrz';
TempDBName := DatabaseName;
TempTblNam := '';
For i := 1 To 100 Do
Begin
TempTblNam := TempTblStub+StringPad(IntToStr(i),'0',3,False)+'.Db';
If Not IsTable(TempDBName,TempTblNam) Then
Begin
Break;
End
Else
Begin
If i = 100 Then
Begin
DBDeleteTable(
TempDBName,
TempTblNam);
End;
End;
End;
T := TTable.Create(nil);
T2 := TTable.Create(nil);
Try
Try
T.Active := False;
T.DatabaseName := DatabaseName;
T.TableName := TableName;
T.Active := True;
T2.Active := False;
T2.DatabaseName := TempDBName;
T2.TableName := TempTblNam;
T2.FieldDefs.Assign(T.FieldDefs);
T2.IndexDefs.Clear;
KeysString := '';
For i := 0 To NKeys - 1 Do
Begin
If i > 0 Then
Begin
KeysString := KeysString + ';';
End;
KeysString :=
KeysString +
DBFieldNameByNo(
DatabaseName,
TableName,
i);
End;
T2.IndexDefs.Add('',KeysString,[ixPrimary]);
T2.CreateTable;
T2.Active := False;
T.Active := False;
AddTables(
DatabaseName,
TableName,
TempDBName,
TempTblNam);
DBDeleteTable(DatabaseName,TableName);
T2.Active := True;
T.DatabaseName := DatabaseName;
T.TableName := TableName;
T.FieldDefs.Assign(T2.FieldDefs);
T.IndexDefs.Clear;
T.IndexDefs.Add('',KeysString,[ixPrimary]);
T.CreateTable;
T2.Active := False;
T.Active := False;
AddTables(
TempDBName,
TempTblNam,
DatabaseName,
TableName);
DBDeleteTable(
TempDBName,
TempTblNam);
Result := True;
Except
ShowMessage('Error in Function DBParadoxCreateNKeys');
End;
Finally
T.Free;
T2.Free;
End;
End;
Tablo adının değiştirilmesi
Belirtilen tablonun adını değiştirir. Bu fonksiyon kullanılırken, veri tabanındaki referans sınırlamalarına dikkat edilmelidir. SQL tabanlı veri tabanlarında, eğer tabloya referans eden başka veri tabanı nesneleri varsa, tablonun silinmesine izin verilmeyecektir.
Function DBReNameTable(
DatabaseName,
TableNameOld,
TableNameNew: String): Boolean;
Begin
Result := True;
Try
If Not IsTable(DatabaseName, TableNameOld) Then
Begin
Result := False;
Exit;
End;
{First Copy The Source Table To The New Table}
If Not DBCopyTable(
DatabaseName,
TableNameOld,
DatabaseName,
TableNameNew) Then
Begin
Result := False;
Exit;
End;
{Now Drop The Source Table}
If Not DBDropTable(DatabaseName, TableNameOld) Then
Begin
Result := False;
Exit;
End;
Except
Result := False;
End;
End;
{!~ Applies BatchMode Types As Appropriate To
Source and Destination Tables}
Function DBRecordMove(
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestTable: String;
BMode: TBatchMode): Boolean;
var S : TTable;
D : TTable;
B : TBatchMove;
begin
S := TTable.Create(nil);
D := TTable.Create(nil);
B := TBatchMove.Create(nil);
try
{Create The Source Table}
S.Active := False;
S.DatabaseName := SourceDatabaseName;
S.ReadOnly := False;
S.TableName := SourceTable;
S.Active := true;
{Create The Destination Table}
D.Active := False;
D.DatabaseName := DestDatabaseName;
D.TableName := DestTable;
D.ReadOnly := False;
{Make the table copy}
B.AbortOnKeyViol := False;
B.AbortOnProblem := False;
B.Destination := D;
B.Source := S;
B.Mode := BMode;
Try
B.Execute;
Except
End;
Result := True;
finally
S.Free;
D.Free;
B.Free;
end;
End;
Tablo yapıları aynı mı?
Bu fonksiyonda, iki tablonun yapısı karşılaştırılır ve aynı ise TRUE değeri döndürülür.
Function DBSchemaSame(const
DatabaseName1,
Table1,
DatabaseName2,
Table2: string): Boolean;
Begin
Result := IsStructureSame(DatabaseName1,Table1,DatabaseName2,Table2);
End;
{!~ Creates a new TSession object.}
{$IFDEF WIN32}
Function DBSessionCreateNew: TSession;
{$ENDIF WIN32}
{$IFDEF WIN32}
Var
List : TStringList;
Seed : String;
i : Integer;
Ses : String;
Begin
Seed := 'Session';
Ses := Seed+'0';
List := TStringList.Create;
Try
Sessions.GetSessionNames(List);
For i := 0 To 1000 Do
Begin
Ses := Seed + IntToStr(i);
If List.IndexOf(Ses) = -1 Then Break;
End;
Result := Sessions.OpenSession(Ses);
Finally
List.Free;
End;
End;
{$ENDIF}
Bir tablo alanındaki değerlerin sağ tarafındaki boşlukların temizlenmesi
Belirtilen alandaki değerlerin, sağ yanındaki boşlukları temizleyen bir fonksiyondur.
Function DBTrimBlanksRight(
DatabaseName : String;
TableName : String;
FieldName : String): Boolean;
Var
Q : TQuery;
S : String;
Begin
{ Result := False;}{zzz}
Q := TQuery.Create(nil);
Try
Q.Active := False;
Q.DatabaseName := DatabaseName;
Q.RequestLive := True;
Q.Sql.Clear;
Q.Sql.Add('Select');
Q.Sql.Add('*');
Q.Sql.Add('From');
Q.Sql.Add('"'+TableName+'"');
Q.Active := True;
Q.First;
While Not Q.EOF Do
Begin
S := Q.FieldByName(FieldName).AsString;
S := Trim(S);
S := Trim(S);
Q.Edit;
Q.FieldByName(FieldName).AsString := S;
Q.Post;
Q.Next;
End;
Result := True;
Finally
Q.Free;
End;
End;
Aranan alan, tabloda var mı?
Alan, belirtilen tabloda varsa fonksiyondan TRUE değeri döner.
Function IsField(DatabaseName, TableName, FieldName: String): Boolean;
Var
Query : TQuery;
T : TTable;
i : Integer;
UpperFN : String;
TestFN : String;
Begin
Result := False;
UpperFN := UpperCase(FieldName);
If Not IsTable(DatabaseName, TableName) Then Exit;
Query := TQuery.Create(nil);
T := TTable.Create(nil);
Try
Try
Query.DatabaseName := DatabaseName;
Query.Sql.Clear;
Query.Sql.Add('Select ');
Query.Sql.Add('a.'+FieldName+' XYZ');
Query.Sql.Add('From');
If (Pos('.DB', UpperCase(TableName)) > 0) Or
(Pos('.DBF',UpperCase(TableName)) > 0) Then
Begin
Query.Sql.Add('"'+TableName+'" a');
End
Else
Begin
Query.Sql.Add(TableName+' a');
End;
Query.Active := True;
Result := True;
Except
Try
T.Active := False;
T.DatabaseName := DatabaseName;
T.TableName := TableName;
T.Active := True;
If T.FieldDefs.IndexOf(FieldName) > -1 Then
Begin
Result := True;
End
Else
Begin
For i := 0 To T.FieldDefs.Count -1 Do
Begin
TestFN := UpperCase(T.FieldDefs[i].Name);
If TestFN = UpperFN Then
Begin
Result := True;
Break;
End;
End;
End;
T.Active := False;
Except
End;
End;
Finally
Query.Free;
T.Free;
End;
End;
Alan anahtar mı?
Belirtilen alan, o tabloda mevcutsa ve anahtar olarak kullanılıyorsa, bu fonksiyondan TRUE değeri döner.
Function IsFieldKeyed(DatabaseName, TableName, FieldName: String): Boolean;
Var
Table : TTable;
FieldIndex : Integer;
i : Integer;
KeyCount : Integer;
LocalTable : Boolean;
ParadoxTbl : Boolean;
DBaseTable : Boolean;
TempString : String;
Begin
Result := False;
If Not IsTable(DatabaseName, TableName) Then Exit;
If Not IsField(DatabaseName, TableName, FieldName) Then Exit;
TempString := UpperCase(Copy(TableName,Length(TableName)-2,3));
ParadoxTbl := (Pos('.DB',TempString) > 0);
TempString := UpperCase(Copy(TableName,Length(TableName)-3,4));
DBaseTable := (Pos('.DBF',TempString) > 0);
LocalTable := (ParadoxTbl Or DBaseTable);
Table := TTable.Create(nil);
Try
Try
Table.DatabaseName := DatabaseName;
Table.TableName := TableName;
Table.Active := True;
KeyCount := Table.IndexFieldCount;
FieldIndex := Table.FieldDefs.IndexOf(FieldName);
If LocalTable Then
Begin
If ParadoxTbl Then
Begin
Result := (FieldIndex < KeyCount);
End
Else
Begin
Table.IndexDefs.UpDate;
For i := 0 To Table.IndexDefs.Count-1 Do
Begin
{Need to check if FieldName is in the Expression listing}
If Pos(UpperCase(FieldName),UpperCase(Table.IndexDefs[i].Expression))>0 Then
Begin
Result := True;
Break;
End;
{Need to check if FieldName is in the Fields listing}
If Pos(UpperCase(FieldName),UpperCase(Table.IndexDefs[i].Fields))>0 Then
Begin
Result := True;
Break;
End;
End;
End;
End
Else
Begin
If Table.
FieldDefs[FieldIndex].
Required
Then
Begin
Result := True;
End;
End;
Except
End;
Finally
Table.Free;
End;
End;
Tablo mevcut mu?
Bu fonksiyon, belirtilen tablo varsa TRUE değerini döndürür.
Function IsTable(DatabaseName, TableName: String): Boolean;
Var
Query: TQuery;
Begin
Result := False;
Query := TQuery.Create(nil);
Try
Try
Query.DatabaseName := DatabaseName;
Query.Sql.Clear;
Query.Sql.Add('Select *');
Query.Sql.Add('From');
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;
Query.Active := True;
Result := True;
Except
End;
Finally
Query.Free;
End;
End;
Tablo mevcut ve esas anahtarı var mı
Bu fonksiyon, belirtilen tablo, mevcutsa ve öncelikli anahtara sahipsei TRUE değerini döndürür.
Function IsTableKeyed(DatabaseName, TableName: String): Boolean;
Var
Table : TTable;
i : Integer;
IsKeyed : Boolean;
Begin
Result := False;
IsKeyed := False;
If Not IsTable(DatabaseName, TableName) Then Exit;
Table := TTable.Create(nil);
Try
Try
Table.DatabaseName := DatabaseName;
Table.TableName := TableName;
Table.Active := True;
For i := 0 To Table.FieldDefs.Count-1 Do
Begin
If Table.FieldDefs[i].Required Then
Begin
IsKeyed := True;
Break;
End;
End;
If IsKeyed Then
Begin
Result := True;
End
Else
Begin
Result := False;
{Need to examine indexdefs}
If (Pos('.DB', UpperCase(TableName)) > 0) Then
Begin
{Table is either Paradox or DBase}
Table.IndexDefs.UpDate;
If (Pos('.DBF', UpperCase(TableName)) > 0) Then
Begin
{Table is a DBase Table}
If Table.IndexDefs.Count > 0 Then
Begin
Result := True;
End;
End
Else
Begin
{Table is a Paradox Table}
For i := 0 To Table.IndexDefs.Count-1 Do
Begin
If ixPrimary in Table.IndexDefs[i].Options Then
Begin
Result := True;
Break;
End;
End;
End;
End
Else
Begin
Result := False;
End;
End;
Except
End;
Finally
Table.Free;
End;
End;
Mevcut bir tablo ile aynı yapıda başka bir tablo yaratmak
Bir veri tabanı içerisinde var olan tablo ile tıpatıp aynı bir başka tablo, herhangi bir veri tabanı içerisinde yaratılabilir. "Datali" değişkenine bağlı olarak, verilerde yeni tabloya aktarılabilir.
implementation
uses DB, DBTables ;
{$R *.DFM}
function tabloaktar(SourceDB,
SourceTable,
DestDb,
DestTable:string;
datali:boolean):boolean;
var
tSource, TDest: TTable;
i:integer;
begin
TSource := TTable.create(nil);
with TSource do begin
DatabaseName := sourcedb;
TableName := Sourcetable;
open;
end;
TDest := TTable.create(nil);
with TDest do begin
DatabaseName := DestDb;
TableName := DestTable;
FieldDefs.Assign(TSource.FieldDefs);
IndexDefs.Assign(TSource.IndexDefs);
CreateTable;
end;
tdest.open;
tsource.first;
if datali then
begin
while not tsource.eof do
begin
tdest.append;
for i:=0 to tsource.fieldcount-1 do begin
tdest.fields[i].assign(tsource.fields[i]);
showmessage(tsource.fields[i].asstring)
end;
tsource.Next;
end;
end;
TSource.close;
tdest.close;
showmessage('aktarma bitti')
end;
Tablo filtreleme
Bir tablonun filterelenmesi, basit olarak filter özelliğine, seçim kriterinin yazılıp, filtered özelliğinin TRUE yapılması ile yapılır. Tablo seçim kriterine uyan kayıtları gösterir, diğerlerini göstermez.
Filtreleme işleminin, dinamik bir sorgu niteliğinde, form üzerindeki alanlar kullanılarak yapılması, daha kullanışlı olabilir. Örneğin, Oracle formlarında, sorgu moduna girildiğinde, veri alanlarının temizlenerek, sorgu parametrelerinin yazılmasına imkan vermekte ve sorgu uygula komutu ile birlikte, belirtilen kriterlere uygun sonuç kümesi getirilmektedir.
Benzer bir yapı, Delphi formlarında da kurulabilir. Bunun için takip edilecek adımlar şunlardır.
" Form üzerine,"Sorgu moduna geçiş" için kullanılacak bir buton yerleştirin.
" Butona basıldığında çalışması için, OnClick olay yordamı içerisinde verilecek
<SorgulanacakTabloAdı>.Insert
" komutu ile, veri alanlarının temizlenmesini sağlayın
" Form üzerine "Sorgu uygulama" için kullanılacak başka bir buton yerleştirip, OnClick olay yordamına,
< SorgulanacakTabloAdı >.cancel
" komutunu yazarak, arama kriteri olarak girilen değerlerin, tabloya kaydedilmemesini sağlayın. Fakat bu işlemden önce, sorgulama kriteri olarak kullanılacak alanlardaki sorgu kriterlerini değişkenlere aktararak, saklayın.
" Seçilen alanların tümü, sorgu işleminde kullanılmayabilir. Bu nedenle boş bırakılan alanların, sorgulama esnasında problem yaratmaması için, aşağıdaki fonksiyonları kullanın. Eğer, sorgulama alanı boş bırakılmışsa, bu fonksiyonlar, o alana ait her türlü değerin kabul edilmesini sağlayacaktır.
function nvlforstr(birinci:string;ikinci:string):string;
begin
if birinci=''
then result:=ikinci
else result:=birinci;
end;
function nvlforscl(birinci:string;ikinci:string):string;
begin
if birinci=' . . . '
then result:=ikinci
else result:=birinci;
end;
function nvlforTEL(birinci:string;ikinci:string):string;
begin
if birinci='( ) '
then result:=ikinci
else result:=birinci;
end;
function nvltoyil(s1 : string) : string;
begin
if length(s1)=0 then result:='*' else result:=s1;
end;
" Filtre uygulanacak tablonun OnFilter olay yordamı parametreleri arasında bulunan ACCEPT, TRUE değerini alırsa, tablodaki o kayıt, filtreleme kriterine uygun demektir. Aksi taktirde, kayıt gösterilmeyecektir. Bu yordam aşağıdaki gibi kullanılır. Bu yordamdaki kod, tablonun her satırı için çalışarak, gereken mantıksal karşılaştırmayı yapacak ve ACCEPT parametresinin değerine göre kayıt kabul veya red edilecektir.
procedure Tf_data_ana.TableFilterRecord(DataSet: TDataSet;
var Accept: Boolean);
begin
Accept := (
(Table.FieldByName('firm_adi').AsString,
nvltoyil(kurulus_adi)) and
(Table.FieldByName('firm_sah').AsString,
NVLtoyil(sahip_adi)) and
(Table.FieldByName('VER_SCL_NO').AsString = NVLForscl(ver_sic,Table.FieldByName('VER_SCL_NO').AsString)) and
(Table.FieldByName('VER_DA').AsString,
nvltoyil(vrg_d)) and
(Table.FieldByName('TEL').AsString= NVLForTEL(telefon,Table.FieldByName('TEL').AsString))
);
end;
Şifreli paradox tablosuna otomatik bağlantı
Paradox tablolarına da şifre konabilir. Bu durumda, kullanıcı bağlanırken, şifresini belirtmek zorundadır. Şifrenin uygulama tarafından otomatik olarak girilmesi için tablo açılmadan önce
Session.addpassword('<şifre>');
Komutu verilmelidir.
SubString fonksiyonunun SQL cümlesinde kullanılması
DBase ve Paradox veri tabanlarında sorgulama yapılırken kullanılabilecek bir fonksiyon olan SubString fonksiyonu, neredeyse hiç dökümante edilmemiştir. Bu fonksiyon, hem sorguda, hem sıralamada hem de karşılaştırma kısmında kullanılabilir. Notasyonu şu şekildedir.
Substring(<alan adı> from <Başlangıç> to <Bitiş>)
Örnek
Select substring(adi from 2 to 5) from customer
Where substring(adi from 4 to 5)='AL'
Order by substring(adi from 2 to 3)
DbControlGrid kaydırma çubukları
DbControlGrid bileşeninde, normalda sadece dikey kaydırma çubuğu vardır. Yatay kaydırma çubuğu görünmez. Eğer yatay kaydırma çubuğunun da görünmesi ve kullanılması istenirse yapılması gereken, ScrollBars özelliğinin yayınlanması ve seçime göre araç çubuklarının hazırlanmasıdır.
unit EDBcgrd;
interface
uses
Windows,
Messages,
SysUtils,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
DBCGrids,
Unit1 in '......Program FilesBorlandDelphi 3Unit1.pas' {Form1};
type scrollbartype=(sbBoth,SbNone,sbVertical,sbHorizontal);
type
TEDBCtrlGrid = class(TDBCtrlGrid)
private
{ Private declarations }
fsbars:scrollbartype;
protected
{ Protected declarations }
public
{ Public declarations }
procedure CreateWnd;override;
published
{ Published declarations }
property ScrollBars:scrollbartype read fsbars write fsbars;
end;
procedure Register;
implementation
procedure TEDBctrlgrid.CreateWnd;
begin
inherited CreateWnd;
case scrollbars of
sbboth:showscrollbar(handle,sb_both,true);
sbnone:showscrollbar(handle,sb_both,false);
sbvertical:begin
showscrollbar(handle,sb_vert,true);
showscrollbar(handle,sb_horz,false);
end;
sbhorizontal:begin
showscrollbar(handle,sb_vert,false);
showscrollbar(handle,sb_horz,true);
end;
end;
end;
procedure Register;
begin
RegisterComponents('F1Delphi', [TEDBCtrlGrid]);
end;
end.
Tablodan dosyaya aktarma
Bir Ttable bileşeninin bağlı olduğu veri tabanı tablosundaki verilerin, Sabit kolon uzunluğunda veya, kolonlar arasına ayıraçlar koymak suretiyle metin dosyasına saklanması için geliştirilmiş bir Ttable türevi bileşene ait kod aşağıdadır.
unit Exttab;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,dialogs,
Db, DBTables,StdCtrls,ComCtrls,WinTypes, WinProcs, ExtCtrls,DBCtrls;
const
LANGUAGE='TURKISH';
REGISTERED=FALSE;
type
TExtTab= class(Ttable)
private
{ Private declarations }
f_message:string;
f_about:string;
f_delimited:boolean;
f_delimeter:string;
f_filename:string;
protected
{ Protected declarations }
public
{ Public declarations }
published
procedure SaveToFile;
property IsDelimited:boolean read f_delimited write f_delimited;
property Delimeter:string read f_delimeter write f_delimeter;
property FilePathAndName:string read f_filename write f_filename;
property About:string read f_about write f_about;
{ Published declarations }
end;
implementation
var msgid:integer;
procedure TExtTab.SaveToFile;
function tamamla(instr:string;x:integer;j:integer):string;
var
l,t:integer;
begin
if (IsDelimited) and (delimeter='') then delimeter:='@';
if not isdelimited then
begin
if length(fields[j].fieldname)>=x then
x:=length(fields[j].fieldname);
for l:=1 to x-length(instr) do
instr:=instr+' ';
result:=instr+' ';
end
else result:=instr+delimeter;
end;
var
col_count:integer;
row_count:integer;
z,i,j:integer;
row:string;
f:system.text;
st,et,ft:ttime;
begin
if not active then open;
if FilePathAndName='' then
begin
filepathandname:= InputBox('Dikkat', 'Dosya ismini belirtiniz!', 'c:TmpName.txt');
end;
col_count:=fieldcount;
row_count:=recordcount;
rewrite(f,FilePathAndName);
first;
disablecontrols;
st:=time;
for j:=0 to col_count-1 do
write(f,tamamla(fields[j].fieldname,fields[j].displaywidth,j));
writeln(f,'');
for i:=0 to row_count-1 do
begin
for j:=0 to col_count-1 do
begin
if ord(fields[j].datatype)<14 then
begin
row:=tamamla(fields[j].asstring,fields[j].displaywidth,j);
write(f,row);
end;
end;
next;
writeln(f,'');
end;
et:=time;
ft:=et-st;
showmessage('Başlangıç: '+timetostr(st)+' '+' Bitiş: '+timetostr(et)+''#10#13+
'Kayıt Sayısı: '+inttostr(fieldcount)+' Kolon X '+inttostr(recordcount)+' Satır.'#10#13+
'İşlem tamam!');
enablecontrols;
closefile(f);
end;
end.
Sorgudan dosyaya aktarma
Tquery bileşeni kullanarak yapılan sorgu neticesinde dönen sonuç kümesinin, metin dosyasına atılması için geliştirilmiş Tquery türevi bir bileşene ait kod örneği aşağıdadır. Bu örnekte, Dene ve al sürümü, bileşen uygulamasına örnek bir yöntem de yer almaktadır.
unit ExtQuery;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,Db, DBTables, WinTypes, WinProcs, ExtCtrls,DBCtrls;
const
LANGUAGE='TURKISH';
REGISTERED=FALSE;
type
TExtQuery = class(TQuery)
private
{ Private declarations }
f_message:string;
f_about:string;
f_delimited:boolean;
f_delimeter:string;
f_filename:string;
protected
{ Protected declarations }
public
{ Public declarations }
published
procedure SaveToFile;
property IsDelimited:boolean read f_delimited write f_delimited;
property Delimeter:string read f_delimeter write f_delimeter;
property FilePathAndName:string read f_filename write f_filename;
property About:string read f_about write f_about;
constructor create(aowner:tcomponent);override;
destructor destroy;override;
{ Published declarations }
end;
implementation
var
msgid:integer;
constructor TExtquery.create(aowner:tcomponent);
begin
inherited;
about:='Written by Faruk DEMİREL (fdemirel@kkk.tsk.mil.tr) 01.02.1998 Turkey';
if (not registered) AND (componentstate <> [csDesigning]) then
{Eğer kayıtlı bir kullanıcı değilse ve uygulama çalışma modunda ise, uyarı ve tanıtım mesajını ver.}
if language='ENGLISH' then
begin
showmessage ('EXTENDED QUERY'+#10#13+
'TRIAL'+#10#13+
'BY FARUK DEMİREL'+#10#13+
'fdemirel@kkk.tsk.mil.tr');
msgid:=300;
end
else
begin
showmessage ('EXTENDED QUERY'+#10#13+
'DENE VE AL SÜRÜMÜ'+#10#13+
'YAZAN FARUK DEMİREL'+#10#13+
'fdemirel@kkk.tsk.mil.tr');
msgid:=100;
end;
end;
destructor TExtquery.destroy;
begin
inherited;
end;
procedure TExtQuery.SaveToFile;
function tamamla(instr:string;x:integer):string;
var
l,t:integer;
begin
if (IsDelimited) and (delimeter='') then delimeter:='@';
if FilePathAndName='' then
begin
showmessage('Invalid path or filename');
exit;
end;
if not isdelimited then
begin
if length(instr)<x then
for l:=1 to x-length(instr) do
instr:=instr+' ';
result:=instr+' ';
end
else result:=instr+delimeter;
end;
var
col_count:integer;
row_count:integer;
z,i,j:integer;
w:array[0..49] of string;
row:string;
f:system.text;
begin
if not active then open;
col_count:=fieldcount;
row_count:=recordcount;
rewrite(f,FilePathAndName);
first;
for j:=0 to col_count-1 do
write(f,tamamla(fields[j].fieldname,fields[j].displaywidth));
writeln(f,'');
for i:=0 to row_count-1 do
begin
for j:=0 to col_count-1 do
begin
if ord(fields[j].datatype)<14 then
begin
row:=tamamla(fields[j].asstring,fields[j].displaywidth);
write(f,row);
end;
end;
next;
writeln(f,'');
end;
closefile(f);
end;
end.