Visual Basic 4 Unleashed/Visual_Basic_4_Unleashed_SAMS_Publishing_1995.iso/source/chap29/frm329.frm

Visual Basic Form | 1995-08-31 | 4.9 KB | 166 lines

VERSION 4.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   5940
   ClientLeft      =   1140
   ClientTop       =   1515
   ClientWidth     =   6690
   Height          =   6345
   Left            =   1080
   LinkTopic       =   "Form1"
   ScaleHeight     =   5940
   ScaleWidth      =   6690
   Top             =   1170
   Width           =   6810
   Begin VB.CommandButton Command2
      Caption         =   "test"
      Height          =   495
      Left            =   780
      TabIndex        =   2
      Top             =   1500
      Width           =   1215
   End
   Begin VB.CommandButton Command1
      Caption         =   "Command1"
      Height          =   495
      Left            =   3060
      TabIndex        =   1
      Top             =   4140
      Width           =   1215
   End
   Begin VB.CommandButton cmdOpenOdbc
      Caption         =   "Command1"
      Height          =   495
      Left            =   1140
      TabIndex        =   0
      Top             =   4140
      Width           =   1215
   End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Dim nenv As Long
Dim nconnect As Long
Const SQL_C_CHAR = 1
Sub OpenOdbcSource()
Dim nenv As Long
Dim nok As Integer
Dim cdatasource As String
Dim suserid As String
Dim spassword As String
Dim nsql As Long
Dim csql As String
Dim cdata As String
Dim nlong As Long
Dim nlength As Integer
Dim size As Integer
Dim cname As String
Dim ntype As Integer
Dim ndecimals As Integer
Dim nscale As Integer
Dim nnulls As Integer
nok = SQLAllocEnv(nenv)
If nok <> SQL_SUCCESS Then
    MsgBox "An Error Occured During the Allocation of the ODBC Environment"
    Exit Sub
End If
nok = SQLAllocConnect(nenv, nconnect)
If nok <> SQL_SUCCESS Then
    MsgBox "An Error Occured During the Allocation of ODBC Connections"
    Exit Sub
End If
' change the following 3 lines for your environment
cdatasource = "BIBLIO"
suserid = "ADMIN"
spassword = "PASSWORD"
nok = SQLConnect(nconnect, cdatasource, Len(cdatasource), suserid, Len(suserid), spassword, Len(spassword))
If nok <> SQL_SUCCESS Then
    MsgBox "An Error Occured During the Conection to the ODBC Database"
    Exit Sub
End If
MsgBox " You have sucessfully connected to the ODBC Database"
nok = SQLAllocStmt(nconnect, nsql)
If nok <> SQL_SUCCESS Then
    MsgBox "An Error Occured Allocating the SQL Results Handle"
    Exit Sub
End If
csql = " Select * from currency"
nok = SQLExecDirect(nsql, csql, Len(csql))
If nok <> SQL_SUCCESS Then
    MsgBox "An Error Occured Excuting the SQL Statment"
    Exit Sub
End If
nok = SQLFetch(nsql)
If nok <> SQL_SUCCESS Then
    MsgBox "An Error Occured Obtaining the SQL Result Set"
    Exit Sub
End If
nok = SQLDescribeCol(nsql, 2, cname, 15, size, ntype, ByVal ndecimals, nscale, nnulls)
nok = SQLGetData(nsql, 2, ntype, cdata, size, nlong)
nok = SQLGetData(nsql, 1, SQL_C_CHAR, cdata, 30, nlong)
If nok <> SQL_SUCCESS Then
    processerror nenv, nconnect, 0
    MsgBox "An Error Occured Obtaining the Field Value"
    Exit Sub
    MsgBox "The Following data was retreived " * cdata
End If
End Sub
Private Sub cmdOpenOdbc_Click()
Dim nok As Integer
Dim cdatasource As String
Dim suserid As String
Dim spassword As String
' change the following 3 lines for your environment
cdatasource = "BIBLIO"
suserid = "ADMIN"
spassword = "PASSWORD"
nok = SQLAllocEnv(nenv)
If nok <> SQL_SUCCESS Then ''''
    processerror nenv, nconnect, 0
    Exit Sub
End If
nok = SQLAllocConnect(nenv, nconnect)
If nok <> SQL_SUCCESS Then
    processerror nenv, nconnect, 0
    Exit Sub
End If
nok = SQLConnect(nconnect, cdatasource, Len(cdatasource), suserid, Len(suserid), spassword, Len(spassword))
If nok <> SQL_SUCCESS Then
    processerror nenv, nconnect, 0
    Exit Sub
End If
End Sub
Private Sub Command1_Click()
Dim nok As Integer
nok = SQLDisconnect(nconnect)
If nok < SQL_SUCCESS Then
    processerror nenv, nconnect, 0
    Exit Sub
End If
nok = SQLFreeConnect(nconnect)
If nok < SQL_SUCCESS Then
    processerror nenv, nconnect, 0
    Exit Sub
End If
nok = SQLFreeEnv(nenv)
If nok < SQL_SUCCESS Then
    processerror nenv, nconnect, 0
    Exit Sub
End If
End Sub
Sub processerror(nenv As Long, nconnect As Long, nstatement As Long)
Dim nok As Integer
Dim csqlstate As String
Dim snativeerror As Long
Dim serrormessage As String * 255
Dim nerrormsg As Integer
nok = SQLError(nenv, nconnect, nstatement, csqlstate, snativeerror, serrormessage, Len(serrormessage), nerrormsg)
MsgBox " the following Error" & serrormessage & " occurred Number " & snativeerror
End Sub
Private Sub Command2_Click()
OpenOdbcSource
End Sub
Private Sub Form_Load()
End Sub