Re: Visual Basic ADO/Stored Procs

"Tom Brennan" <[email protected]> Fri, 05 Sep 2003 19:30:13 +0000
Newsgroups gmane.comp.db.sapdb.general
Message-ID <[email protected]>
Hello SAP'pers,

I have enclosed the entire code as my journey into SAP/Stored 
Procs/ADO/Visual Basic have begun. Kudos to Marcin P. and Thomas Anhaus for 
their help. I am not an expert on SAP and it's a whole different ball game 
to me. I have found some quirky things such as a stored procedure having 
output parameter(s), and expecting a recordset to be created on the fly, 
unfortunately not with this database, as I have found out! As per Marcin P's 
posting to my earlier query, it turns out you have to create a variable of 
ADODB.Parameter and store the output value into it,
e.g.
Set RS=Cmd.Execute
Debug.Print RS("RETVAL")
this can be annoying especially if you have perhaps more than 10 output 
parameters (See the code below to find out or refer to Marcin P's posting! 
Instead a cursor would have to be explicitly created if you wish to access 
the values. Unlike SQL Server where you have a few output parameters, a 
recordset is created automatically on the fly. Can somebody tell me if this 
is correct regarding having to create a cursor for output parameters or is 
there an easier way of achieving this! Hope this code helps others who may 
be experiencing difficulties with VB/ADO/SAP....

Thanks,
Tom.
//------------- SAP SQL Code Begins Here ----------------------
create table telephone_book
(
    tel_id integer,
    fname varchar(50) ascii,
    lname varchar(50) ascii,
    address varchar(255) ascii,
    telephone varchar(30) ascii,
    email_address varchar(255) ascii,
    primary key(tel_id)
)
//
insert into telephone_book values(0, 'Dummy First Name', 'Dummy Last Name', 
'Dummy Address', 'Dummy Telephone', 'Dummy Email')
//
create dbproc add_telephone_entry(in first_name varchar(50), in last_name 
varchar(50), in address_details varchar(255), in telephone_details 
varchar(30), in email_details varchar(255), out RV integer) as
    var new_tel_id integer;
begin
    select
        tel_id
    from xxxxx.telephone_book
    order by tel_id desc;

    if $rc = 0 then begin
        fetch into :new_tel_id;
        set new_tel_id = new_tel_id + 1;
        insert into xxxxx.telephone_book values
        (
            :new_tel_id,
            :first_name,
            :last_name,
            :address_details,
            :telephone_details,
            :email_details
        );
        if $rc = 0 then
            set :RV = 0
        else
            set RV = 1;
    end;
end;
//
create dbproc get_all_tel_list returns
cursor as $cursor='PhoneList';
declare :$cursor cursor for
    select
        tel_id,
        lname||', '||fname as "Name"
    FROM
        xxxxx.telephone_book
    where
        tel_id > 0
    order by lname asc;
//
create dbproc get_one_tel(in in_tel_id integer) returns
cursor as $cursor='PhoneList';
declare :$cursor cursor for
    select
        address,
        telephone,
        email_address
    FROM
        xxxxx.telephone_book
    where
        tel_id = :in_tel_id;
//------------- SAP SQL Code Ends Here ----------------------
'-----------------> Visual Basic Code Begins here <-------------------------
' Form1.frm
VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Telephone Book"
   ClientHeight    =   1815
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   1560
   LinkTopic       =   "Form1"
   ScaleHeight     =   1815
   ScaleWidth      =   1560
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdView
      Caption         =   "View"
      Height          =   525
      Left            =   120
      TabIndex        =   1
      Top             =   960
      Width           =   1305
   End
   Begin VB.CommandButton cmdAddEntry
      Caption         =   "Add"
      Height          =   525
      Left            =   120
      TabIndex        =   0
      Top             =   225
      Width           =   1290
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdAddEntry_Click()
    Load Form2
    Form2.Show
End Sub
Private Sub cmdView_Click()
    Load Form3
    Form3.Show
End Sub
Private Sub Form_Load()
    Dim ConnStr As String
    ConnStr = "Driver={SAP DB}; Server=localhost; Uid=xxxx; Pwd=xxxx; 
Database=xxxx;"
    Conn.Open ConnStr
End Sub
' Form2.frm
Attribute VB_Name = "Module1"
Option Explicit

Public Conn As New ADODB.Connection
'
VERSION 5.00
Begin VB.Form Form2
   Caption         =   "Form2"
   ClientHeight    =   3480
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3525
   LinkTopic       =   "Form2"
   ScaleHeight     =   3480
   ScaleWidth      =   3525
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1
      Caption         =   "Clear Entry"
      Height          =   495
      Left            =   1785
      TabIndex        =   11
      Top             =   2865
      Width           =   1125
   End
   Begin VB.CommandButton cmdAddEntry
      Caption         =   "Add Entry"
      Height          =   480
      Left            =   375
      TabIndex        =   10
      Top             =   2865
      Width           =   1080
   End
   Begin VB.TextBox Text5
      Height          =   285
      Left            =   1275
      TabIndex        =   9
      Text            =   "Text5"
      Top             =   2340
      Width           =   2055
   End
   Begin VB.TextBox Text4
      Height          =   285
      Left            =   1260
      TabIndex        =   7
      Text            =   "Text4"
      Top             =   1905
      Width           =   2115
   End
   Begin VB.TextBox Text3
      Height          =   930
      Left            =   1095
      MultiLine       =   -1  'True
      TabIndex        =   5
      Text            =   "Form2.frx":0000
      Top             =   840
      Width           =   1800
   End
   Begin VB.TextBox Text2
      Height          =   285
      Left            =   1110
      TabIndex        =   3
      Text            =   "Text2"
      Top             =   435
      Width           =   1785
   End
   Begin VB.TextBox Text1
      Height          =   285
      Left            =   1110
      TabIndex        =   1
      Text            =   "Text1"
      Top             =   75
      Width           =   1755
   End
   Begin VB.Label Label5
      AutoSize        =   -1  'True
      Caption         =   "Telephone No:"
      Height          =   195
      Left            =   105
      TabIndex        =   8
      Top             =   2385
      Width           =   1065
   End
   Begin VB.Label Label4
      AutoSize        =   -1  'True
      Caption         =   "Email Address:"
      Height          =   195
      Left            =   75
      TabIndex        =   6
      Top             =   1920
      Width           =   1035
   End
   Begin VB.Label Label3
      AutoSize        =   -1  'True
      Caption         =   "Address:"
      Height          =   195
      Left            =   135
      TabIndex        =   4
      Top             =   825
      Width           =   615
   End
   Begin VB.Label Label2
      AutoSize        =   -1  'True
      Caption         =   "Last Name:"
      Height          =   195
      Left            =   120
      TabIndex        =   2
      Top             =   480
      Width           =   810
   End
   Begin VB.Label Label1
      AutoSize        =   -1  'True
      Caption         =   "First Name:"
      Height          =   195
      Left            =   105
      TabIndex        =   0
      Top             =   120
      Width           =   795
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdAddEntry_Click()
    Dim Cmd As ADODB.Command
    Dim ParamOutput As ADODB.Parameter
    Dim RS As ADODB.Recordset
    On Error GoTo cmdAddEntry_Error
    Set Cmd = New ADODB.Command
    With Cmd
        .ActiveConnection = Conn
        .CommandText = "ADD_TELEPHONE_ENTRY"
        .CommandType = adCmdStoredProc
        Call .Parameters.Append(.CreateParameter("FIRST_NAME", adVarChar, 
adParamInput, 50, Text1))
        Call .Parameters.Append(.CreateParameter("LAST_NAME", adVarChar, 
adParamInput, 50, Text2))
        Call .Parameters.Append(.CreateParameter("ADDRESS_DETAILS", 
adVarChar, adParamInput, 255, Text3))
        Call .Parameters.Append(.CreateParameter("TELEPHONE_DETAILS", 
adVarChar, adParamInput, 30, Text5))
        Call .Parameters.Append(.CreateParameter("EMAIL_DETAILS", adVarChar, 
adParamInput, 255, Text4))
        '
        Set ParamOutput = .CreateParameter("RV", adInteger, adParamOutput, 
10, 100)
        Call .Parameters.Append(ParamOutput)
        Call .Execute
'
' Would be nice if I can just say if (RS("RV") = 0) Then....
'
        Debug.Print "ParamOutput.Value = " & ParamOutput.Value
    End With
cmdAddEntry_Escape:
    Set ParamOutput = Nothing
    Set Cmd = Nothing
    Exit Sub
cmdAddEntry_Error:
    Resume cmdAddEntry_Escape
End Sub
' Form3.frm
VERSION 5.00
Begin VB.Form Form3
   Caption         =   "Form3"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form3"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox Text3
      Height          =   285
      Left            =   915
      Locked          =   -1  'True
      TabIndex        =   7
      Text            =   "Text3"
      Top             =   2445
      Width           =   2130
   End
   Begin VB.TextBox Text2
      Height          =   285
      Left            =   1230
      Locked          =   -1  'True
      TabIndex        =   5
      Text            =   "Text2"
      Top             =   1965
      Width           =   1860
   End
   Begin VB.TextBox Text1
      Height          =   855
      Left            =   1080
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   3
      Text            =   "Form3.frx":0000
      Top             =   840
      Width           =   2160
   End
   Begin VB.ComboBox Combo1
      Height          =   315
      Left            =   735
      TabIndex        =   0
      Text            =   "Combo1"
      Top             =   315
      Width           =   2445
   End
   Begin VB.Label Label4
      AutoSize        =   -1  'True
      Caption         =   "Email:"
      Height          =   195
      Left            =   270
      TabIndex        =   6
      Top             =   2475
      Width           =   420
   End
   Begin VB.Label Label3
      AutoSize        =   -1  'True
      Caption         =   "Telephone:"
      Height          =   195
      Left            =   270
      TabIndex        =   4
      Top             =   2010
      Width           =   810
   End
   Begin VB.Label Label2
      AutoSize        =   -1  'True
      Caption         =   "Address:"
      Height          =   195
      Left            =   255
      TabIndex        =   2
      Top             =   840
      Width           =   615
   End
   Begin VB.Label Label1
      AutoSize        =   -1  'True
      Caption         =   "Name:"
      Height          =   195
      Left            =   240
      TabIndex        =   1
      Top             =   345
      Width           =   465
   End
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Combo1_Click()
    Dim Cmd As ADODB.Command
    Dim ParamOutput As ADODB.Parameter
    Dim RS As ADODB.Recordset
    On Error GoTo Combo1_Click_Error
    Set Cmd = New ADODB.Command
    With Cmd
        .ActiveConnection = Conn
        .CommandText = "GET_ONE_TEL"
        .CommandType = adCmdStoredProc
        Call .Parameters.Append(.CreateParameter("IN_TEL_ID", adInteger, 
adParamInput, 10, Combo1.ItemData(Combo1.ListIndex)))
    End With
    Set RS = Cmd.Execute
    If (Not RS Is Nothing) Then
        While Not RS.EOF
            Text1 = RS("Address")
            Text2 = RS("Telephone")
            Text3 = RS("Email_Address")
            RS.MoveNext
        Wend
        RS.Close
    Else
        Text1 = ""
        Text2 = ""
        Text3 = ""
    End If
Combo1_Click_Escape:
    Set ParamOutput = Nothing
    Set Cmd = Nothing
    Exit Sub
Combo1_Click_Error:
    Resume Combo1_Click_Escape
End Sub
Private Sub Form_Load()
    Dim RS As ADODB.Recordset
    Dim Cmd As ADODB.Command
    On Error GoTo Form_Load_Error
    Text1 = ""
    Text2 = ""
    Text3 = ""
    Set Cmd = New ADODB.Command
    Cmd.ActiveConnection = Conn
    Cmd.CommandText = "GET_ALL_TEL_LIST"
    Cmd.CommandType = adCmdStoredProc
    Combo1.Clear
    Set RS = Cmd.Execute
    If (Not RS Is Nothing) Then
        While Not RS.EOF
            Combo1.AddItem RS("Name")
            Combo1.ItemData(Combo1.NewIndex) = RS("Tel_Id")
            RS.MoveNext
        Wend
        RS.Close
        Combo1.ListIndex = 0
    End If
Form_Load_Escape:
    Set RS = Nothing
    Set Cmd = Nothing
    Exit Sub
Form_Load_Error:
    Resume Form_Load_Escape
End Sub
' Project.vbp
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\WINNT\System32\STDOLE2.TLB#OLE 
Automation
Reference=*\G{00000205-0000-0010-8000-00AA006D2EA4}#2.5#0#..\..\..\..\..\..\Program 
Files\Common Files\system\ado\msado25.tlb#Microsoft ActiveX Data Objects 2.5 
Library
Reference=*\G{00000300-0000-0010-8000-00AA006D2EA4}#2.6#0#..\..\..\..\..\..\Program 
Files\Common Files\system\ado\msador15.dll#Microsoft ActiveX Data Objects 
Recordset 2.6 Library
Object={67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0; msadodc.ocx
Object={CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0; MSDatGrd.ocx
Form=Form1.frm
Form=Form2.frm
Module=Module1; Module1.bas
Form=Form3.frm
IconForm="Form1"
Startup="Form1"
ExeName32="Project1.exe"
Command32=""
Name="Project1"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="TBWizards Ltd., 1995, 2002."
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1

[MS Transaction Server]
AutoRefresh=1
'-----------------> Visual Basic Code Ends here <-------------------------



/*
** #define p printf
** p("Better to reign in Hell, than to serve in Heaven");
** p("Email - [email protected]");
*/

_________________________________________________________________
MSN 8 helps eliminate e-mail viruses. Get 2 months FREE*. 
http://join.msn.com/?page=features/virus