How to get an updatable ADODB Recordset from a Stored Procedure?

Question

In VB6 I have this code to get a disconnected ADODB Recordset from a Oracle 9i database (the Oracle Client is 10g):
Dim conSQL As ADODB.Connection
Dim comSQL As ADODB.Command
Dim recSQL As ADODB.Recordset
Set conSQL = New ADODB.Connection
With conSQL
.ConnectionString = "Provider=OraOLEDB.Oracle;Password=<pwd>;Persist Security Info=True;User ID=<uid>;Data Source=<dsn>"
.CursorLocation = adUseClientBatch
.Open
End With
Set comSQL = New ADODB.Command
With comSQL
.ActiveConnection = conSQL
.CommandType = adCmdStoredProc
.CommandText = "P_PARAM.GETALLPARAM"
.Properties("PLSQLRSet").Value = True
End With
Set recSQL = New ADODB.Recordset
With recSQL
Set .Source = comSQL
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockBatchOptimistic
.Open
.ActiveConnection = Nothing
End With
The PL/SQL Procedure is returning a REF CURSOR like this:
PROCEDURE GetAllParam(op_PARAMRecCur IN OUT P_PARAM.PARAMRecCur)
IS
BEGIN
OPEN op_PARAMRecCur FOR
SELECT *
FROM PARAM
ORDER BY ANNPARAM DESC;
END GetAllParam;
When I try to update some values in the ADODB Recordset (still disconnected), I get the following error:
Err.Description: Multiple-step operation generated errors. Check each status value.
Err.Number: -2147217887 (80040E21)
Err.Source: Microsoft Cursor Engine
The following properties on the Command object doesn't change anything:
.Properties("IRowsetChange") = True
.Properties("Updatability") = 7
How can I get an updatable ADODB Recordset from a Stored Procedure?

Answer 1

4 years later...
I was having then same problem.
Finally, I've found how to "touch" the requierd bits.
Obviously, it's hardcore, but since some stupid at microsoft cannot understand the use of a disconnected recordset in the real world, there is no other choice.
Reference: http://download.microsoft.com/downlo...MS-ADTG%5D.pdf
http://msdn.microsoft.com/en-us/library/cc221950.aspx
http://www.xtremevbtalk.com/showthread.php?t=165799
Solution (VB6):
<pre>
Dim Rst As Recordset
Rst.Open "select 1 as C1, '5CHARS' as C5, sysdate as C6, NVL(null,15) as C7, null as C8 from DUAL", yourconnection, adOpenKeyset, adLockBatchOptimistic
Set Rst.ActiveConnection = Nothing
Dim S As New ADODB.Stream
Rst.Save S, adPersistADTG
Rst.Close
Set Rst = Nothing
With S
'Debug.Print .Size
Dim Bytes() As Byte
Dim WordVal As Integer
Dim LongVal As Long
Bytes = .Read(2)
If Bytes(0) <> 1 Then Err.Raise 5, , "ADTG byte 0, se esperaba: 1 (header)"
.Position = 2 + Bytes(1)
Bytes = .Read(3)
If Bytes(0) <> 2 Then Err.Raise 5, , "ADTG byte 9, se esperaba: 2 (handler)"
LongVal = Bytes(1) + Bytes(2) * 256 ' handler size
.Position = .Position + LongVal
Bytes = .Read(3)
If Bytes(0) <> 3 Then Err.Raise 5, , "ADTG, se esperaba: 3 (result descriptor)"
LongVal = Bytes(1) + Bytes(2) * 256 ' result descriptor size
.Position = .Position + LongVal
Bytes = .Read(3)
If Bytes(0) <> 16 Then Err.Raise 5, , "ADTG, se esperaba: 16 (adtgRecordSetContext)"
LongVal = Bytes(1) + Bytes(2) * 256 ' token size
.Position = .Position + LongVal
Bytes = .Read(3)
If Bytes(0) <> 5 Then Err.Raise 5, , "ADTG, se esperaba: 5 (adtgTableDescriptor)"
LongVal = Bytes(1) + Bytes(2) * 256 ' token size
.Position = .Position + LongVal
Bytes = .Read(1)
If Bytes(0) <> 6 Then Err.Raise 5, , "ADTG, se esperaba: 6 (adtgTokenColumnDescriptor)"
Do ' For each Field
Bytes = .Read(2)
LongVal = Bytes(0) + Bytes(1) * 256 ' token size
Dim NextTokenPos As Long
NextTokenPos = .Position + LongVal
Dim PresenceMap As Long
Bytes = .Read(3)
PresenceMap = Val("&H" & Right$("0" & Hex$(Bytes(0)), 2) & Right$("0" & Hex$(Bytes(1)), 2) & Right$("0" & Hex$(Bytes(2)), 2))
Bytes = .Read(2) 'ColumnOrdinal
'WordVal = Val("&H" & Right$("0" & Hex$(Bytes(0)), 2) & Right$("0" & Hex$(bytes(1)), 2))
'Aca pueden venir: friendly_columnname, basetable_ordinal,basetab_column_ordinal,basetab_colname
If PresenceMap And &H800000 Then 'friendly_columnname
Bytes = .Read(2) 'Size
LongVal = Bytes(0) + Bytes(1) * 256 ' Size
.Position = .Position + LongVal * 2 '*2 debido a UNICODE
End If
If PresenceMap And &H400000 Then 'basetable_ordinal
.Position = .Position + 2 ' 2 bytes
End If
If PresenceMap And &H200000 Then 'basetab_column_ordinal
.Position = .Position + 2 ' 2 bytes
End If
If PresenceMap And &H100000 Then 'basetab_colname
Bytes = .Read(2) 'Size
LongVal = Bytes(0) + Bytes(1) * 256 ' Size
.Position = .Position + LongVal * 2 '*2 debido a UNICODE
End If
Bytes = .Read(2) 'adtgColumnDBType
'WordVal = Val("&H" & Right$("0" & Hex$(Bytes(0)), 2) & Right$("0" & Hex$(bytes(1)), 2))
Bytes = .Read(4) 'adtgColumnMaxLength
'LongVal = Val("&H" & Right$("0" & Hex$(Bytes(3)), 2) & Right$("0" & Hex$(Bytes(2)), 2) & Right$("0" & Hex$(Bytes(1)), 2) & Right$("0" & Hex$(Bytes(0)), 2))
Bytes = .Read(4) 'Precision
'LongVal = Val("&H" & Right$("0" & Hex$(Bytes(3)), 2) & Right$("0" & Hex$(Bytes(2)), 2) & Right$("0" & Hex$(Bytes(1)), 2) & Right$("0" & Hex$(Bytes(0)), 2))
Bytes = .Read(4) 'Scale
'LongVal = Val("&H" & Right$("0" & Hex$(Bytes(3)), 2) & Right$("0" & Hex$(Bytes(2)), 2) & Right$("0" & Hex$(Bytes(1)), 2) & Right$("0" & Hex$(Bytes(0)), 2))
Dim ColumnFlags() As Byte, NewFlag0 As Byte
ColumnFlags = .Read(1) 'DBCOLUMNFLAGS, First Byte only (DBCOLUMNFLAGS=4 bytes total)
NewFlag0 = ColumnFlags(0)
If (NewFlag0 And &H4) = 0 Then 'DBCOLUMNFLAGS_WRITE (bit 2) esta OFF
'Lo pongo en ON, ya que quiero escribir esta columna LOCALMENTE en el rst DESCONECTADO
NewFlag0 = (NewFlag0 Or &H4)
End If
If (NewFlag0 And &H8) <> 0 Then 'DBCOLUMNFLAGS_WRITEUNKNOWN (bit 3) esta ON
'Lo pongo en OFF, ya que no me importa si NO sabes si se puede updatear no, yo lo se, no te preocupes
'ya que quiero escribir esta columna LOCALMENTE en el rst DESCONECTADO
NewFlag0 = (NewFlag0 And Not &H8)
End If
If (NewFlag0 And &H20) <> 0 Then 'DBCOLUMNFLAGS_ISNULLABLE (bit 5) esta OFF
'Lo pongo en ON, ya que siendo un RST DESCONECTADO, si le quiero poner NULL, le pongo y listo
NewFlag0 = (NewFlag0 Or &H20)
End If
If NewFlag0 <> ColumnFlags(0) Then
ColumnFlags(0) = NewFlag0
.Position = .Position - 1
.Write ColumnFlags
End If
.Position = NextTokenPos
Bytes = .Read(1)
Loop While Bytes(0) = 6
'Reconstruyo el Rst desde el stream
S.Position = 0
Set Rst = New Recordset
Rst.Open S
End With
'TEST IT
On Error Resume Next
Rst!C1 = 15
Rst!C5 = "MUCHOS CHARS"
Rst!C7 = 23423
If Err.Number = 0 Then
MsgBox "OK"
Else
MsgBox Err.Description
End If
</pre>