General information
Category:
COM/DCOM and OLE Automation
What happens if the data isn't found?
The component will return a empty XML dataset
Can you open the table trough the development environment?
I can open the table through the development enviroment and do a seek.
What user is the component running under?
The Administrator.
Does it have the proper rights to the data directory?
yes.
What do you mean, not really?
No Reports Just an XML String
Could it be the interaction between VB and VFP. I am calling the VFP component from VB. Enclosed is my code. Just for Kicks.
Thanks
Darren
Define Class DataAccess AS Custom OLEPUBLIC
Procedure GetCardInfo
lparameter tcXMLString
Private lcXMLString,loXML,lcLocation,loXML,lcPin,lcInst,lcTest
loXML = CreateObject("ILD_XML.XML")
lcPin = loXML.GetElementValue(tcXMLString, "Pin")
lcInst = loXML.GetElementValue(tcXMLString, "Inst")
lcTest = loXML.GetElementValue(tcXMLString, "Test")
loXML = Null
*Get My Location
lcLocation = This.GetLocation(lcTest)
*Open My Tables
This.UseTable("MstDebit",lcLocation,"MstDebit","Pin")
lcXMLString = ""
Select mstDebit
Set Exact On
If Seek(lcPin)
lcTable = "Debit" + ALLTRIM(MstDebit.dbpoint)
This.UseTable(lcTable,lcLocation,"Debit","Pin")
Select Debit
Set Exact On
If Seek(lcPin)
lcXMLString = This.CreateXMLDocumentFromTable("Debit")
lcXMLString = This.InsertIntoXMLDocumentTableRow(lcXMLString,"Debit",0)
EndIf
Select Debit
Use
EndIf
*Close My Tables
Select MstDebit
Use
Close All
loScript = Null
Return lcXMLString
EndProc
Procedure PinSearchByPin
lparameter tcXMLString
Private lcXMLString,loXML,lcLocation,lcPin,lcTest
*loMTX = CreateObject("MTXAS.APPSERVER.1")
*loContext = loMTX.GetObjectContext()
loXML = CreateObject("ILD_XML.XML")
lcPin = loXML.GetElementValue(tcXMLString, "Pin")
lcTest = loXML.GetElementValue(tcXMLString, "Test")
loXML = Null
*Get My Location
lcLocation = This.GetLocation(lcTest)
*Open My Tables
This.UseTable("MstDebit",lcLocation,"MstDebit","Pin")
lcXMLString = This.CreateXMLDocumentFromTable("MSTDebit")
Select MstDebit
Set Exact On
If Seek(lcPin)
lcXMLString = This.InsertIntoXMLDocumentTableRow(lcXMLString,"mstDebit",0)
EndIf
*Close My Tables
Select MstDebit
Use
*loContext.SetComplete
Close All
Return lcXMLString
EndProc
Procedure PinSearchByBatchSeq
lparameter tcXMLString
Private lcXMLString,loXML,lcLocation,lcBatch,lcSeq,lcTest,lcSearch
*loMTX = CreateObject("MTXAS.APPSERVER.1")
*loContext = loMTX.GetObjectContext()
loXML = CreateObject("ILD_XML.XML")
lcBatch = loXML.GetElementValue(tcXMLString, "Batch")
lcSeq = loXML.GetElementValue(tcXMLString, "Seq")
lcTest = loXML.GetElementValue(tcXMLString, "Test")
loXML = Null
*Get My Location
lcLocation = This.GetLocation(lcTest)
*Open My Tables
This.UseTable("MstDebit",lcLocation,"MstDebit","Acct")
lcXMLString = This.CreateXMLDocumentFromTable("MSTDebit")
Select MstDebit
Set Exact On
lcSearch = PADL(lcBatch,8,"0") + PADL(lcSeq,8,"0")
If Seek(lcSearch)
lcXMLString = This.InsertIntoXMLDocumentTableRow(lcXMLString,"mstDebit",0)
EndIf
*Close My Tables
Select MstDebit
Use
Close All
*loContext.SetComplete
Return lcXMLString
EndProc
Procedure GetInst
lparameter tcXMLString
Private lcXMLString,loXML,lcLocation,lcPin,lcInst,lcTest
*loMTX = CreateObject("MTXAS.APPSERVER.1")
*loContext = loMTX.GetObjectContext()
loXML = CreateObject("ILD_XML.XML")
lcPin = loXML.GetElementValue(tcXMLString, "Pin")
lcInst = loXML.GetElementValue(tcXMLString, "Inst")
lcTest = loXML.GetElementValue(tcXMLString, "Test")
loXML = Null
*Get My Location
lcLocation = This.GetLocation(lcTest)
*Open My Tables
This.UseTable("Inst",lcLocation,"Inst","Inst")
lcXMLString = This.CreateXMLDocumentFromTable("Inst")
Select Inst
Set Exact On
If Seek(lcInst)
lcXMLString = This.InsertIntoXMLDocumentTableRow(lcXMLString,"Inst",0)
EndIf
*Close My Tables
Select Inst
Use
Close All
*loContext.SetComplete
Return lcXMLString
EndProc
Procedure InsertIntoXMLDocumentTableRow
lparameter tcXMLString,tcTable,tcIndex
Private laFields,lnFieldCount,loXML,lcFieldName
lnFieldCount = AFields(laFields,tcTable)
loXML = CreateObject("ILD_XML.XML")
tcXMLString = loXML.AddChildElement(tcXMLString,"rs:data","z:row","",tcIndex)
For I = 1 to lnFieldCount
lcFieldName = tcTable + "." + laFields(I,1)
Do Case
Case laFields(I,2) = "C" &&String
tcXMLString = loXML.AddAttribute(tcXMLString,"z:row",laFields(I,1),ALLTRIM(&lcFieldName.),tcIndex)
Case laFields(I,2) = "D" &&Date
If !Empty(&lcFieldName.)
tcXMLString = loXML.AddAttribute(tcXMLString,"z:row",laFields(I,1),DTOC(&lcFieldName.),tcIndex)
EndIf
Case laFields(I,2) = "L" &&Boolean
If &lcFieldName.
tcXMLString = loXML.AddAttribute(tcXMLString,"z:row",laFields(I,1),"1",tcIndex)
Else
tcXMLString = loXML.AddAttribute(tcXMLString,"z:row",laFields(I,1),"0",tcIndex)
EndIf
Case laFields(I,2) = "M" &&Memo
tcXMLString = loXML.AddAttribute(tcXMLString,"z:row",laFields(I,1),ALLTRIM(&lcFieldName.),tcIndex)
Case laFields(I,2) = "N" &&Number
tcXMLString = loXML.AddAttribute(tcXMLString,"z:row",laFields(I,1),ALLTRIM(STR(&lcFieldName.,laFields(I,3),laFields(I,4))),tcIndex)
Case laFields(I,2) = "F" &&Float
tcXMLString = loXML.AddAttribute(tcXMLString,"z:row",laFields(I,1),laFields(I,3),laFields(I,4),tcIndex)
Case laFields(I,2) = "B" &&Double
tcXMLString = loXML.AddAttribute(tcXMLString,"z:row",laFields(I,1),laFields(I,3),laFields(I,4),tcIndex)
Case laFields(I,2) = "Y" &&Currency
tcXMLString = loXML.AddAttribute(tcXMLString,"z:row",laFields(I,1),laFields(I,3),laFields(I,4),tcIndex)
Case laFields(I,2) = "T" &&DateTime
If !Empty(&lcFieldName.)
tcXMLString = loXML.AddAttribute(tcXMLString,"z:row",laFields(I,1),DTOC(&lcFieldName.),tcIndex)
EndIf
Case laFields(I,2) = "G" &&General
tcXMLString = loXML.AddAttribute(tcXMLString,"z:row",laFields(I,1),&lcFieldName.,tcIndex)
EndCase
Next
loXML = Null
Return tcXMLString
EndProc
Procedure CreateXMLDocumentFromTable
lParameter tcTable
Private loXML
loXML = CreateObject("ILD_XML.XML")
loXMLDocument = CreateObject("MSXML2.DomDocument")
lnFields = AFields(laFields,tcTable)
lcXMLString = loXML.GetBlankXMLDocument()
lcXMLString = loXML.AddElement(lcXMLString,"s:Schema","")
lcXMLString = loXML.AddAttribute(lcXMLString,"s:Schema","id","RowsetSchema")
lcXMLString = loXML.AddChildElement(lcXMLString,"s:Schema","s:ElementType","",0)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:ElementType","name","row")
lcXMLString = loXML.AddAttribute(lcXMLString,"s:ElementType","content","eltOnly")
For I = 0 To (lnFields-1)
lcXMLString = loXML.AddChildElement(lcXMLString,"s:ElementType","s:AttributeType","")
lcXMLString = loXML.AddAttribute(lcXMLString,"s:AttributeType","name",laFields(I+1,1),I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:AttributeType","rs:number",ALLTRIM(STR(I+1)),I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:AttributeType","rs:writeunknown","true",I)
lcXMLString = loXML.AddChildElement(lcXMLString,"s:AttributeType","s:datatype","",I)
Do Case
Case laFields(I+1,2) = "C" &&String
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","dt:type","String",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:dbtype","str",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","dt:maxLength",ALLTRIM(STR(laFields(I+1,3))),I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:fixedlength","true",I)
Case laFields(I+1,2) = "D" &&Date
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","dt:type","Date",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:dbtype","Date",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","dt:maxLength","16",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:scale","3",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:precision","23",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:fixedlength","true",I)
Case laFields(I+1,2) = "L" &&Boolean
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","dt:type","boolean",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:dbtype","bool",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","dt:maxLength","1",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:fixedlength","true",I)
Case laFields(I+1,2) = "M" &&Memo
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","dt:type","String",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:dbtype","str",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","dt:maxLength",ALLTRIM(STR(laFields(I+1,3))),I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:fixedlength","false",I)
Case laFields(I+1,2) = "N" &&Number
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","dt:type","number",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:dbtype","number",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","dt:maxLength",ALLTRIM(STR(lafields(I+1,3) + 2)),I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:precision",lafields(I+1,3),I)
Case laFields(I+1,2) = "F" &&Float
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","dt:type","Float",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:dbtype","Float",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","dt:maxLength",ALLTRIM(STR(lafields(I+1,3) + 2)),I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:precision",lafields(I+1,3),I)
Case laFields(I+1,2) = "B" &&D
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","dt:type","number",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:dbtype","numb",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","dt:maxLength",ALLTRIM(STR(lafields(I+1,3) + 2)),I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:precision",lafields(I+1,3),I)
Case laFields(I+1,2) = "Y" &&Currency
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","dt:type","currency",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:dbtype","curr",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","dt:maxLength","8",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:precision","19",I)
Case laFields(I+1,2) = "T" &&DateTime
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","dt:type","DateTime",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:dbtype","DateTime",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","dt:maxLength","16",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:scale","3",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:precision","23",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:fixedlength","true",I)
Case laFields(I+1,2) = "G" &&General
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","dt:type","String",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:dbtype","str",I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","dt:maxLength",ALLTRIM(STR(laFields(I+1,3))),I)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:fixedlength","false",I)
EndCase
if laFields(I+1,5)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:maybenull","true",I)
else
IF laFields(I+1,2) = "D" or laFields(I+1,2) = "T"
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:maybenull","true",I)
Else
lcXMLString = loXML.AddAttribute(lcXMLString,"s:datatype","rs:maybenull","false",I)
EndIf
endif
Next
lcXMLString = loXML.AddChildElement(lcXMLString,"s:ElementType","s:extends","",0)
lcXMLString = loXML.AddAttribute(lcXMLString,"s:extends","type","rs:rowbase",0)
lcXMLString = loXML.AddChildElement(lcXMLString,"xml","rs:data","",0)
loXML = Null
Return lcXMLString
EndProc
Procedure GetBlankXMlDocument
Private loXML,lcXMLString
loXML = CreateObject("ILD_XML.XML")
lcXMLString = loXML.GetBlankXMLDocument()
loXML = Null
Return lcXMLString
EndProc
Procedure GetLocation
lParameter lcTesting
If Upper(lcTesting) = "TEST"
lcLocation = "c:\development\businesslogic\ildfpdataaccess\TestData\"
Else
lcLocation = "\\Warp2\p2000\"
*lcLocation = "I:\"
EndIf
Return lcLocation
EndProc
Procedure UseTable
lparameter lcTable,lcLocation,lcAlias,lcIndex
if !used(lcAlias)
USE ALLTRIM(lcLocation + lcTable) in 0 Shared Alias &lcAlias. Order &lcIndex.
EndIf
Return
EndProc
Procedure CloseTable
lParameter lcAlias
If Used(lcAlias)
Select &lcAlias.
Use
EndIf
Return
EndProc
PROCEDURE Error
LPARAMETERS nError, cMethod, nLine
private lcErrorString
*!* Trap error and return the error message to client.
lcErrorString = ALLTRIM(STR(nError)) + ': "'+MESSAGE()+'" on Line ' ;
+ALLTRIM(STR(nline))
loScript = CreateObject("WScript.Shell")
loScript.LogEvent(1,lcErrorString)
loScript = Null
Close All
ComReturnError(cMethod,lcErrorString)
Return
EndProc
EndDefine
Previous
Next
Reply
View the map of this thread
View the map of this thread starting from this message only
View all messages of this thread
View all messages of this thread starting from this message only