Visual Basic 6 - Recordset from a Ref Cursor within a Store Procedure

  

    CREATE OR REPLACE PACKAGE cfsearchpkg

      IS

         TYPE t_cursor  IS REF CURSOR ;

         procedure DelegaSearchCF  (pCF VARCHAR2,  io_cursor in out t_cursor );

    END cfsearchpkg;







    CREATE OR REPLACE PACKAGE BODY cfsearchpkg

    as

    procedure DelegaSearchCF

        (pCF VARCHAR2,  io_cursor in out t_cursor )

      as

   BEGIN

       

       open io_cursor FOR

       

       SELECT  'Cliente' as CfAs, vwdelega.*  FROM vwdelega WHERE IDDELEGA IN

       SELECT DISTINCT delega.IDDelega 

       FROM

       Delega inner join cccliente  on delega.idcc=cccliente.idcc

       inner join Cliente on cccliente.idcliente=cliente.idcliente

       where cliente.cf= pCF

       )

       

       UNION

    SELECT 'Intestatario' as CfAs ,vwdelega.*  FROM vwdelega WHERE IDDELEGA IN

       SELECT DISTINCT delega.IDDelega

       FROM

       Delega inner join cccliente  on delega.idcc=cccliente.idcc

       where cccliente.cfintestatario= pCF

       )

       UNION

       SELECT 'Sottoscrittore' as CfAs  , vwdelega.* FROM vwdelega WHERE IDDELEGA IN

        SELECT DISTINCT delega.IDDelega 

       FROM

       Delega inner join SOTTOSCRITTORE  on delega.idsottoscrittore=sottoscrittore.idsottoscrittore

       where sottoscrittore.cfsottoscrittore= pCF

       

       );

   END;

      end cfsearchpkg; 

      /



       

      Dim cn As ADODB.Connection

        Dim RS As ADODB.Recordset

        Dim cmd As ADODB.Command

        Dim param As ADODB.Parameter

        Dim SQL As String

        Const CONNECT = "Provider=MSDAORA.1;Data Source=WEB;User ID=SOFIDUSR;Password=SO"

        

        Set cn = New ADODB.Connection

        cn.Open CONNECT

        Dim CF As String

        CF = "MRGGNN68B22M090M"

        SQL = "{call cfsearchpkg.DelegaSearchCFStorico(?)}"

        Set cmd = New ADODB.Command

        With cmd

            Set .ActiveConnection = cn

            .CommandText = SQL

            .CommandType = 1                'adCmdText

            'Pass in 0 to retrieve all of the records

            Set param = .CreateParameter("pCFCliente", adVarChar, adParamInputOutput, 16, CF)

            .Parameters.Append param

        End With

                        

        Set RS = New ADODB.Recordset

        Set RS = cmd.execute

        While Not RS.EOF

            List1.AddItem (RS("cfas") & "--" & RS("IDDELEGA") & "-" & Trim(RS("CODICESOCIETA")) & Trim(RS("CODICEDELEGA")))

            

            RS.MoveNext

        Wend