Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Error being raised With COM+
Message
From
10/07/2001 11:17:59
 
 
To
10/07/2001 11:04:16
General information
Forum:
Visual FoxPro
Category:
COM/DCOM and OLE Automation
Miscellaneous
Thread ID:
00528556
Message ID:
00528647
Views:
17
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
Map
View

Click here to load this message in the networking platform