Visual Basic and the HP e3000 Examples 
Remote Procedure Calls allow one to run subroutines across a
a network.  This example shows how to issue TurboIMAGE calls
from a Visual Basic program across an network.


  Home
  New
  Site Map
  VB Examples
    Visual Basic Example Intro
  
     ODBC Program Generator
        COM Client/Server and Web
        TurboIMAGE Calls from Win32
  Guest Book
  Email

The problem

If one wants to access data that exists in an HP 3000 TurboIMAGE database from a Windows application there are several choices.  One alternative is first make it ODBC enabled in such a way that the free ODBCLink driver that comes with MPE can be used.  ODBC enabling a database requires that several steps be performed on the HP 3000 for each database that one needs to access.  Another alternative  is to purchase a commercial ODBC software package in order to have ODBC access to TurboIMAGE databases in their native form.   Still other client server approaches exist that usually involve the developer writing a server program on the HP 3000 and a client for the Windows computer.  The approach described in this example allows the programmer to issue the same IMAGE calls that one would issue on the HP 3000 from a program on the Windows computer.  The user written Visual Basic program is able to communicate with a general purpose server that has been written in advance to process IMAGE calls.  

Remote Procedure Calls

What Is RPC

RPC is a powerful technique for constructing distributed, client-server based applications. It is based on extending the notion of conventional, or local procedure calling, so that the called procedure need not exist in the same address space as the calling procedure. The two processes may be on the same system, or they may be on different systems with a network connecting them. By using RPC, programmers of distributed applications avoid the details of the interface with the network. The transport independence of RPC isolates the application from the physical and logical elements of the data communications mechanism and allows the application to use a variety of transports.

RPC makes the client/server model of computing more powerful and easier to program. When combined with the ONC RPCGEN protocol compiler clients transparently make remote calls through a local procedure interface.

How RPC Works

An RPC is analogous to a function call. Like a function call, when an RPC is made, the calling arguments are passed to the remote procedure and the caller waits for a response to be returned from the remote procedure. Figure 3.1 shows the flow of activity that takes place during an RPC call between two networked systems. The client makes a procedure call that sends a request to the server and waits. The thread is blocked from processing until either a reply is received, or it times out. When the request arrives, the server calls a dispatch routine that performs the requested service, and sends the reply to the client. After the RPC call is completed, the client program continues. RPC specifically supports network applications.

Fig. 3.1 Remote Procedure Calling Mechanism 

A remote procedure is uniquely identified by the triple: (program number, version number, procedure number) The program number identifies a group of related remote procedures, each of which has a unique procedure number. A program may consist of one or more versions. Each version consists of a collection of procedures which are available to be called remotely. Version numbers enable multiple versions of an RPC protocol to be available simultaneously. Each version contains a a number of procedures that can be called remotely. Each procedure has a procedure number.

The Portmapper

As stated above, the caller has to know the exact port number used by a specific RPC program to be able to send a call message to it. Portmap is a server application that will map a program number and its version number to the internet port number used by the program. Because Portmap is assigned a reserved (well-known service) port number 111, all the caller has to do is ask the Portmap service on the remote host about the port used by the desired program. See Fig. 3.2.

Portmap only knows about RPC programs on the host it runs on (only RPC programs on the local host).

In order for Portmap to know about the RPC program, every RPC program should register itself with the local Portmap when it starts up. It should also cancel its registration when it closes down.

Normally, the calling application would contact Portmap on the destination host to obtain the correct port number for a particular remote program, and then send the call message to this particular port. A variation exists when the caller also sends the procedure data along to Portmap and then the remote Portmap directly invokes the procedure.

An RPC Server for TurboIMAGE

Our goal is to be able to issue native IMAGE calls from a Visual Basic program.  In order to do this we need to have a server located on the HP 3000 that implements the desired IMAGE functionality and a dll on the PC side that allows us to issue the IMAGE call on the PC and have it execute on the server.

To develop an RPC application the following steps are needed:

  • Specify the protocol for client server communication
  • Develop the client program (a dll)
  • Develop the server program

The programs are compiled separately on their respective host computers. The communications protocol is achieved by generated stubs and these stubs and rpc (and other libraries) will need to be linked in.

TurboIMAGE Intrinsics Implemented             

DBOPEN                 

DBINFO              

DBFIND                 

DBGET                  

DBLOCK        
DBUNLOCK 

DBPUT                  

DBUPDATE              

DBDELETE             

DBCLOSE   
DBERROR

 

Visual Basic Calls

Declare Sub DBOPEN Lib "DBapiV2.dll" Alias "_DBOPEN@16" (sDBName As udtByteArrayType, sDBPass As udtByteArrayType, iDBMode As Any, uDBStatus As udtDBStatusType)

Declare Sub DBINFO Lib "DBapiV2.dll" Alias "_DBINFO@20" (sDBName As udtByteArrayType, sDummy As udtByteArrayType, iDBMode As Any, uDBStatus As udtDBStatusType, uDBInfoData As Any)


Declare Sub DBFIND Lib "DBapiV2.dll" Alias "_DBFIND@24" (sDBName As udtByteArrayType, sDBSetName As udtByteArrayType, iDBMode As Any, uDBStatus As udtDBStatusType, uDBSearchItem As udtByteArrayType, uDBSearchKey As udtByteArrayType)


Declare Sub DBGET Lib "DBapiV2.dll" Alias "_DBGET@28" (sDBName As udtByteArrayType, sDBSetName As udtByteArrayType, iDBMode As Any, uDBStatus As udtDBStatusType, uDBFieldList As udtByteArrayType, sBuffer As udtByteBufferType, uDBSearchKey As udtByteArrayType)


Declare Sub DBLOCK Lib "DBapiV2.dll" Alias "_DBLOCK@16" (sDBName As udtByteArrayType, sDBSetName As udtByteArrayType, iDBMode As Any, uDBStatus As udtDBStatusType)


Declare Sub DBUNLOCK Lib "DBapiV2.dll" Alias "_DBUNLOCK@16" (sDBName As udtByteArrayType, sDBSetName As udtByteArrayType, iDBMode As Any, uDBStatus As udtDBStatusType)


Declare Sub DBPUT Lib "DBapiV2.dll" Alias "_DBPUT@24" (sDBName As udtByteArrayType, sDBSetName As udtByteArrayType, iDBMode As Any, uDBStatus As udtDBStatusType, uDBFieldList As udtByteArrayType, sBuffer As udtByteBufferType)


Declare Sub DBUPDATE Lib "DBapiV2.dll" Alias "_DBUPDATE@24" (sDBName As udtByteArrayType, sDBSetName As udtByteArrayType, iDBMode As Any, uDBStatus As udtDBStatusType, uDBFieldList As udtByteArrayType, sBuffer As udtByteBufferType)


Declare Sub DBDELETE Lib "DBapiV2.dll" Alias "_DBDELETE@16" (sDBName As udtByteArrayType, sDBSetName As udtByteArrayType, iDBMode As Any, uDBStatus As udtDBStatusType)


Declare Sub DBCLOSE Lib "DBapiV2.dll" Alias "_DBCLOSE@16" (sDBName As udtByteArrayType, sDBSetName As udtByteArrayType, iDBMode As Any, uDBStatus As udtDBStatusType)


Declare Sub DBERROR Lib "DBapiV2.dll" Alias "_DBERROR@12" (uDBStatus As Any, sDBErrText As udtByteArrayType, iTextLen As Any)

 

Program HOST Role Comment
Visual Basic Client Program Windows Client Your program
DBapiV2.dll Windows Client RPC client
oncrpc.dll Windows Client RPC library for Windows
DBSERVER HP e3000 Server TurboIMAGE server for HP e3000
PORTMAP HP e3000 Application Launcher RPC Portmapper application

 

RPC Visual Basic Application

Consider an example:

A client/server database dump program on a remote machine.

 

 

 

 

 

 
Option Explicit

Dim CurForm As frmDocument

Sub ExportDatabase(ThisForm As frmDocument)
Dim i As Integer
Dim iFileno As Integer
Dim sFilenm As String

On Error GoTo edErrHandler

Set CurForm = ThisForm

iDBMode = 5
Call DBOPEN(sDBName, sDBPass, iDBMode, uDBStatus)
If uDBStatus.iStatus <> 0 Then
Call DispDBErrMsg("DBOPEN")

Exit Sub
End If

CurForm.lstOutput.AddItem "Data Set" & Space(14) & "Records"
CurForm.lstOutput.AddItem String(16, "-") & " -- - --------"

DoEvents

iDBMode = 203
Call DBINFO(sDBName, sDummy, iDBMode, uDBStatus, uDBSetList)
If uDBStatus.iStatus <> 0 Then
Call DispDBErrMsg("DBINFO(203)")

Exit Sub
End If

For i = 2 To uDBSetList.mbtSets(1) + 1
Call ExportSet(uDBSetList.mbtSets(i), iFileno)
Next i

iDBMode = 1
Call DBCLOSE(sDBName, sDummy, iDBMode, uDBStatus)
If uDBStatus.iStatus <> 0 Then
Call DispDBErrMsg("DBCLOSE(1)")
End If

On Error GoTo 0

Exit Sub

edErrHandler:
MsgBox "ED Err (" & Err.Number & ") " + Err.Description, vbOKOnly

Err.Clear
Exit Sub
End Sub

Sub ExportSet(iSetno As Integer, iFileno As Integer)
Dim i As Integer
Dim j As Integer
Dim cnt As Long
Dim sFilenm As String
Dim sDispStr As String
Dim sTmpSetName As String
Dim uSetno As udtIntegerType
Dim uItemno As udtIntegerType

uSetno.mitInteger = iSetno
LSet sDummy = uSetno
iDBMode = 202
Call DBINFO(sDBName, sDummy, iDBMode, uDBStatus, uDBSetInfo)
If uDBStatus.iStatus <> 0 Then
Call DispDBErrMsg("DBINFO(202)")

Exit Sub
End If

sTmpSetName = ""
For i = 1 To 16
sTmpSetName = sTmpSetName & Chr(uDBSetInfo.mbtSetName(i))
Next i

CurForm.lstOutput.AddItem sTmpSetName & " " & Right(String(5, " ") & Str(iSetno), 2) & " " & Chr(uDBSetInfo.mbtType) & " " & Right(String(9, " ") & Str(uDBSetInfo.mbtEntries), 8)

If Chr(uDBSetInfo.mbtType) = "A" Then
Exit Sub
End If

iDBMode = 104
Call DBINFO(sDBName, sDummy, iDBMode, uDBStatus, uDBItemList)
If uDBStatus.iStatus <> 0 Then
Call DispDBErrMsg("DBINFO(104)")

Exit Sub
End If

For i = 2 To uDBItemList.mbtItems(1) + 1
uItemno.mitInteger = uDBItemList.mbtItems(i)
LSet sDummy = uItemno
iDBMode = 102
Call DBINFO(sDBName, sDummy, iDBMode, uDBStatus, uDBItemInfo)
If uDBStatus.iStatus <> 0 Then
Call DispDBErrMsg("DBINFO(102)")

Exit Sub
End If

uDBSetItems(i - 1) = uDBItemInfo
Next i

DoEvents

sDispStr = ""

iDBMode = 3
LSet sDBSetName = uSetno
Call DBCLOSE(sDBName, sDBSetName, iDBMode, uDBStatus)
If uDBStatus.iStatus <> 0 Then
Call DispDBErrMsg("DBCLOSE(3)")

Exit Sub
End If

On Error GoTo esErrHandler

iFileno = FreeFile(0)

sFilenm = sExportPath
If Right(sFilenm, 1) <> "/" Then
sFilenm = sFilenm & "/"
End If
' sFilenm = sFilenm & sDBNameShort & "." & Format(iSetno, "00") & "v.exp"
i = InStr(sTmpSetName, " ")
If i = 0 Then
i = 17
End If
sFilenm = sFilenm & Left(sTmpSetName, i - 1) & ".txt"

Kill sFilenm

Open sFilenm For Output Shared As #iFileno

If bExtract Then
Call ConvertStringToBytes("@;", uDBFieldList, True)
cnt = 0

Do
iDBMode = 2
Call DBGET(sDBName, sDBSetName, iDBMode, uDBStatus, uDBFieldList, sBuffer, sDummy)
If uDBStatus.iStatus = 11 Then
Exit Do
End If

If uDBStatus.iStatus <> 0 Then
Call DispDBErrMsg("DBGET(2)")

Exit Sub
End If

cnt = cnt + 1

If cnt Mod 100 = 0 Then
If cnt > 100 Then
CurForm.lstOutput.RemoveItem CurForm.lstOutput.ListCount - 1
End If
CurForm.lstOutput.AddItem " Records read = " & cnt
End If

Call ExportRecord(iFileno)

DoEvents
Loop
End If

Close #iFileno

On Error GoTo 0

If bExtract Then
If cnt > 100 Then
CurForm.lstOutput.RemoveItem CurForm.lstOutput.ListCount - 1
End If

CurForm.lstOutput.AddItem " Records read = " & cnt
End If

Exit Sub

esErrHandler:
If Err.Number <> 53 Then
MsgBox "ES Err (" & Err.Number & ") " + Err.Description, vbOKOnly
End If

Err.Clear
Resume Next
End Sub

Sub ExportRecord(iFileno As Integer)
Dim iItem As Integer
Dim iField As Integer
Dim iBufPtr As Integer
Dim iBytes As Integer
Dim sRecord As String

On Error GoTo erErrHandler

sRecord = ""
iBufPtr = 1

For iItem = 1 To uDBItemList.mbtItems(1)
For iField = 1 To uDBSetItems(iItem).mbtCount
If iItem <> iField Then
sRecord = sRecord + sFieldSep
End If

Select Case Chr(uDBSetItems(iItem).mbtType)
Case "X", "U"
iBytes = uDBSetItems(iItem).mbtLength
Call ExportString(sRecord, iBufPtr, iBytes)
Case "I", "J"
iBytes = uDBSetItems(iItem).mbtLength * 2
If uDBSetItems(iItem).mbtLength = 1 Then
Call ExportInteger(sRecord, iBufPtr, iBytes)
ElseIf uDBSetItems(iItem).mbtLength = 2 Then
Call ExportLong(sRecord, iBufPtr, iBytes)
Else
MsgBox "Found Type " & Chr(uDBSetItems(iItem).mbtType) & " with length of " & Chr(uDBSetItems(iItem).mbtLength), vbOKOnly
End If
Case "K"
iBytes = uDBSetItems(iItem).mbtLength * 2
If uDBSetItems(iItem).mbtLength = 1 Then
Call ExportInteger(sRecord, iBufPtr, iBytes)
ElseIf uDBSetItems(iItem).mbtLength = 2 Then
Call ExportLong(sRecord, iBufPtr, iBytes)
Else
MsgBox "Found Type " & Chr(uDBSetItems(iItem).mbtType) & " with length of " & Chr(uDBSetItems(iItem).mbtLength), vbOKOnly
End If
Case "E"
iBytes = uDBSetItems(iItem).mbtLength * 2
If uDBSetItems(iItem).mbtLength = 2 Then
Call ExportSingle(sRecord, iBufPtr, iBytes)
ElseIf uDBSetItems(iItem).mbtLength = 4 Then
Call ExportDouble(sRecord, iBufPtr, iBytes)
Else
MsgBox "Found Type " & Chr(uDBSetItems(iItem).mbtType) & " with length of " & Chr(uDBSetItems(iItem).mbtLength), vbOKOnly
End If
Case Else
MsgBox "Found Type " & Chr(uDBSetItems(iItem).mbtType) & " with length of " & Chr(uDBSetItems(iItem).mbtLength), vbOKOnly
End Select

iBufPtr = iBufPtr + iBytes
Next iField
Next iItem

Print #iFileno, sRecord

On Error GoTo 0

Exit Sub

erErrHandler:
MsgBox "ER Err (" & Err.Number & ") " + Err.Description, vbOKOnly

Err.Clear
Resume Next
End Sub

Sub ExportString(sRecord As String, iBufPtr As Integer, iBytes As Integer)
Dim i As Integer
Dim nBytes As Integer

nBytes = iBytes
For i = iBufPtr + iBytes - 1 To iBufPtr Step -1
If Chr(sBuffer.mbtBytes(i)) <> " " Then
Exit For
End If

nBytes = nBytes - 1
Next i

sRecord = sRecord & Chr(34)

If nBytes > 0 Then
For i = 1 To nBytes
If sBuffer.mbtBytes(iBufPtr + i - 1) < 32 Then
sRecord = sRecord & Chr(92) & Format(Oct(sBuffer.mbtBytes(iBufPtr + i - 1)), "000")
Else
If sBuffer.mbtBytes(iBufPtr + i - 1) = 34 Or sBuffer.mbtBytes(iBufPtr + i - 1) = 92 Then
sRecord = sRecord & Chr(92)
End If
sRecord = sRecord & Chr(sBuffer.mbtBytes(iBufPtr + i - 1))
End If
Next i
End If

sRecord = sRecord + Chr(34)
End Sub

Sub ExportInteger(sRecord As String, iBufPtr As Integer, iBytes As Integer)
Dim i As Integer
Dim uInt As udtIntegerType
Dim uIntB As udtIntegerBytesType

For i = 1 To iBytes
uIntB.mbtBytes(i) = sBuffer.mbtBytes(iBufPtr + i - 1)
Next i

LSet uInt = uIntB

sRecord = sRecord & Format(uInt.mitInteger)
End Sub

Sub ExportLong(sRecord As String, iBufPtr As Integer, iBytes As Integer)
Dim i As Integer
Dim uLong As udtLongType
Dim uLongB As udtLongBytesType

For i = 1 To iBytes
uLongB.mbtBytes(i) = sBuffer.mbtBytes(iBufPtr + i - 1)
Next i

LSet uLong = uLongB

sRecord = sRecord & Format(uLong.mitLong)
End Sub

Sub ExportSingle(sRecord As String, iBufPtr As Integer, iBytes As Integer)
Dim i As Integer
Dim uSingle As udtSingleType
Dim uSingleB As udtSingleBytesType

For i = 1 To iBytes
uSingleB.mbtBytes(i) = sBuffer.mbtBytes(iBufPtr + i - 1)
Next i

LSet uSingle = uSingleB

sRecord = sRecord & Format(uSingle.mitSingle)
End Sub

Sub ExportDouble(sRecord As String, iBufPtr As Integer, iBytes As Integer)
Dim i As Integer
Dim uDouble As udtDoubleType
Dim uDoubleB As udtDoubleBytesType

For i = 1 To iBytes
uDoubleB.mbtBytes(i) = sBuffer.mbtBytes(iBufPtr + i - 1)
Next i

LSet uDouble = uDoubleB

sRecord = sRecord & Format(uDouble.mitDouble)
End Sub

Sub ConvertStringToBytes(OriginalStr As String, Strs As udtByteArrayType, StrToBytes As Boolean)
Dim i As Integer
Dim length As Integer

If StrToBytes Then
length = Len(OriginalStr)
Else
OriginalStr = ""
length = UBound(Strs.mbtBytes)
End If

For i = 1 To length
If StrToBytes Then
Strs.mbtBytes(i) = CByte(Asc(Mid(OriginalStr, i, 1)))
Else
OriginalStr = OriginalStr & Chr(Strs.mbtBytes(i))
End If
Next i
End Sub

Private Sub DispDBErrMsg(sType As String)
Dim iTextLen As Integer
Dim sNewline As String
Dim sDBErrText As udtByteArrayType
Dim sErrmsg As String

sNewline = vbCr & vbLf

iTextLen = 80
Call DBERROR(uDBStatus, sDBErrText, iTextLen)

Call ConvertStringToBytes(sErrmsg, sDBErrText, False)

sErrmsg = "DBError on " & sType & " : " & uDBStatus.iStatus & sNewline & sNewline & sErrmsg

MsgBox sErrmsg, vbOKOnly
End Sub

Installation and Configuration

This example distribution comes in as a single zip file.  It contains installation components for both the HP e3000 and the Windows computer.   

Prerequisites

  • Both the HP e3000 and the PC must be reachable by each other across a network.
  • The HP e3000 requires MPE/iX 5.5 or newer
  • The Windows 9x or NT computer requires Visual Basic 6 sp3 or newer.

Install Programs on HP e3000 

Install Programs on Windows Computer

Run setup.exe on the Windows computer. 

Getting something to work...

Compile and Execute the VB Sample Application

Finally, compile and execute the Visual Basic sample application.

 

 

download.gif (899 bytes) Download the source


Copyright (c) 1999 - 2000 Transformix Computer Corporation
Comments and suggestions to the Webmaster.