Tricks of the Windows Gam…ming Gurus (2nd Edition)/Disc2.iso/msdn_vcb/samples/vc98/sdk/dbmsg/sql/vbsql/rpc.frm

Visual Basic Form | 1996-04-03 | 12.5 KB | 371 lines

VERSION 2.00
Begin Form PrimaryWindow
   Caption         =   "Remote Stored Procedure"
   Height          =   6765
   Icon            =   0
   Left            =   150
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   6075
   ScaleWidth      =   9060
   Top             =   390
   Width           =   9180
   Begin VBSQL VBSQL1
      Caption         =   "VBSQL1"
      Height          =   255
      Left            =   5280
      Top             =   120
      Visible         =   0   'False
      Width           =   855
   End
   Begin TextBox RESULT_FIELD
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Courier"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   2430
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   3
      Text            =   "Text1"
      Top             =   3600
      Width           =   8460
   End
   Begin Frame Frame2
      Caption         =   "Procedure Sampler"
      Height          =   1575
      Left            =   120
      TabIndex        =   11
      Top             =   1680
      Width           =   8895
      Begin TextBox PARAMVALUE_FIELD
         Height          =   285
         Left            =   1800
         TabIndex        =   15
         Text            =   "Text1"
         Top             =   1080
         Width           =   6975
      End
      Begin TextBox PARAMNAME_FIELD
         Height          =   285
         Left            =   1800
         TabIndex        =   16
         Text            =   "Text2"
         Top             =   720
         Width           =   6975
      End
      Begin ComboBox PROCNAME_COMBO
         Height          =   300
         Left            =   1800
         TabIndex        =   17
         Top             =   360
         Width           =   2895
      End
      Begin Label Label7
         Caption         =   "Parameter &Values:"
         Height          =   255
         Left            =   120
         TabIndex        =   14
         Top             =   1080
         Width           =   1815
      End
      Begin Label Label6
         Caption         =   "Para&meter Names:"
         Height          =   255
         Left            =   120
         TabIndex        =   13
         Top             =   720
         Width           =   1815
      End
      Begin Label Label3
         Caption         =   "&Procedure Name:"
         Height          =   255
         Left            =   120
         TabIndex        =   12
         Top             =   360
         Width           =   1575
      End
   End
   Begin CommandButton SEND_QUERY_BUTTON
      Caption         =   "E&xecute Proc"
      Enabled         =   0   'False
      Height          =   375
      Left            =   6360
      TabIndex        =   1
      Top             =   720
      Width           =   1575
   End
   Begin CommandButton MAKE_PROC_BUTTON
      Caption         =   "&Make Test Proc"
      Enabled         =   0   'False
      Height          =   375
      Left            =   6360
      TabIndex        =   0
      Top             =   240
      Width           =   1575
   End
   Begin Frame Frame1
      Caption         =   "Procedure qualifiers (optional)"
      Height          =   1455
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   5055
      Begin TextBox OWNER_FIELD
         Height          =   285
         Left            =   2040
         TabIndex        =   10
         Text            =   "Text3"
         Top             =   1080
         Width           =   2535
      End
      Begin TextBox DBNAME_FIELD
         Height          =   285
         Left            =   2040
         TabIndex        =   8
         Text            =   "Text2"
         Top             =   720
         Width           =   2535
      End
      Begin ComboBox SERVER_COMBO
         Height          =   300
         Left            =   2040
         TabIndex        =   6
         Top             =   360
         Width           =   2535
      End
      Begin Label Label5
         Caption         =   "&Owner:"
         Height          =   255
         Left            =   120
         TabIndex        =   9
         Top             =   1080
         Width           =   735
      End
      Begin Label Label4
         Caption         =   "&Database Name:"
         Height          =   255
         Left            =   120
         TabIndex        =   7
         Top             =   720
         Width           =   1455
      End
      Begin Label Label1
         Caption         =   "Remote &Server:"
         Height          =   255
         Left            =   120
         TabIndex        =   5
         Top             =   360
         Width           =   1455
      End
   End
   Begin Label Label2
      Caption         =   "&Results:"
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   3360
      Width           =   735
   End
   Begin Menu CONNECT_MENU
      Caption         =   "&Connection"
      Begin Menu LOGIN_MENU
         Caption         =   "&Login"
      End
      Begin Menu DATABASE_MENU
         Caption         =   "Change &Database"
      End
      Begin Menu EXIT_MENU
         Caption         =   "E&xit"
      End
   End
Sub ClearFields ()
    RESULT_FIELD.Text = ""
    DBNAME_FIELD.Text = ""
    OWNER_FIELD.Text = ""
    PARAMNAME_FIELD.Text = ""
    PARAMVALUE_FIELD.Text = ""
End Sub
Sub DATABASE_MENU_Click ()
    If SqlConn% = 0 Then
        MsgBox "Must login first"
        Exit Sub
    End If
    CHNGDB.Show 1
End Sub
Sub EXIT_MENU_Click ()
    ExitApplication
End Sub
Sub Form_Load ()
Rem Initialize the connection to SQL Server
    InitializeApplication
    MsgBox DBLIB_VERSION$
    PrimaryWindowTitle = "VBSQL RPC demonstration"
Rem Call routine to clear the fields
Rem Fill in the procedure names combobox
    ClearFields
    PROCNAME_COMBO.AddItem "sp_help"
    PROCNAME_COMBO.AddItem "sp_who"
    PROCNAME_COMBO.AddItem "echo_test"
End Sub
Function GetServers (Server_Control As Control) As Integer
Rem This routine gets the name of all the remote servers
Rem Fill each element in the combobox or list box which is passed into this procedure
Rem execute the command.  Get each server name and fill the combobox.
    If ExecuteSQLCommand("Select srvname from master..sysservers where srvid != 0") = FAIL% Then
        GetServers = FAIL
        Exit Function
    Else
        If SqlResults(SqlConn%) = FAIL% Then Exit Function
        While SqlNextRow(SqlConn%) <> NOMOREROWS%
            Server_Control.AddItem SqlData(SqlConn%, 1)
        Wend
    End If
    GetServers = SUCCEED
End Function
Sub LOGIN_MENU_Click ()
    Login.Show 1
    If SqlConn% <> 0 Then
        SEND_QUERY_BUTTON.Enabled = True
        MAKE_PROC_BUTTON.Enabled = True
        Results% = GetServers(SERVER_COMBO)
    End If
End Sub
Sub MAKE_PROC_BUTTON_Click ()
Static OutputData(0) As String
cmd$ = "CREATE PROCEDURE echo_test(@inparm1 varchar(20), @inparm2 int, "
cmd$ = cmd$ + "@outparm varchar(20) = NULL OUTPUT) AS "
cmd$ = cmd$ + "select @outparm = @inparm1 "
cmd$ = cmd$ + "return @inparm2"
Ret% = ExecuteSQLCommand(cmd$)
If Ret% = SUCCEED% Then
    MsgBox "Procedure echo_test created successfully"
    ' get rid of an result rows
    numrows& = Process_SQL_query("", OutputData())
End If
End Sub
Sub Parse_params (ParamIn As String, Delimiter As String, ParamOut() As String) '
Rem This routine takes the comma delimited Parameter names/values
Start% = 1
For i% = 0 To UBound(ParamOut)
    If done% = False Then
        'look for delimiter
        endpos% = InStr(Start%, ParamIn$, Delimiter$)
        If endpos% = 0 Then
            'we're at the last parameter
            ParamOut(i%) = Mid$(ParamIn$, Start%, 255)
            done% = True
        Else
            ParamOut(i%) = Mid$(ParamIn$, Start%, (endpos% - Start%))
            Start% = endpos% + 1
        End If
    Else
        'clear out rest of array
        ParamOut(i%) = ""
    End If
Next i%
End Sub
Sub PROCNAME_COMBO_Click ()
Select Case PROCNAME_COMBO.Text
    Case Is = "sp_help"
        PARAMNAME_FIELD.Text = "@objname VARCHAR(30)"
        PARAMVALUE_FIELD.Text = "sysobjects"
    Case Is = "echo_test"
        PARAMNAME_FIELD.Text = "@inparm1 VARCHAR(20),@inparm2 INTEGER,@outparm VARCHAR(20) OUT"
        PARAMVALUE_FIELD.Text = "hello,7,notused"
    Case Else
        PARAMNAME_FIELD.Text = ""
        PARAMVALUE_FIELD.Text = ""
End Select
End Sub
Sub SEND_QUERY_BUTTON_Click ()
Static OutputData(500) As String
CRLF$ = Chr$(13) + Chr$(10)
Rem Assemble the procedure name
Rem Get the parameter names
Rem Get the parameter values
Rem Initialize the stored proc.
Rem Fill the parameters
Static Param_Values(10) As String
Static Param_Declares(10) As String
Static Param_Types(2) As String
Static Param_Datatype(1) As String
'  Note:  If this is a remote server-to-server procedure call (SERVER_NAME is
'       not blank), and your remote password is different from your local
'       password, you will need to set the remote password field with SqlRPwSet%
'       prior to logging on.
procname$ = SERVER_COMBO.Text + "." + DBNAME_FIELD.Text + "." + OWNER_FIELD.Text + "." + PROCNAME_COMBO.Text
Results% = SqlRpcInit(SqlConn%, procname$, 0)
If PARAMVALUE_FIELD.Text <> "" Then
    In$ = PARAMVALUE_FIELD.Text
    Parse_params In$, ",", Param_Values()
    In$ = PARAMNAME_FIELD.Text
    Parse_params In$, ",", Param_Declares()
    For i% = 0 To 10
        'check to see if we are at the end of the parameters provided
        If Param_Values(i%) = "" Then Exit For
        'for each parameter, find out its type
        'first split type declaration into name, type(len), output
        In$ = Param_Declares(i%)
        Parse_params In$, " ", Param_Types()
        'param name is first part
        paramname$ = Param_Types(0)
        'If this is an output var, set the flag
        If Left$(Param_Types(2), 3) = "OUT" Then
            status% = SQLRPCRETURN%
        Else
            status% = 0
        End If

        'now take type(len) and split into type, len)
        In$ = Param_Types(1)
        Parse_params In$, "(", Param_Datatype()

        Select Case Param_Datatype(0)
            Case "VARCHAR"
                typecode% = SQLVARCHAR%
                If status% = SQLRPCRETURN% Then
                    maxlen& = Val(Left$(Param_Datatype(1), Len(Param_Datatype(1)) - 1))
                Else
                    maxlen& = -1
                End If
                datalen& = Len(Param_Values(i%))
            Case "INTEGER"
                typecode% = SQLINT4%
                maxlen& = -1
                datalen& = -1
            Case Else
                MsgBox "Sample does not handle " + Param_Datatype(0) + " paramters"
                Exit Sub
        End Select
        Results% = SqlRpcParam(SqlConn%, paramname$, status%, typecode%, maxlen&, datalen&, Param_Values(i%))
    Next i%
End If
Results% = SqlRpcSend(SqlConn%)
Rem Clear the result array, and result controls first
i% = 0
For i% = 0 To 499
    OutputData(i%) = ""
Rem Fill the result array with the data
Rem Fill the results field
RESULT_FIELD.Text = ""
numrows& = Process_SQL_query(cmd$, OutputData())
For i% = 0 To numrows& - 1
    DataLine$ = DataLine$ + OutputData(i%) + CRLF$
Next i%
RESULT_FIELD.Text = DataLine$
End Sub
Sub VBSQL1_Error (SqlConn As Integer, Severity As Integer, ErrorNum As Integer, ErrorStr As String, RetCode As Integer)
' Call the required VBSQL error-handling function
' OSErr and OSErrStr not used in VBSQL for Windows, but DOS interprets
' anything other than -1 as an OS error
    OsErr% = -1
    RetCode% = UserSqlErrorHandler%(SqlConn, Severity%, ErrorNum%, OsErr%, ErrorStr$, OsErrStr$)
End Sub
Sub VBSQL1_Message (SqlConn As Integer, Message As Long, State As Integer, Severity As Integer, MsgStr As String)
    UserSqlMsgHandler SqlConn, Message&, State%, Severity%, MsgStr$
End Sub