main.pas

ODAC 5.7.0.28

unit Main;

interface

uses
{$IFDEF LINUX}
  SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs, QStdCtrls,
  QDBCtrls, QComCtrls, QExtCtrls, QGrids, QDBGrids, OdacClx,
{$ELSE}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DBCtrls, ExtCtrls, Grids, DBGrids, StdCtrls, ToolWin, ComCtrls, OdacVcl,
{$ENDIF}
  Db, Ora, DBAccess, OraScript, MemDS, OraSmart;

type
  TfmMain = class(TForm)
    ToolBar1: TPanel;
    btOpen: TButton;
    btClose: TButton;
    DBNavigator1: TDBNavigator;
    btCreate: TButton;
    btDrop: TButton;
    DBGrid: TDBGrid;
    dsData: TDataSource;
    Query: TSmartQuery;
    OraSession: TOraSession;
    ConnectDialog1: TConnectDialog;
    scCreate: TOraScript;
    scDrop: TOraScript;
    Panel: TPanel;
    cbDebug: TCheckBox;
    btShowCountry: TButton;
    btAddRecord: TButton;
    OraSQL: TOraSQL;
    RadioButton2: TRadioButton;
    RadioButton1: TRadioButton;
    DBMemo1: TDBMemo;
    Button1: TButton;
    Button2: TButton;
    procedure btCreateClick(Sender: TObject);
    procedure btDropClick(Sender: TObject);
    procedure btOpenClick(Sender: TObject);
    procedure btCloseClick(Sender: TObject);
    procedure cbDebugClick(Sender: TObject);
    procedure btShowCountryClick(Sender: TObject);
    procedure btAddRecordClick(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fmMain: TfmMain;

implementation
uses
  OraCall, OraClasses, OraObjects, Details;

{$R *.dfm}

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

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

procedure TfmMain.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 TfmMain.btCloseClick(Sender: TObject);
begin
  Query.Close;
end;

procedure TfmMain.cbDebugClick(Sender: TObject);
begin
  Query.Debug := cbDebug.Checked;
  OraSQL.Debug := cbDebug.Checked;
  scCreate.Debug := cbDebug.Checked;
  scDrop.Debug := cbDebug.Checked;
end;

procedure TfmMain.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 := OraSession.OCISvcCtx;
      try
        GetSchema(RetDoc, SchemaURL, RootElem);
        FmDetails.Execute('Schema', RetDoc.AsString);
      finally
        RetDoc.Free;
      end;
    end;
  end;
end;

procedure TfmMain.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 := 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 := 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 TfmMain.RadioButton1Click(Sender: TObject);
begin
  Query.Close;
end;

procedure TfmMain.Button1Click(Sender: TObject);
var
  RetDoc: TOraXML;
begin
  with Query do begin
    RetDoc := TOraXML.Create();
    RetDoc.OCISvcCtx := 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!');
        FmDetails.Execute('Extract', RetDoc.AsString);
      end;
    finally
      RetDoc.Free;
    end;
  end;
end;

procedure TfmMain.Button2Click(Sender: TObject);
var
  RetDoc, XSLDoc: TOraXML;
begin
  with Query do begin
    RetDoc := TOraXML.Create();
    RetDoc.OCISvcCtx := OraSession.OCISvcCtx;
    XSLDoc := TOraXML.Create();
    XSLDoc.OCISvcCtx := 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);
        FmDetails.Execute('Extract', RetDoc.AsString);
      end;
    finally
      RetDoc.Free;
      XSLDoc.Free;
    end;
  end;
end;

initialization
  OraCall.OCIThreaded := False;
end.