Mega Code Archive
Paradox_to_xml
<![CDATA[
{
>>>> DB -> XML 'E DÖNÜŞTÜREN COMPONENT <<<<
Bu Fonksiyor Murat Turan tarafından geliştirilmiştir.
admin@datakent.com
www.datakent.com
Yapınız : Bu sayfadaki kodun tamamını not defterinde boş bir sayfaya yapıştırın
ve XML.pas adıyla kaydedin. Daha sonra Derleyin.
}
unit XML;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, DBTables, ComCtrls,ExtCtrls,StdCtrls;
type
TXML = class(TComponent)
private
_TABLE_:TTABLE;
_ENTER_:BOOLEAN;
_SAVE_FILE_NAME_:STRING;
_USER_SAVE_:BOOLEAN;
_PROGRES_:BOOLEAN;
_INFO_:BOOLEAN;
FACTIVE:BOOLEAN;
FUNCTION GetTable:TTable;
PROCEDURE SetTable(Const Value:TTable);
FUNCTION GetEnter:Boolean;
PROCEDURE SetEnter(Const Value:Boolean);
FUNCTION GetFilename:String;
PROCEDURE SetFilename(Const Value:String);
FUNCTION GetUserSave:Boolean;
PROCEDURE SetUserSave(Const Value:Boolean);
FUNCTION GetIlerleme:Boolean;
PROCEDURE SetIlerleme(Const Value:Boolean);
FUNCTION GetUyar:Boolean;
PROCEDURE Setuyar(Const Value:Boolean);
FUNCTION GetACTIVE:Boolean;
procedure SETACTIVE(const Value: BOOLEAN);
PROCEDURE _PARADOX_TO_XML_;
protected
public
constructor Create(AOwner:TComponent);override;
destructor Destroy;Override;
published
PROPERTY TABLO:TTABLE READ GetTable WRITE SetTable;
PROPERTY XML_SATIRLI:Boolean READ GetEnter WRITE SetEnter;
PROPERTY XML_KAYIT_DOSYA_ADI:STRING READ GetFilename WRITE SetFilename;
PROPERTY XML_KULLANICI_KAYIT:BOOLEAN READ GetUserSave WRITE SetUserSave;
PROPERTY XML_ISLEM_DURUMU:BOOLEAN READ GetIlerleme WRITE SetIlerleme;
PROPERTY XML_UYARI:BOOLEAN READ GetUyar WRITE Setuyar;
PROPERTY ACTIVE:BOOLEAN READ GETACTIVE WRITE SETACTIVE;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Standard', [TXML]);
end;
{ TXML }
constructor TXML.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
destructor TXML.Destroy;
begin
inherited Destroy;
End;
function TXML.GetACTIVE: Boolean;
begin
Result := FACTIVE;
end;
function TXML.GetEnter: Boolean;
begin
Result := _ENTER_;
end;
function TXML.GetFilename: String;
begin
Result := _SAVE_FILE_NAME_;
end;
function TXML.GetIlerleme: Boolean;
begin
Result := _PROGRES_;
end;
function TXML.GetTable: TTable;
begin
Result := _TABLE_;
end;
function TXML.GetUserSave: Boolean;
begin
Result := _USER_SAVE_;
end;
function TXML.GetUyar: Boolean;
begin
Result := _INFO_;
end;
procedure TXML.SETACTIVE(const Value: BOOLEAN);
begin
FACTIVE :=VALUE;
IF FACTIVE = TRUE THEN _PARADOX_TO_XML_;
end;
procedure TXML.SetEnter(const Value: Boolean);
begin
_ENTER_ :=VALUE;
end;
procedure TXML.SetFilename(const Value: String);
begin
_SAVE_FILE_NAME_ := Value;
end;
procedure TXML.SetIlerleme(const Value: Boolean);
begin
_PROGRES_ := VALUE;
end;
procedure TXML.SetTable(const Value: TTable);
begin
_TABLE_ := VALUE;
end;
procedure TXML.SetUserSave(const Value: Boolean);
begin
_USER_SAVE_ := Value;
end;
procedure TXML.Setuyar(const Value: Boolean);
begin
_INFO_ :=VALUE;
end;
procedure TXML._PARADOX_TO_XML_;
function _DEGISTIR_(_ARANACAK_: STRING): STRING;
VAR
_UZN_:INTEGER;
_DNG_:INTEGER;
_NEW_DATA_, _CHAR_:STRING;
begin
{ & -> & }
_UZN_ := LENGTH(_ARANACAK_);
_NEW_DATA_ :='';
FOR _DNG_ := 1 TO _UZN_ DO
BEGIN
_CHAR_ := _ARANACAK_[_DNG_];//AKTİF KARAKTER
IF _CHAR_ = '&' THEN _CHAR_ :='&';//ARANAN VE YENİ DEĞER
_NEW_DATA_ := _NEW_DATA_ + _CHAR_;//BİRLEŞTİR
END;
Result := _NEW_DATA_;
end;
VAR
_A_SAY_,_MAX_N_:INTEGER;
_DNG_ :BYTE;
_XML_S_ :TStrings;
_TYPE_,_FIELD_ :STRING;
_SQL_ :TQuery;
_AUTO_ :BOOLEAN;
_DATA_,_BRLS_ :STRING;
_ELKEME_ :BOOLEAN;
_CHR13_ :STRING;
_XML_SAVE_ :TSaveDialog;
_pform_ :TForm;
_lbl_position_ :TLabel;
_prb_position_ :TProgressBar;
_bvl_yanlar_ :TBevel;
BEGIN
_AUTO_ := FALSE;
_MAX_N_ := 1;
IF _TABLE_.Exists = FALSE THEN
BEGIN
MessageDlg(''+#13+#10+'VERİ TABANI BULUNAMADI.', mtError, [mbOK], 0);
ACTIVE :=FALSE;
EXIT;
END;
_A_SAY_ := _TABLE_.Fields.Count;
_XML_S_ := TStringList.Create;//XML_SOURCE CREATE
//XML START
_XML_S_.ADD(' <?xml version="1.0" standalone="yes"?> ');
_XML_S_.ADD('<DATAPACKET Version="2.0">');
_XML_S_.ADD(' <METADATA>');
_XML_S_.ADD(' <FIELDS>');
IF _PROGRES_ = TRUE THEN
BEGIN
_pform_ := TForm.Create(Application);
_lbl_position_ := TLabel.Create(_pform_);
_prb_position_ := TProgressBar.Create(_pform_);
_bvl_yanlar_ := TBevel.Create(_pform_);
with _pform_ do
begin
Width := 259;
Height := 50;
Position := poScreenCenter;
BorderStyle := bsNone;
FormStyle :=fsStayOnTop;
end;
with _lbl_position_ do
begin
Parent := _pform_;
Left := 8;
Top := 8;
Width := 64;
Height := 13;
Caption := '';
Font.Style := [fsBold];
end;
with _prb_position_ do
begin
Parent := _pform_;
Left := 8;
Top := 24;
Width := 241;
Height := 16;
end;
with _bvl_yanlar_ do
begin
Parent := _pform_;
Left := 0;
Top := 0;
Width := 688;
Height := 453;
Align := alClient;
Shape := bsFrame;
end;
_pform_.Show;
_lbl_position_.Caption :='Alanlar Oluşturuluyor...';
_prb_position_.Position := 0;
_prb_position_.Max := _A_SAY_;
END;
IF _TABLE_.Active = FALSE THEN _TABLE_.Open;
//TABLE FIELD
FOR _DNG_:= 0 TO _A_SAY_-1 DO
BEGIN
_FIELD_ := _TABLE_.Fields.Fields[_DNG_].FieldName;
_TYPE_ := _TABLE_.Fields.Fields[_DNG_].ClassName;
IF _TYPE_ = 'TAutoIncField' THEN _XML_S_.ADD(' <FIELD attrname="' + _FIELD_ + '" fieldtype="i4" SUBTYPE="Autoinc"/>');
IF _TYPE_ = 'TStringField' THEN _XML_S_.ADD(' <FIELD attrname="' + _FIELD_ + '" fieldtype="string" WIDTH="' + INTTOSTR(_TABLE_.Fields.Fields[_DNG_].Size) + '"/>' );
IF _TYPE_ = 'TIntegerField' THEN _XML_S_.ADD(' <FIELD attrname="' + _FIELD_ + '" fieldtype="i4"/>');
IF _TYPE_ = 'TSmallintField' THEN _XML_S_.ADD(' <FIELD attrname="' + _FIELD_ + '" fieldtype="i2"/>');
IF _TYPE_ = 'TFloatField' THEN _XML_S_.ADD(' <FIELD attrname="' + _FIELD_ + '" fieldtype="r8"/>');
IF _TYPE_ = 'TCurrencyField' THEN _XML_S_.ADD(' <FIELD attrname="' + _FIELD_ + '" fieldtype="r8" SUBTYPE="Money"/>');
IF _TYPE_ = 'TBooleanField' THEN _XML_S_.ADD(' <FIELD attrname="' + _FIELD_ + '" fieldtype="boolean"/>');
IF _TYPE_ = 'TDateField' THEN _XML_S_.ADD(' <FIELD attrname="' + _FIELD_ + '" fieldtype="date"/>');
IF _TYPE_ = 'TTimeField' THEN _XML_S_.ADD(' <FIELD attrname="' + _FIELD_ + '" fieldtype="time"/>');
IF _TYPE_ = 'TDateTimeField' THEN _XML_S_.ADD(' <FIELD attrname="' + _FIELD_ + '" fieldtype="dateTime"/>');
IF _TYPE_ = 'TMemoField' THEN _XML_S_.ADD(' <FIELD attrname="' + _FIELD_ + '" fieldtype="bin.hex" SUBTYPE="Text" WIDTH="' + INTTOSTR(_TABLE_.Fields.Fields[_DNG_].Size) + '"/>' );
IF _TYPE_ = 'TBlobField' THEN _XML_S_.ADD(' <FIELD attrname="' + _FIELD_ + '" fieldtype="bin.hex" SUBTYPE="Binary" WIDTH="' + INTTOSTR(_TABLE_.Fields.Fields[_DNG_].Size) + '"/>' );
IF _TYPE_ = 'TGraphicField' THEN _XML_S_.ADD(' <FIELD attrname="' + _FIELD_ + '" fieldtype="bin.hex" SUBTYPE="Graphics" WIDTH="' + INTTOSTR(_TABLE_.Fields.Fields[_DNG_].Size) + '"/>' );
//OTOMATİK NUMARA VARSA GEREKENİ YAP
IF _TYPE_ = 'TAutoIncField' THEN
BEGIN
_AUTO_ :=TRUE;
IF _TABLE_.RecordCount > 0 THEN
BEGIN
_SQL_ := TQuery.Create(Application);
_SQL_.DatabaseName := _TABLE_.DatabaseName;
_SQL_.SQL.Text :='';
_SQL_.SQL.Text := 'SELECT MAX(' + _FIELD_ + ') AS MAXNUM FROM "' + _TABLE_.TableName + '"';
_SQL_.open;
_MAX_N_ := _SQL_.FieldByName('MAXNUM').asinteger + 1;
_SQL_.close;
_SQL_.free;
_SQL_ :=nil;
END;
END;
IF _PROGRES_ = TRUE THEN _prb_position_.Position := _prb_position_.Position + 1;
Application.ProcessMessages;
END;
_XML_S_.ADD(' </FIELDS>');
IF _AUTO_ = TRUE THEN _XML_S_.ADD(' <PARAMS AUTOINCVALUE="' + IntToStr(_MAX_N_) +'"/>');
_XML_S_.ADD(' </METADATA>');
_XML_S_.ADD(' <ROWDATA>');
//TABLE DATA
_TABLE_.First;
IF _PROGRES_ = TRUE THEN
BEGIN
_lbl_position_.Caption :='Veriler XML Formatına Dönüştürülüyor...';
_prb_position_.Position := 0;
_prb_position_.Max := _TABLE_.RecordCount;
END;
WHILE NOT (_TABLE_.EOF) DO
BEGIN
_BRLS_ :='';
FOR _DNG_:= 0 TO _A_SAY_-1 DO
BEGIN
_FIELD_ := _TABLE_.Fields.Fields[_DNG_].FieldName;
_TYPE_ := _TABLE_.Fields.Fields[_DNG_].ClassName;
_DATA_ := _TABLE_.FieldByName(_FIELD_).AsString;
IF TRIM(_DATA_) ='' THEN _ELKEME_ :=TRUE ELSE _ELKEME_:=FALSE;
//EĞER XML İÇİN DEĞİŞKEN KARAKTER VARSA
IF POS('&',_DATA_)>0 THEN
BEGIN
IF (_TYPE_ = 'TStringField') OR (_TYPE_ = 'TMemoField') THEN
_DATA_ := _DEGISTIR_(_DATA_);
END;
_DATA_ := AnsiQuotedStr(_DATA_,'"');
IF _ELKEME_ = FALSE THEN
BEGIN
IF _ENTER_ = TRUE THEN
_BRLS_ := _BRLS_ + _FIELD_ + '=' + _DATA_ + ' ' + #13#10
ELSE _BRLS_ := _BRLS_ + _FIELD_ + '=' + _DATA_ + ' ';
END;
END;
_XML_S_.ADD(' <ROW ' + _BRLS_ + '/>');//_XML_S_.ADD(' <ROW RowState="1" ' + _BRLS_ + '/>');
_TABLE_.Next;
IF _PROGRES_ = TRUE THEN _prb_position_.Position := _prb_position_.Position + 1;
Application.ProcessMessages;
END;
_TABLE_.CLOSE;
_XML_S_.ADD(' </ROWDATA>');
_XML_S_.ADD('</DATAPACKET>');
IF _PROGRES_ = TRUE THEN
BEGIN
_pform_.CLOSE;
_lbl_position_.FREE; _lbl_position_:=NIL;
_prb_position_.FREE; _prb_position_:=NIL;
_bvl_yanlar_.FREE; _bvl_yanlar_:=NIL;
_pform_.FREE; _pform_:=NIL;
END;
//KULLANICI TANIMLI KAYIT
IF _USER_SAVE_ = TRUE THEN
BEGIN
_XML_SAVE_ := TSaveDialog.Create(Application);
with _XML_SAVE_ do
begin
Filter := 'XML File (*.XML)|*.XML';
Options := [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing];
FileName := _SAVE_FILE_NAME_;
if Execute then
begin
_XML_S_.SaveToFile(_XML_SAVE_.FileName);
_XML_SAVE_.free;
_XML_SAVE_ :=nil;
IF _INFO_ = TRUE THEN
MessageDlg(''+#13+#10+'DB -> XML DÖNÜŞÜM İŞLEMİ TAMAMLANDI', mtInformation, [mbOK], 0);
end;
end;
END ELSE BEGIN
IF TRIM(_SAVE_FILE_NAME_) <> '' THEN
BEGIN
_XML_S_.SaveToFile(_SAVE_FILE_NAME_);
IF _INFO_ = TRUE THEN MessageDlg(''+#13+#10+'DB -> XML DÖNÜŞÜM İŞLEMİ TAMAMLANDI', mtInformation, [mbOK], 0);
END;
END;
_XML_S_.Text :='';
_XML_S_.FREE;
_XML_S_ := NIL;
FACTIVE :=FALSE;
end;
end.
]]>