Visual Basic 4 Unleashed/Visual_Basic_4_Unleashed_SAMS_Publishing_1995.iso/sfi/vbxctdem/logon.frm

Visual Basic Form | 1994-12-23 | 6.7 KB | 206 lines

VERSION 2.00
Begin Form logon
   BackColor       =   &H00C0FFC0&
   Caption         =   "Logon For SQL Server System 10"
   ClientHeight    =   1665
   ClientLeft      =   1665
   ClientTop       =   3285
   ClientWidth     =   5580
   ControlBox      =   0   'False
   Height          =   2070
   Left            =   1605
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1665
   ScaleWidth      =   5580
   Top             =   2940
   Width           =   5700
   Begin CommandButton cancelbut
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   615
      Left            =   3600
      TabIndex        =   9
      Top             =   840
      Width           =   1695
   End
   Begin CommandButton logonbut
      Caption         =   "Logon to Server"
      Default         =   -1  'True
      Height          =   615
      Left            =   3600
      TabIndex        =   8
      Top             =   120
      Width           =   1695
   End
   Begin TextBox dbase
      Height          =   285
      Left            =   1440
      TabIndex        =   7
      Text            =   "pubs2"
      Top             =   1200
      Width           =   1935
   End
   Begin TextBox serverid
      Height          =   285
      Left            =   1440
      TabIndex        =   6
      Text            =   "10NT"
      Top             =   840
      Width           =   1935
   End
   Begin TextBox password
      Height          =   285
      Left            =   1440
      TabIndex        =   5
      Top             =   480
      Width           =   1935
   End
   Begin TextBox uid
      Height          =   285
      Left            =   1440
      TabIndex        =   4
      Text            =   "sa"
      Top             =   120
      Width           =   1935
   End
   Begin Label Label4
      Alignment       =   1  'Right Justify
      Caption         =   "DataBase :"
      Height          =   195
      Left            =   200
      TabIndex        =   3
      Top             =   1200
      Width           =   1000
   End
   Begin Label Label3
      Alignment       =   1  'Right Justify
      Caption         =   "Server Id :"
      Height          =   195
      Left            =   200
      TabIndex        =   2
      Top             =   840
      Width           =   1000
   End
   Begin Label Label2
      Alignment       =   1  'Right Justify
      Caption         =   "PassWord :"
      Height          =   195
      Left            =   200
      TabIndex        =   1
      Top             =   480
      Width           =   1000
   End
   Begin Label Label1
      Alignment       =   1  'Right Justify
      Caption         =   "User Id :"
      Height          =   195
      Left            =   200
      TabIndex        =   0
      Top             =   120
      Width           =   1000
   End
Sub cancelbut_Click ()
'   User does not wish to connect
    Unload Me
End Sub
Sub change_database (cp As Long, db As String)
    Dim restype As Long
    Dim ncols As Long
    Dim rinfo As Long
'   Set up the command buffer for processing
        ret = VBCT_command_str(cmd_pointer, CS_LANG_CMD, "use " & db, CS_UNUSED)

'   Send the command(s) to the server for processing
        ret = VBCT_send(cmd_pointer)

'   Process the result sets comming back from the server
        result_ret = VBCT_results(cmd_pointer, restype)
        res$ = ""
        While result_ret = CS_SUCCEED

            Select Case restype

            Case CS_CMD_DONE, CS_CMD_SUCCEED, CS_CMD_FAIL
                Select Case restype
                Case CS_CMD_DONE
                    rt$ = "CS_CMD_DONE"
                Case CS_CMD_SUCCEED
                    rt$ = "CS_CMD_SUCCEED"
                Case CS_CMD_FAIL
                    rt$ = "CS_CMD_FAIL"
                End Select
'                MsgBox "Command status " & rt$ & " recieved"
            Case Else
                MsgBox "This command should never reach here"
            End Select
        result_ret = VBCT_results(cmd_pointer, restype)
    Wend
End Sub
Sub logonbut_Click ()
    Dim version As Long
    Dim sbuf As String
    Dim buflen As Long
    Dim outlen As Long
'   If the application has not already initialized the
'   CT-Library then use the following code to init
'   the CT-Library
    If ctx_pointer = 0 Then
        ret = VBCS_ctx_alloc(CS_VERSION_100, ctx_pointer)
        ret = VBCT_init(ctx_pointer, CS_VERSION_100)
        ret = VBCT_install_callbacks(ctx_pointer, CS_SERVERMSG_CB)
        ret = VBCT_install_callbacks(ctx_pointer, CS_CLIENTMSG_CB)
    End If
'   This form solicits from the user the following
'   information
'   Userid
'   Password
'   Database to be used -   this should be
'                           or pubs2 for this application
'                           to function property
    usid = uid.Text
    If usid = "" Then
        MsgBox "You must enter a userid"
        Exit Sub
    End If
    pword = password.Text
    sid = serverid.Text
    If sid = "" Then
        MsgBox "You must enter the server name"
        Exit Sub
    End If
    datbase = dbase.Text
    If datbase = "" Then
        MsgBox "You must enter the database name - pubs for SqlServer 4.2 or pubs2 for System 10"
        Exit Sub
    End If
    If datbase <> "pubs2" Then
        MsgBox "Your database name should be - pubs2 for SqlServer System 10"
    End If
'   Once the information needed to open a connection is
'   obtained from the user open a connection with the server
'   using the following code. This code allocates a connection
'   sets the connection properties, connects to the server,
'   allocates a command and changes the database to pubs2
    sbuf = uid
    buflen = Len(sbuf)
    ret = VBCT_con_alloc(ctx_pointer, con_pointer)
    ret = VBCT_con_props_str(con_pointer, CS_SET, CS_USERNAME, sbuf, outlen)
    If pword <> "" Then
        ret = VBCT_con_props_str(con_pointer, CS_SET, CS_PASSWORD, pword, outlen)
    End If
    ret = VBCT_con_props_str(con_pointer, CS_SET, CS_APPNAME, "TestCTLib", outlen)
    ret = VBCT_con_props_str(con_pointer, CS_SET, CS_HOSTNAME, "TestCTLib", outlen)
    ret = VBCT_connect(con_pointer, "")
    ret = VBCT_cmd_alloc(con_pointer, cmd_pointer)
    ret = process_no_rows("use " & datbase)
'   If the connection has been made and the database changed
'   to pubs/pubs2 then hiding the connect button will allow
'   the application to run
    If ret = 99 Then
        mainform!multibut.Visible = False
        Unload Me
    End If
End Sub