The following is a sample API application (edaapp.bas) written in Visual Basic and is provided with a Visual Basic form file and a project file (edavb.frm and edaapp.vbp) to build a GUI-based test application similar to the GUI RDAAPP tool.
Attribute VB_Name = "edaapp"
'--------------------------------------------------------------------------------
'
' Copyright (c) 2004 Information Builders, Inc. All rights reserved.
'
' Name: edaapp.bas
' Description: iWay API function calls used by sample VB application.
' Release: 7.x
'
' edaapp.vbp - VB project file for VB sample
' edaapp.frm - GUI Form an Main Control for VB sample
' edaapp.bas - Actual VB sample program
' edaglob.bas - iWay API Header file for VB
'
'--------------------------------------------------------------------------------
Option Explicit
Global eid As Long
Global scb As eda_scb
Public Function fnEdaRpc(query As String) As Long
Dim lStatus As Long
Dim lRpcPos As Long
Dim sRpcName As String
Dim sRpcParm As String
lRpcPos = InStr(1, query, " ")
If lRpcPos > 0 Then
sRpcName = Left(query, lRpcPos)
sRpcParm = Trim(Mid$(query, lRpcPos))
Else
sRpcName = Trim(query)
sRpcParm = ""
End If
EDARPC scb, sRpcName, EDA_NULL_DELIM, sRpcParm, EDA_NULL_DELIM
If scb.status <> EDA_SUCCESS Then
fnEdaRpc = scb.status
Exit Function
End If
lStatus = fnEdaTest()
If lStatus = EDA_SUCCESS Then
lStatus = fnEdaFetch()
End If
fnEdaRpc = lStatus
End Function
Public Function fnEdaConn(userid As String, passwd As String, server As String) As Long
EDACONNECT eid, scb, userid, EDA_NULL_DELIM, passwd, EDA_NULL_DELIM, server, EDA_NULL_DELIM
fnEdaConn = scb.status
End Function
Public Function fnEdaXconn() As Long
EDAXCONNECT scb
fnEdaXconn = scb.status
End Function
Public Function fnEdaTest() As Long
Dim lWaiting As Long
Dim sMsgText As String * 134
frmEDAx.lblStatus.Caption = "Waiting... "
frmEDAx.lblStatus.Refresh
Do
EDATEST scb, lWaiting
If scb.status < EDA_SUCCESS Then
fnEdaTest = scb.status
Exit Do
End If
Loop While lWaiting <> 0
frmEDAx.lblScb.Caption = "SCB: Rows=" + Str(scb.count) + " Cols=" +
Str(scb.nbrcols) + " Size=" + Str(scb.a_size)
frmEDAx.lblScb.Refresh
If scb.msg_type <> 0 Then
sMsgText = Left(scb.msg_text, scb.msg_len)
frmEDAx.txtResults.Text = frmEDAx.txtResults.Text + _
"(" + scb.msg_org + Str(scb.msg_code) + ") " + sMsgText + vbNewLine
Do While scb.msg_pending <> 0
EDAACCEPT scb
sMsgText = Left(scb.msg_text, scb.msg_len)
frmEDAx.txtResults.Text = frmEDAx.txtResults.Text + _
"(" + scb.msg_org + Str(scb.msg_code) + ") " + sMsgText + vbNewLine
Loop
frmEDAx.txtResults.Text = frmEDAx.txtResults.Text + _
"-- End of Messages -- " + vbNewLine
End If
fnEdaTest = scb.status
End Function
Public Function fnEdaFetch() As Long
Dim tuple As String * 4096
Dim szTuple As String
Dim szTemp As String
Dim lRow As Long
If scb.a_size > 0 Then
frmEDAx.lblStatus.Caption = "Fetching Data..."
frmEDAx.lblStatus.Refresh
lRow = 0
Do While scb.status = EDA_SUCCESS
EDAFETCH scb, tuple, scb.a_size, EDA_ALPHANUM
If scb.status = EDA_END_OF_SET Then
frmEDAx.txtResults.Text = frmEDAx.txtResults.Text + _
"-- End of Set -- (" + Str(scb.count) + " Rows retrieved)"
EDAQUIT scb
Else
If scb.status < EDA_SUCCESS Then
frmEDAx.txtResults.Text = frmEDAx.txtResults.Text + _
"(" + Str(scb.status) + ") Error in Fetching Data"
Else
lRow = lRow + 1
frmEDAx.lblStatus.Caption = "Rows=" & Str(lRow)
frmEDAx.lblStatus.Refresh
szTuple = Left(tuple, scb.a_size)
frmEDAx.txtResults.SelStart = Len(frmEDAx.txtResults.Text)
frmEDAx.txtResults.SelText = szTuple + vbNewLine
frmEDAx.txtResults.Refresh
End If
End If
Loop
End If
fnEdaFetch = scb.status
End Function
Public Function fnEdaSql(query As String) As Long
Dim lStatus As Long
EDASQL scb, query, EDA_NULL_DELIM, 0, 0, "", 0, 1
If scb.status <> EDA_SUCCESS Then
fnEdaSql = scb.status
Exit Function
End If
lStatus = fnEdaTest()
If lStatus = EDA_SUCCESS Then
lStatus = fnEdaFetch()
End If
fnEdaSql = lStatus
End Function
Public Function fnEdaInit()
Dim lStatus As Long
EDAINIT eid, lStatus
If lStatus <> EDA_SUCCESS Then
MsgBox "ERROR in Init, Status=" & lStatus, vbExclamation
End
End If
lStatus = fnEdaSources()
End Function
Public Function fnEdaTerm()
Dim lStatus As Long
EDATERM eid, lStatus
End Function
Public Function fnBrowseTables() As Long
Dim lStatus As Long
EDABROWSE scb, EDABASE_TBL_TABLES, EDABASE_SEL_TABLES_ALL, 0&, EDABASE_SELECT
If scb.status <> EDA_SUCCESS Then
fnBrowseTables = scb.status
Exit Function
End If
lStatus = fnEdaTest()
If lStatus = EDA_SUCCESS Then
lStatus = fnEdaFetch()
End If
fnBrowseTables = lStatus
End Function
Public Function fnDescribe(sTable As String) As Long
Dim InfoArea As eda_info_area
Dim lColNumb As Long
Dim lStatus As Long
Dim szTuple As String
EDADESCRIBE scb, sTable, EDA_NULL_DELIM
If scb.status <> EDA_SUCCESS Then
fnDescribe = scb.status
Exit Function
End If
lStatus = fnEdaTest()
If lStatus = EDA_SUCCESS Then
For lColNumb = 1 To scb.nbrcols Step 1
EDAINFO scb, lColNumb, InfoArea
If scb.status <> EDA_SUCCESS Then
lStatus = scb.status
Exit For
End If
szTuple = Left(InfoArea.col_name, InfoArea.col_Length)
frmEDAx.txtResults.Text = frmEDAx.txtResults.Text + szTuple + " " +
Str$(InfoArea.type) + " " + Str$(InfoArea.length) + vbNewLine
frmEDAx.txtResults.Refresh
Next lColNumb
End If
frmEDAx.txtResults.Text = frmEDAx.txtResults.Text + "-- End of Columns -- " +
vbNewLine
fnDescribe = lStatus
End Function
Private Function fnEdaSources()
Dim selfscb As eda_scb
Dim SName As String * 8
Dim sServer As String * 512
Dim servers As Long
Dim selector As Long
Dim cmd As Long
servers = EDABASE_TBL_SERVERS
selector = EDABASE_SEL_SERVERS_ALL
cmd = EDABASE_SELECT
EDACONNECT eid, selfscb, "", -1, "", -1, "", -5
EDABROWSE selfscb, servers, selector, 0&, cmd
EDATEST selfscb, 0&
Do While selfscb.status = EDA_SUCCESS
EDANEXT selfscb
If selfscb.status = EDA_SUCCESS Then
EDAFIELD selfscb, 1, SName, 8, EDA_ALPHANUM
frmEDAx.cmbServers.AddItem SName
End If
Loop
EDAXCONNECT scb
fnEdaSources = 0
End Function
| iWay Software |