Mega Code Archive
Sorgudan dosyaya aktarma
<![CDATA[
Codec By GeNiUS !
genius@turkiye.com
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.
]]>