On 29.10.2010 11:14, FNProgramvare wrote: > Example code: > > <xsl:stylesheet version="1.0" > xmlns:xsl="http://www.w3.org/1999/XSL/Transform";> > <xsl:template match="/"> > <html> > <head> > </head> > <body> > <xsl:text>This text is output</xsl:text> > <xsl:variable name="subTotals"> > <xsl:for-each select="$invoices/invoice/item"> > </xsl:for-each> > </xsl:variable> > <xsl:text>This text is not output</xsl:text> > </body> > </html> > </xsl:template> > </xsl:stylesheet> > > I have set up an error handler with xmlSetStructuredErrorFunc. However, > it is not getting called. The xmlSetStructuredErrorFunc() error handler is somewhat limited. In particular, it is not invoked for XSLT errors. The advantage for Delphi users is that xmlSetStructuredErrorFunc reports "structured" error messages which are easy to process. Other error handlers apply C printf error messages instead, which are not natively supported by Delphi. > If I use the xsltproc command line utility, I get this error data: > > runtime error: file test.xsl line 12 element for-each > Variable 'invoices' has not been declared. > xmlXPathCompiledEval: evaluation failed > runtime error: file test.xsl line 12 element for-each > Failed to evaluate the 'select' expression. > > How can I display the same error data using DIXml? The xsltproc command line utility writes errors to the C stdout / stderr streams which are not available in Delphi. Fortunately, DIXml supports a "generic" error handler in addition to the "structured" one mentioned above. There are two separate generic error handlers, one for XML and another for XSLT errors: * xmlSetGenericErrorFunc() * xsltSetGenericErrorFunc() The error data you are seeing with xsltproc is reported throuth the xsltSetGenericErrorFunc() handler. Both the XML and the XSLT handlers pass their error messages in C printf style to a CEDECL VARARGS function. Delphi supports VARARGS for external functions only, but a workaround is available. I have modified DIXml_XSLT_Browser_fMain.pas to use the generic error handlers and added a very simple sprintf() Delphi port to format the actual error messages (attached). Using this updated version, DIXml_XSLT_Browser outputs the same error messages as xsltproc. Ralf
{ DIXml Demo to perform XSL transformation. Visit the DIXml Internet site for latest information and updates: http://www.yunqa.de/delphi/ Copyright (c) 2007-2010 Ralf Junker, The Delphi Inspiration <delphi@xxxxxxxx> ------------------------------------------------------------------------------ } unit DIXml_XSLT_Browser_fMain; {.$DEFINE Debug}// Default: Off {$I DI.inc} { Suppress some Delphi Unicode string conversion warnings. } {$IFDEF COMPILER_12_UP} {$WARN IMPLICIT_STRING_CAST OFF} {$WARN IMPLICIT_STRING_CAST_LOSS OFF} {$WARN EXPLICIT_STRING_CAST OFF} {$WARN EXPLICIT_STRING_CAST_LOSS OFF} {$ENDIF COMPILER_12_UP} interface uses DISystemCompat, SysUtils, Classes, Forms, Controls, ComCtrls, StdCtrls, ExtCtrls, FileCtrl, OleCtrls, {$IFDEF COMPILER_5} SHDocVw {$ELSE} {$IFDEF COMPILER_10_UP}SHDocVw{$ELSE}ShDocVw_TLB{$ENDIF} {$ENDIF}; type TfrmXsltBrowser = class(TForm) Panel1: TPanel; Splitter1: TSplitter; pnlBottom: TPanel; btnShow: TButton; Splitter2: TSplitter; Splitter3: TSplitter; pnlDir: TPanel; pnlDirCaption: TPanel; pnlXsl: TPanel; flbXsl: TFileListBox; pnlXslCaption: TPanel; pnlXml: TPanel; flbXml: TFileListBox; pnlXmlCaption: TPanel; DirectoryListBox: TDirectoryListBox; PageControl: TPageControl; tsTransformation: TTabSheet; WebBrowser: TWebBrowser; tsXmlSource: TTabSheet; tsXslSource: TTabSheet; memoXmlSource: TMemo; memoXslSource: TMemo; tsErrors: TTabSheet; memoErrors: TMemo; tsTransformationSource: TTabSheet; memoTransformationSource: TMemo; pnlXmlCharSet: TPanel; cboXmlEncoding: TComboBox; pnlXslCharSet: TPanel; cboXslEncoding: TComboBox; Panel2: TPanel; cboDrive: TDriveComboBox; procedure ctrlExecute(Sender: TObject); procedure DirectoryListBoxChange(Sender: TObject); procedure flbChange(Sender: TObject); procedure FormCreate(Sender: TObject); private FTransforming: Boolean; procedure DoTransform; end; var frmXsltBrowser: TfrmXsltBrowser; const APP_TITLE = 'DIXml Demo: XSLT Browser'; implementation uses Windows, DIXml; {$R *.dfm} procedure AddEncodings(const s: TStrings); const Encodings: array[0..20] of string = ('UTF-8', 'UTF-16', 'UTF-16LE', 'UTF-16BE', 'ASCII', 'HTML', 'ISO-8859-1', 'ISO-8859-2', 'ISO-8859-3', 'ISO-8859-4', 'ISO-8859-5', 'ISO-8859-6', 'ISO-8859-7', 'ISO-8859-8', 'ISO-8859-9', 'ISO-8859-10', 'ISO-8859-11', 'ISO-8859-13', 'ISO-8859-14', 'ISO-8859-15', 'ISO-8859-16'); var i: Integer; begin for i := Low(Encodings) to High(Encodings) do s.Add(Encodings[i]); end; //------------------------------------------------------------------------------ procedure TfrmXsltBrowser.FormCreate(Sender: TObject); begin Caption := APP_TITLE; DirectoryListBox.Directory := ExtractFilePath(ParamStr(0)); AddEncodings(cboXmlEncoding.Items); cboXmlEncoding.ItemIndex := 0; AddEncodings(cboXslEncoding.Items); cboXslEncoding.ItemIndex := 0; WebBrowser.Navigate('about:blank'); {$IFDEF Debug} flbXml.ItemIndex := flbXml.Items.IndexOf('test.xml'); flbXsl.ItemIndex := flbXsl.Items.IndexOf('test.xsl'); DoTransform; {$ENDIF Debug} end; //------------------------------------------------------------------------------ { A simple sprintf port from C to Pascal. Supports the the most frequently used format specifiers only. Please extend as necessary. Returns the number of characters written to Buffer. Buffer must be large enough to hold all output. If the output size is unknown, pass Buffer as nil to return the number of character in Buffer required to hold all output. } function sprintf(Buffer: PAnsiChar; const Format: PAnsiChar; Args: Pointer): Integer; var o: PAnsiChar; // Output buffer { Write a single character. Convert single line breaks to CRLF. } procedure Append(const c: AnsiChar); overload; begin if c = #10 then begin if Assigned(Buffer) then o^ := #13; Inc(o); if Assigned(Buffer) then o^ := #10; Inc(o); end else begin if Assigned(Buffer) then o^ := c; Inc(o); end; end; { Write a null-terminated string. } procedure Append(p: PAnsiChar); overload; begin while p^ <> #0 do begin Append(p^); Inc(p); end; end; { Write an AnsiString. } procedure Append(const s: AnsiString); overload; const AC_ZERO: AnsiChar = '0'; var i, l: Integer; begin l := Length(s); for i := 1 to l do Append(s[i]); end; label lblLiteralChar; var a: PAnsiChar; // Args f: PAnsiChar; // Format string t: PAnsiChar; // Temp begin f := Format; a := Args; o := Buffer; while f^ <> #0 do if f^ = '%' then // Format specifier should follow. begin Inc(f); case f^ of // Conversion-Type Characters // Numerics 'd', 'i': // Signed decimal integer. begin Append(IntToStr(PInteger(a)^)); Inc(a, SizeOf(Integer)); Inc(f); end; 'g': // Signed floating point value in either e or f form. begin Append(FloatToStr(PSingle(a)^)); Inc(a, SizeOf(Single)); Inc(f); end; 'u': // Unsigned decimal integer. begin Append(IntToStr(PCardinal(a)^)); Inc(a, SizeOf(Cardinal)); Inc(f); end; 'x': // Unsigned hexadecimal integer. begin Append(IntToHex(PCardinal(a)^, 8)); Inc(a, SizeOf(Cardinal)); Inc(f); end; // Characters '%': // Prints the '%' character. goto lblLiteralChar; 's': // String pointer. Prints characters until null-terminator. begin t := PPAnsiChar(a)^; Inc(a, SizeOf(PAnsiChar)); Append(t); Inc(f); end; else raise Exception.Create('Unsupported Format Specifier'); end; end else begin lblLiteralChar: Append(f^); Inc(f); end; if Assigned(Buffer) then o^ := #0; Result := o - Buffer; end; //------------------------------------------------------------------------------ procedure OnGenericErrorFunc(UserData: Pointer; const Msg: PAnsiChar); cdecl; var Args: PAnsiChar; l: Integer; s: AnsiString; begin { Print message into buffer. Format arguments are passed as cdecl varargs, so we have to apply a Delphi little magic to retrieve them. } Args := Pointer(@Msg); Inc(Args, SizeOf(Msg)); l := sprintf(nil, Msg, Args); SetString(s, nil, l); l := sprintf(Pointer(s), Msg, Args); { Trim trailing line breaks. } while (l > 0) and (s[l] in [#10, #13]) do Dec(l); SetLength(s, l); { Output final error message. } frmXsltBrowser.memoErrors.Lines.Add(s); end; //------------------------------------------------------------------------------ procedure TfrmXsltBrowser.DoTransform; var XmlFile, XmlEncoding: string; XmlFile8, XmlEncoding8: Utf8String; XslFile, XslEncoding: string; XslFile8, XslEncoding8: Utf8String; ResultFile: string; resultfile8: Utf8String; OldCursor: TCursor; TC: xsltTransformContextPtr; XmlDoc, XslDoc, ResultDoc: xmlDocPtr; XslStyle: xsltStyleSheetPtr; begin if not FTransforming and (flbXml.ItemIndex >= 0) and (flbXsl.ItemIndex >= 0) then begin FTransforming := True; btnShow.Enabled := False; OldCursor := Screen.Cursor; Screen.Cursor := crHourGlass; memoErrors.Lines.BeginUpdate; try memoErrors.Lines.Clear; XmlFile := flbXml.FileName; XmlEncoding := cboXmlEncoding.Text; memoXmlSource.Lines.LoadFromFile(XmlFile); XslFile := flbXsl.FileName; XslEncoding := cboXslEncoding.Text; memoXslSource.Lines.LoadFromFile(XslFile); ResultFile := ChangeFileExt(XmlFile, '.htm'); SysUtils.DeleteFile(ResultFile); { Report XML and XSLT errors to the same callback function. } xmlSetGenericErrorFunc(nil, OnGenericErrorFunc); xsltSetGenericErrorFunc(nil, OnGenericErrorFunc); { Set some options. } xmlSubstituteEntitiesDefault(1); { Load the XML document. } XmlFile8 := Utf8Encode(XmlFile); XmlEncoding8 := Utf8Encode(XmlEncoding); XmlDoc := xmlReadFile(PAnsiChar(XmlFile8), PAnsiChar(XmlEncoding8), 0); if Assigned(XmlDoc) then try xmlXIncludeProcessFlags(XmlDoc, XSLT_PARSE_OPTIONS); { Load the style sheet as an XML document. } XslFile8 := Utf8Encode(XslFile); XslEncoding8 := Utf8Encode(XslEncoding); XslDoc := xmlReadFile(PAnsiChar(XslFile8), PAnsiChar(XslEncoding8), 0); if Assigned(XslDoc) then begin xmlXIncludeProcessFlags(XslDoc, XSLT_PARSE_OPTIONS); { Convert the XML style sheet to a style structure. If this is successfull, the XslStyle result takes ownership off XslDoc. } XslStyle := xsltParseStylesheetDoc(XslDoc); if Assigned(XslStyle) then try { Create the transformation context. } TC := xsltNewTransformContext(XslStyle, XmlDoc); try xsltSetCtxtParseOptions(TC, XML_PARSE_PEDANTIC); { Now the actual transformation. } ResultDoc := xsltApplyStylesheetUser(XslStyle, XmlDoc, nil, nil, nil, TC); if Assigned(ResultDoc) then try resultfile8 := Utf8Encode(ResultFile); xsltSaveResultToFileName(PAnsiChar(resultfile8), ResultDoc, XslStyle, 0); finally xmlFreeDoc(ResultDoc); end; finally xsltFreeTransformContext(TC); end; finally xsltFreeStyleSheet(XslStyle); end else begin xmlFreeDoc(XslDoc); end; end; finally xmlFreeDoc(XmlDoc); end; if FileExists(ResultFile) then begin memoTransformationSource.Lines.LoadFromFile(ResultFile); WebBrowser.Navigate(ResultFile); end else begin memoTransformationSource.Text := 'Transformation failed - see Errors tab for details'; PageControl.ActivePage := tsTransformationSource; end; finally memoErrors.Lines.EndUpdate; Screen.Cursor := OldCursor; btnShow.Enabled := True; FTransforming := False; end; end; end; //------------------------------------------------------------------------------ procedure TfrmXsltBrowser.ctrlExecute(Sender: TObject); begin DoTransform; end; //------------------------------------------------------------------------------ procedure TfrmXsltBrowser.DirectoryListBoxChange(Sender: TObject); begin flbXml.Directory := DirectoryListBox.Directory; flbXsl.Directory := DirectoryListBox.Directory; flbXml.ItemIndex := 0; flbXsl.ItemIndex := 0; flbChange(nil); end; //------------------------------------------------------------------------------ procedure TfrmXsltBrowser.flbChange(Sender: TObject); begin btnShow.Enabled := not FTransforming and (flbXml.ItemIndex >= 0) and (flbXsl.ItemIndex >= 0); end; //------------------------------------------------------------------------------ initialization xmlInitParser; // Initialize the XML library. xsltInit; // Initialize the XSLT library. exsltRegisterAll; // Register all EXSLT functions. finalization xmlCleanupParser; // Clear global XML library variables. xsltCleanupGlobals; // Clear global XSLT library variables. end.