Windows编程

开发平台：
Visual C++

RPC.FRM：源码内容
							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
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
Rem Initialize the connection to SQL Server
Rem
    InitializeApplication
    MsgBox DBLIB_VERSION$
    PrimaryWindowTitle = "VBSQL RPC demonstration"
Rem
Rem Call routine to clear the fields
Rem Fill in the procedure names combobox
Rem
    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
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.
Rem
    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
Rem This routine takes the comma delimited Parameter names/values
Rem
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
Rem Assemble the procedure name
Rem Get the parameter names
Rem Get the parameter values
Rem Initialize the stored proc.
Rem Fill the parameters
Rem
    
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
Rem Clear the result array, and result controls first
Rem
i% = 0
For i% = 0 To 499
    OutputData(i%) = ""
Next
Rem
Rem Fill the result array with the data
Rem Fill the results field
Rem
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

						