Having recently commented on addition to embedded arrays in another thread, I did bring out the possibility for those to replicate earlier MsdataShape Provider structures [built from scratch]. For updates:
- Microsoft has supposedly deprecated MsShape in favor of XML
- But [on at least my old Win10 laptop, it still exists in registry
Anyway... this works in PS and creates the output XML (even though the docs say it only should output to binary)
$file = "c:\temp\shape.xml"
If (test-path $file) {Remove-Item $file}
$conn = new-object -comObject ADODB.connection
$rs = new-Object -comObject ADODB.Recordset
$conn.Open("Provider=MSDataShape.1;Data Provider=NONE;")
$strShape = @"
SHAPE APPEND NEW adInteger AS CustID,
NEW adChar(25) AS FirstName,
NEW adChar(25) AS LastName,
NEW adChar(12) AS SSN,
NEW adChar(50) AS Address,
((SHAPE APPEND NEW adChar(80) AS VIN_NO,
NEW adInteger AS CustID,
NEW adChar(20) AS BodyColor,
((SHAPE APPEND NEW adChar(80) AS VIN_NO,
NEW adChar(20) AS Make,
NEW adChar(20) AS Model,
NEW adChar(4) AS Year)
AS VINS RELATE VIN_NO TO VIN_NO))
AS Vehicles RELATE CustID TO CustID)
"@
$rs.Open($strShape, $conn, 1, 3, -1 )
$rs.Save($file,1)
$rs.Close()
$rs=$null
Exit
and fails in WB with similar syntax
file = "c:\temp\shape.xml"
If FileExist(file) Then FileDelete(file)
conn = CreateObject("ADODB.Connection")
rs = CreateObject("ADODB.Recordset")
conn.Open "Provider=MSDataShape.1;Data Provider=NONE;"
strShape = $"
SHAPE APPEND NEW adInteger AS CustID,
NEW adChar(25) AS FirstName,
NEW adChar(25) AS LastName,
NEW adChar(12) AS SSN,
NEW adChar(50) AS Address,
((SHAPE APPEND NEW adChar(80) AS VIN_NO,
NEW adInteger AS CustID,
NEW adChar(20) AS BodyColor,
((SHAPE APPEND NEW adChar(80) AS VIN_NO,
NEW adChar(20) AS Make,
NEW adChar(20) AS Model,
NEW adChar(4) AS Year)
AS VINS RELATE VIN_NO TO VIN_NO))
AS Vehicles RELATE CustID TO CustID)
$"
rs.Open(strShape, conn, 1, 3, -1 )
rs.Save(file,1)
rs.Close()
rs=0
Exit
My intention was to create a structure with MsDataShape that might be replicated with embedded arrays, but would appreciate the failure in WB for something simply done in PS.
I don't know but this works for me:
file = "c:\temp\shape.xml"
If FileExist(file) Then FileDelete(file)
conn = CreateObject("ADODB.Connection")
rs = CreateObject("ADODB.Recordset")
conn.Open("Provider=MSDataShape.1;Data Provider=NONE;")
Yep, forgot the ( )... Now to get on with my intention.
Should mention that the multiple bracket syntax, i.e., mysa[0][0] does not work on safearrays. It is a bit of a knotty problem that will take so doing to figure out but it should work in the next release.
Quote from: td on September 24, 2024, 02:32:59 PMShould mention that the multiple bracket syntax, i.e., mysa
- does not work on safearrays. It is a bit of a knotty problem that will take so doing to figure out but it should work in the next release.
I'm sure all will be fine. ITMT:
- Hope viewers will see how easy it is to align PS<>WB for data processing
- Below I attached tested code from creating a shaped hierarchical recordset
I plan to play around with embedded arrays/maps to see if a structure can be created - i.e. where for an array of a customer there is a sub-array for payments [based on script] NOTE: should work with versions of WB prior to 2024.
;WB 2024B - Hierarchical Shaped Recordset
;Created in memory, stored as Binary adtg
;Simple parent-Child relationship
;===================================================================================================
IntControl(73,1,0,0,0)
file = "c:\temp\shape.adtg"
txt = "c:\temp\shape.txt"
;delete test files if they exist
If FileExist(file) Then FileDelete(file)
If FileExist(txt) Then FileDelete(file)
;create objects
conn = CreateObject("ADODB.Connection")
rs = CreateObject("ADODB.Recordset")
rs1 = CreateObject("ADODB.Recordset")
conn.Open("Provider=MSDataShape.1;Data Provider=NONE;")
;create SQL for shape, child relationship for payments from parent CustID
strShape = $"SHAPE APPEND NEW adInteger AS CustID,
NEW adChar(25) AS FirstName, NEW adChar(25) AS LastName,
NEW adChar(12) AS SSN, NEW adChar(50) AS Address,
((SHAPE APPEND NEW adInteger AS CustID,
NEW adChar(3) AS Month, NEW adInteger AS Payment)
AS Payments RELATE CustID TO CustID)
$"
;open recordset object
rs.Open(strShape, conn, 1, 3, -1 )
rs.addnew()
rs.Collect("CustID") = 2024
rs.Collect("FirstName") = "Bob"
rs.Collect("LastName") = "Cratchett"
rs.Collect("SSN") = "999-99-9999"
rs.Collect("Address") = "Tacoma, Washington"
;2nd Recordset Object creates child 'payments'
rs1 = rs.Collect("Payments")
rs1.AddNew()
rs1.Collect("CustID") = 2024
rs1.Collect("Month") = "JAN"
rs1.Collect("Payment") = 350
rs1.AddNew()
rs1.Collect("CustID") = 2024
rs1.Collect("Month") = "FEB"
rs1.Collect("Payment") = 200
rs1.Update()
rs1.Close()
rs1=0
rs.Update()
;persist the file as adtg, cannot be persisted as XML
rs.Save(file,0)
rs.Close()
rs=0
conn.Close()
conn=0
If FileExist(file) Then Display(2,"XML Created",file)
;re-open connection/recordsets as MsPersist
conn = CreateObject("ADODB.Connection")
rs = CreateObject("ADODB.Recordset")
rs1 = CreateObject("ADODB.Recordset")
conn.Open("Provider=MsPersist")
rs.Open(file, conn, 1, 3, -1 )
; add yet another child record for March
f = rs.Collect("CustID")
If f == 2024
rs1 = rs.Collect("Payments")
rs1.AddNew()
rs1.Collect("CustID") = 2024
rs1.Collect("Month") = "MAR"
rs1.Collect("Payment") = 75
Endif
rs.Update()
rs.MoveFirst()
;create text output from recordset
cOutput = FileOpen(txt,"WRITE")
FileWrite(cOutput,"Parent/Child Data Output from %txt%")
FileWrite(cOutput,"==================================================")
While ! rs.EOF()
parval = Strtrim(rs.Collect("FirstName")) :" " :Strtrim(rs.Collect("LastName")) :", ":Strtrim(rs.Collect("Address"))
var = "Customer: " :StrTrim(parval):@CRLF:"[PAYMENTS]":@CRLF
rs1 = rs.Collect("Payments")
While ! rs1.EOF()
childval = rs1.Collect("Month")
var = strcat( var," ",childval)
childval = rs1.Collect("Payment")
var = strcat( var," ",childval,@CRLF)
rs1.MoveNext()
EndWhile
FileWrite(cOutput,var)
rs.MoveNext()
EndWhile
;close all objects
rs1.Close()
rs.Close()
rs1=0
rs=0
conn.Close()
conn=0
;display results if text output created
If FileExist(txt) Then Message("XML Output",var)
Exit
;===================================================================================================
:WBERRORHANDLER
rs=0
rs1=0
con0
wberroradditionalinfo = wberrorarray[6]
lasterr = wberrorarray[0]
handlerline = wberrorarray[1]
textstring = wberrorarray[5]
linenumber = wberrorarray[8]
errmsg = "Error: ":lasterr:@LF:textstring:@LF:"Line (":linenumber:")":@LF:wberroradditionalinfo
Message("Error",errmsg)
Exit
;===================================================================================================
... as it turns out shaped recordset can be persisted as xml. Rather than directly saving the shaped data to a file, which must be adtg binary format, you can save to an in-memory DOMDocument, then persist to file. The example below creates 2 CustId's with associated payments and displays results as xml keeping the parent-child relationship.
;WB 2024B - Hierarchical Shaped Recordset
; should work with earlier versions of WB
;Created in memory, saved to DOMDocument as XML
;Simple parent-Child relationship
;Stan Littlefield 9/26/2024
;===================================================================================================
IntControl(73,1,0,0,0)
conn = CreateObject("ADODB.Connection")
rs = CreateObject("ADODB.Recordset")
rs1 = CreateObject("ADODB.Recordset")
XMLObj = CreateObject("MSXML2.DOMDocument")
conn.Open("Provider=MSDataShape.1;Data Provider=NONE;")
strShape = $"SHAPE APPEND NEW adInteger AS CustID,
NEW adChar(25) AS FirstName, NEW adChar(25) AS LastName,
NEW adChar(12) AS SSN, NEW adChar(50) AS Address,
((SHAPE APPEND NEW adInteger AS CustID,
NEW adChar(3) AS Month, NEW adInteger AS Payment)
AS Payments RELATE CustID TO CustID)
$"
rs.Open(strShape,conn,1,3,-1)
rs.addnew()
rs.Collect("CustID") = 2024
rs.Collect("FirstName") = "Bob"
rs.Collect("LastName") = "Cratchett"
rs.Collect("SSN") = "999-99-9999"
rs.Collect("Address") = "Tacoma, Washington"
;2nd Recordset Object creates child 'payments'
rs1 = rs.Collect("Payments")
rs1.AddNew()
rs1.Collect("CustID") = 2024
rs1.Collect("Month") = "JAN"
rs1.Collect("Payment") = 350
rs1.AddNew()
rs1.Collect("CustID") = 2024
rs1.Collect("Month") = "FEB"
rs1.Collect("Payment") = 200
rs1.Update()
rs.Update()
rs.addnew()
rs.Collect("CustID") = 2025
rs.Collect("FirstName") = "George"
rs.Collect("LastName") = "Santos"
rs.Collect("SSN") = "999-90-4119"
rs.Collect("Address") = "Syracuse, New York"
;2nd Recordset Object creates child 'payments'
rs1 = rs.Collect("Payments")
rs1.AddNew()
rs1.Collect("CustID") = 2025
rs1.Collect("Month") = "JAN"
rs1.Collect("Payment") = 4000
rs1.AddNew()
rs1.Collect("CustID") = 2025
rs1.Collect("Month") = "FEB"
rs1.Collect("Payment") = 1864.50
rs1.Update()
rs.Update()
rs.Save(XMLObj,1)
rs1.close()
rs1=0
rs.close()
rs = 0
conn.close()
conn = 0
Message("xml",XMLObj.XML)
Exit
;===================================================================================================
:WBERRORHANDLER
rs=0
rs1=0
conn=0
wberroradditionalinfo = wberrorarray[6]
lasterr = wberrorarray[0]
handlerline = wberrorarray[1]
textstring = wberrorarray[5]
linenumber = wberrorarray[8]
errmsg = "Error: ":lasterr:@LF:textstring:@LF:"Line (":linenumber:")":@LF:wberroradditionalinfo
Message("Error",errmsg)
Exit
;===================================================================================================