xmltype.pas

Oracle Data Access Components Source Code ODAC v.6.70.0.45

unit XMLType;

interface

uses
{$IFDEF LINUX}
  SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs, QStdCtrls,
  QDBCtrls, QComCtrls, QExtCtrls, QGrids, QDBGrids, QButtons, OdacClx,
{$ELSE}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DBCtrls, ExtCtrls, Grids, DBGrids, StdCtrls, ComCtrls, Buttons, OdacVcl,
{$ENDIF}
{$IFDEF FPC}
  LResources,
{$ENDIF}
  DB, {$IFNDEF FPC}MemDS{$ELSE}MemDataSet{$ENDIF},
  Ora, DBAccess, OraScript, OraSmart, OdacDemoFrame, OdacDemoForm, DAScript;

type
  TXMLTypeFrame = class(TOdacDemoFrame)
    ToolBar1: TPanel;
    DBGrid: TDBGrid;
    dsData: TDataSource;
    Query: TSmartQuery;
    OraSQL: TOraSQL;
    DBMemo1: TDBMemo;
    Panel1: TPanel;
    btOpen: TSpeedButton;
    btClose: TSpeedButton;
    DBNavigator1: TDBNavigator;
    btAddRecord: TSpeedButton;
    btShowCountry: TSpeedButton;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    Panel2: TPanel;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    Label1: TLabel;
    Panel3: TPanel;
    btCreate: TSpeedButton;
    btDrop: TSpeedButton;
    scCreate: TOraScript;
    scDrop: TOraScript;
    procedure btOpenClick(Sender: TObject);
    procedure btCloseClick(Sender: TObject);
    procedure btShowCountryClick(Sender: TObject);
    procedure btAddRecordClick(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure btCreateClick(Sender: TObject);
    procedure btDropClick(Sender: TObject);
  private
    { Private declarations }
  public
    procedure SetDebug(Value: boolean); override;
    procedure Initialize; override;
    destructor Destroy; override;
  end;

implementation
uses
  OraCall, OraClasses, OraObjects, XMLTypeDetails;

{$IFNDEF FPC}
{$IFDEF CLR}
{$R *.nfm}
{$ENDIF}
{$IFDEF WIN32}
{$R *.dfm}
{$ENDIF}
{$IFDEF LINUX}
{$R *.xfm}
{$ENDIF}
{$ENDIF}

procedure TXMLTypeFrame.Initialize;
begin
  inherited;

  Query.Connection := Connection;
  OraSQL.Connection := Connection;

  if XMLDetailsForm = nil then
    XMLDetailsForm := TXMLDetailsForm.Create(OdacForm);
end;

destructor TXMLTypeFrame.Destroy;
begin
  inherited;
  FreeAndNil(XMLDetailsForm);
end;

procedure TXMLTypeFrame.btOpenClick(Sender: TObject);
begin
  with Query do begin
    Close;
    if RadioButton1.Checked then
      SQL.Text:='SELECT a.rowid, a.* FROM xmlschema_type a'
    else
      SQL.Text:='SELECT a.rowid, a.* FROM xml_type a';
    Open;
  end;
end;

procedure TXMLTypeFrame.btCloseClick(Sender: TObject);
begin
  Query.Close;
end;

procedure TXMLTypeFrame.SetDebug(Value: boolean);
begin
  Query.Debug := Value;
  OraSQL.Debug := Value;
end;

procedure TXMLTypeFrame.btShowCountryClick(Sender: TObject);
var
  RetDoc: TOraXML;
  SchemaURL, RootElem: string;
begin
  with Query do begin
    with TOraXMLField(FieldByName('XMLField')).AsXML do begin
      if not IsSchemaBased then
        raise Exception.Create('XMLType - is not schema based!');
      RetDoc := TOraXML.Create();
      RetDoc.OCISvcCtx := OdacForm.OraSession.OCISvcCtx;
      try
        GetSchema(RetDoc, SchemaURL, RootElem);
        XMLDetailsForm.Execute('Schema', RetDoc.AsString);
      finally
        RetDoc.Free;
      end;
    end;
  end;
end;

procedure TXMLTypeFrame.btAddRecordClick(Sender: TObject);
begin
  with OraSQL do begin
    if RadioButton1.Checked then begin
      SQL.Text := 'INSERT INTO xmlschema_type (ID, XMLField) Values (:ID, :XMLField)';
      Randomize;
      ParamByName('ID').AsInteger := Random(1000);
      with ParamByName('XMLField').AsXML do begin
         OCISvcCtx := OdacForm.OraSession.OCISvcCtx;
         AsString := '<PurchaseOrder xmlns="http://www.oracle.com/PO.xsd" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" '+
         'xsi:schemaLocation="http://www.oracle.com/PO.xsd http://www.oracle.com/PO.xsd">'#$A+
         '  <PONum>' + IntToStr(Random(100)) + '</PONum>'#$A+
         '  <Company>Johnson Company</Company>'#$A+
         '  <Item>'#$A+
         '    <Part>9i Doc Set</Part>'#$A+
         '    <Price>' + IntToStr(Random(1000)) + '</Price>'#$A+
         '  </Item>'#$A+
         '  <Item>'#$A+
         '    <Part>8i Doc Set</Part>'#$A+
         '    <Price>' + IntToStr(Random(1000)) + '</Price>'#$A+
         '  </Item>'#$A+
         '</PurchaseOrder>'#$A;
      end;
    end
    else begin
      SQL.Text := 'INSERT INTO xml_type (ID, XMLField) Values (:ID, :XMLField)';
      Randomize;
      ParamByName('ID').AsInteger := Random(1000);
      with ParamByName('XMLField').AsXML do begin
         OCISvcCtx := OdacForm.OraSession.OCISvcCtx;
         AsString := '<PurchaseOrder>'#$A+
         '  <PONum>' + IntToStr(Random(100)) + '</PONum>'#$A+
         '  <Company>Johnson Company</Company>'#$A+
         '  <Item>'#$A+
         '    <Part>9i Doc Set</Part>'#$A+
         '    <Price>' + IntToStr(Random(1000)) + '</Price>'#$A+
         '  </Item>'#$A+
         '  <Item>'#$A+
         '    <Part>8i Doc Set</Part>'#$A+
         '    <Price>' + IntToStr(Random(1000)) + '</Price>'#$A+
         '  </Item>'#$A+
         '</PurchaseOrder>'#$A;
      end;
    end;
    Execute;
  end;

  Query.Refresh;
end;

procedure TXMLTypeFrame.RadioButton1Click(Sender: TObject);
begin
  Query.Close;
end;

procedure TXMLTypeFrame.SpeedButton1Click(Sender: TObject);
var
  RetDoc: TOraXML;
begin
  with Query do begin
    RetDoc := TOraXML.Create();
    RetDoc.OCISvcCtx := OdacForm.OraSession.OCISvcCtx;
    try
      with TOraXMLField(FieldByName('XMLField')).AsXML do begin
        Extract(RetDoc, '//Item[1]');
        if not Exists('//Item[1]') then
          raise Exception.Create('Path ''//Item[1]'' does not exists!');
        XMLDetailsForm.Execute('Extract', RetDoc.AsString);
      end;
    finally
      RetDoc.Free;
    end;
  end;
end;

procedure TXMLTypeFrame.SpeedButton2Click(Sender: TObject);
var
  RetDoc, XSLDoc: TOraXML;
begin
  with Query do begin
    RetDoc := TOraXML.Create();
    RetDoc.OCISvcCtx := OdacForm.OraSession.OCISvcCtx;
    XSLDoc := TOraXML.Create();
    XSLDoc.OCISvcCtx := OdacForm.OraSession.OCISvcCtx;
    try
      with TOraXMLField(FieldByName('XMLField')).AsXML do begin
        XSLDoc.AsString:=
          '<?xml version=''1.0''?> '#$A +
          '<xsl:stylesheet version="1.0" '#$A +
          '      xmlns:xsl="http://www.w3.org/1999/XSL/Transform"> '#$A +
          '   <xsl:output method="html"/> '#$A +
          '   <xsl:template match="/"> '#$A +
          '      <html>    '#$A +
          '         <head> '#$A +
          '            <title><xsl:value-of select="//Company"/></title>'#$A +
          '         </head> '#$A +
          '         <body> '#$A +
          '            <h1><xsl:value-of select="//Company"/></h1> '#$A +
          '            <h2><xsl:value-of select="//PONum"/></h2> '#$A +
          '            <DIV> '#$A +
          '                 Item: <xsl:value-of select="//Item[1]/Part"/> '#$A +
          '            </DIV> '#$A +
          '            <DIV> '#$A +
          '                 Price: <xsl:value-of select="//Item[1]/Price"/> '#$A +
          '            </DIV> '#$A +
          '         </body> '#$A +
          '      </html> '#$A +
          '   </xsl:template> '#$A +
          '</xsl:stylesheet> ';

        Transform(XSLDoc, RetDoc);
        XMLDetailsForm.Execute('Extract', RetDoc.AsString);
      end;
    finally
      RetDoc.Free;
      XSLDoc.Free;
    end;
  end;
end;

procedure TXMLTypeFrame.btCreateClick(Sender: TObject);
begin
  scCreate.Execute;
end;

procedure TXMLTypeFrame.btDropClick(Sender: TObject);
begin
  scDrop.Execute;
end;

initialization
{$IFDEF FPC}
{$I XMLType.lrs}
{$ENDIF}

end.