Title: SQLXML in Delphi
Question: There is not much about SQLXML and Delphi around on the net.(This one is the only good one I've found) Specially when it comes to the usage of SQLXML over HTTP. That's why I started putting some procedures and functions together for my own use during different projects. Here is a sample of those procedures and functions for those who want to have SQLXML working with Delphi over the Internet.
Answer:
unit XMLSamples;
interface
uses DB, ADODB;
type
TPXDataAccessMode = (pxdaHTTP, pxdaADO, pxdaIndy);
// ExecuteQuery
{
Executes a sQuery on the SQLXML server.
ForType:
ForType is FOR XML AUTO by default but any other valid FOR XML values can be used
ForType should be '' (null) if the query is a non-select one (ie. Delete, update, insert...)
RootTag:
Is the XML root tag. ROOT by default
}
function ExecuteQuery(sQuery : string; ForType : string = 'FOR XML AUTO'; RootTag : string = 'ROOT') : string;
// GetXPathString
{
Returns the value of attribute or node addressed by XPath within XMLBody
Refer to XPATH language references for more information
}
function GetXPathString(XMLBody: WideString; XPath : string) : string;
// XMLToStrings
{
Converts a XML recordset to a StringList like string.
Only the Attribute of XPath node will be included in
the result string.
Example:
Result of
XMLToStrings(XMLBody,'/ENV1/TAG1','Name')
is
Khash
Bob
Paul
XPath can contain any XPATH query.
Refer to XPATH references for more information
}
function XMLToStrings(XMLBody : WideString; XPath, Attribute : string) : string;
function CountNodes(XMLString, XPath : WideString) : Integer;
// ApplyXSL
{
Applies a XSL onto an XML
}
function ApplyXSL(XMLBody, XSLBody : string) : string;
// MeregXML
{
Merges two XML files.
Envelope will be added as a set of nodes at the end of XMLString within its root node
Example:
XMLString:
Envelope:
Result:
Envelope can contain unlimited number of nested envelopes
}
function MergeXML(XMLString, Envelope : string) : string;
// XPathExists
{
Checks if XPath exists in XMLBody
}
function XPathExists(XMLBody, XPath : string) : Boolean;
// GetAddress
{
Converts a post code to a TPXAddress using PAF system
}
var
pxDataAccess : TPXDataAccessMode = pxdaHTTP; // HTTP is the default mode
implementation
uses Classes, SysUtils, ComObj, MSXML2_TLB, WebErrors, pxConstants, Postcode,
pgPCode, ADODB_TLB, Variants, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP;
function ExecuteQueryHTTP(sQuery, ForType, RootTag : string) : string;
var
Http_Obj : MSXML2_TLB.TXMLHTTP;
begin
sQuery := sQuery + ' ' + ForType;
Http_Obj:=TXMLHTTP.Create(nil);
try
try
if (Trim(SQLXMLUser) = '') and (Trim(SQLXMLPassword) = '') then
Http_Obj.Open('POST', SQLXMLServer, false)
else
Http_Obj.Open('POST', SQLXMLServer, false, SQLXMLUser, SQLXMLPassword);
Http_Obj.Send('sql=' + sQuery + '&ROOT=' + RootTag);
Result:=Http_Obj.responseText;
except
Result:='';
end;
finally
Http_Obj.Free;
end;
end;
function ExecuteQueryHTTP_Indy(sQuery, ForType, RootTag : string) : string;
var
St : TStringList;
begin
sQuery := sQuery + ' ' + ForType;
with TIdHTTP.Create(nil) do
try
try
Request.Username:=SQLXMLUser;
Request.Password:=SQLXMLPassword;
St:=TStringList.Create;
try
St.Text:='sql=' + sQuery + '&ROOT=' + RootTag;
Result:=Post(SQLXMLServer,St);
finally
St.Free;
end;
except
Result:='';
end;
finally
Free;
end;
end;
function ExecuteQueryADO(sQuery, ForType, RootTag : string) : string;
var
Connection : ADODB_TLB.TConnection;
Command : ADODB_TLB.TCommand;
Stream : ADODB_TLB.TStream;
Records,Params : OleVariant;
begin
sQuery := sQuery + ' ' + ForType;
Connection := ADODB_TLB.TConnection.Create(nil);
try
Connection.ConnectionString:=ADOConnection;
Connection.Open(ADOConnection,'','',0);
Command := ADODB_TLB.TCommand.Create(nil);
try
Command.DefaultInterface.Set_ActiveConnection(Connection.DefaultInterface);
Command.DefaultInterface.CommandType := adCmdText;
Command.DefaultInterface.CommandText := sQuery;
Stream := ADODB_TLB.TStream.Create(nil);
try
Stream.Open(EmptyParam,adModeUnknown,adOpenStreamUnspecified,'','');
Command.DefaultInterface.Properties.Item['Output Stream'].Value := Stream.DefaultInterface;
Params := EmptyParam;
Records := Unassigned;
Command.DefaultInterface.Execute(Records,Params,adExecuteStream);
Result := '' + Stream.ReadText(Integer(adReadAll)) + ' finally
Stream.Free;
end;
finally
Command.Free;
end;
finally
Connection.Free;
end;
end;
function XPathExists;
var
XML : IXMLDOMDocument;
begin
XML := CreateOleObject('Microsoft.XMLDOM') as IXMLDomDocument;
XML.async:=False;
XML.loadXML(XMLBody);
if (XML.parseError.errorCode 0) then
Result:=False
else
try
XML.SelectSingleNode(XPath).nodeTypedValue;
Result:=True;
except
Result:=False;
end;
end;
function GetXPathString;
var
XML : IXMLDOMDocument;
MyErr : IXMLDOMParseError;
begin
XML := CreateOleObject('Microsoft.XMLDOM') as IXMLDomDocument;
XML.async:=False;
XML.loadXML(XMLBody);
if (XML.parseError.errorCode 0) then
begin
myErr := xml.parseError;
Result:=myErr.reason;
end
else
try
Result:=XML.SelectSingleNode(XPath).nodeTypedValue;
except
Result:=WebError(werXPathString);
end;
end;
function XMLToStrings;
var
XML : IXMLDOMDocument;
Nodes : IXMLDOMNodeList;
i : Integer;
St : TStringList;
begin
Result:='';
XML:=CreateOleObject('Microsoft.XMLDOM') as IXMLDOMDocument;
XML.async:=False;
XML.loadXML(XMLBody);
Nodes:=XML.selectNodes(XPath);
St:=TStringList.Create;
try
for i:=0 to Nodes.length - 1 do
St.Add(Nodes.item[i].attributes.getNamedItem(Attribute).text);
Result:=St.Text;
finally
St.Free;
end;
end;
function ApplyXSL(XMLBody, XSLBody : string) : string;
var
XSL,
XML : IXMLDOMDocument;
begin
XSL:=CreateOleObject('Microsoft.XMLDOM') as IXMLDOMDocument;
XSL.async:=False;
XSL.loadXML(XSLBody);
XML:=CreateOleObject('Microsoft.XMLDOM') as IXMLDOMDocument;
XML.async:=False;
XML.loadXML(XMLBody);
Result:=XML.transformNode(XSL);
end;
function MergeXML(XMLString, Envelope : string) : string;
var
XML : IXMLDOMDocument;
s : string;
p : Integer;
begin
XML:=CreateOleObject('Microsoft.XMLDOM') as IXMLDOMDocument;
XML.async:=False;
XML.loadXML(XMLString);
s:=XML.documentElement.tagName;
p:=Pos(' if p 0 then
Insert(Envelope,XMLString,p);
Result:=XMLString;
end;
function CountNodes(XMLString, XPath : WideString) : Integer;
var
XML : IXMLDOMDocument;
Nodes : IXMLDOMNodeList;
begin
XML:=CreateOleObject('Microsoft.XMLDOM') as IXMLDOMDocument;
XML.async:=False;
XML.loadXML(XMLString);
try
Nodes:=XML.selectNodes(XPath);
Result:=Nodes.length;
except
Result:=0;
end;
end;
function ExecuteQuery;
begin
sQuery:=StringReplace(sQuery,'/q',#39,[rfReplaceAll,rfIgnoreCase]);
sQuery:=StringReplace(sQuery,'/p','+',[rfReplaceAll,rfIgnoreCase]);
sQuery:=StringReplace(sQuery,'/m','-',[rfReplaceAll,rfIgnoreCase]);
case pxDataAccess of
pxdaHTTP: Result:=ExecuteQueryHTTP(sQuery,ForType,RootTag);
pxdaADO : Result:=ExecuteQueryADO(sQuery,ForType,RootTag);
pxdaIndy: Result:=ExecuteQueryHTTP_Indy(sQuery,ForType,RootTag);
end;
end;
end.