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.  

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.

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.   

Install Programs on HP e3000 

Install Programs on Windows Computer

Run setup.exe on the Windows computer. 

Getting something to work...

Download the source