{
>>>> 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
   { &amp;   -> & }
      _UZN_ := LENGTH(_ARANACAK_);
    _NEW_DATA_ :='';

    FOR _DNG_ := 1 TO _UZN_ DO
    BEGIN
      _CHAR_ :=  _ARANACAK_[_DNG_];//AKTİF KARAKTER
       IF _CHAR_ = '&' THEN _CHAR_ :='&amp;';//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.