Visual Basic and Cobol - Custom Server Sample

The following files, available for download are a simple sample of how a custom server could be written.

VB SA01

Option Explicit
Dim SA

Private Sub Form_Load()

Set SA = CreateObject("MdmSA.Session")

End Sub

Private Sub GetData_Click()

If (SA.ConnectStatus) Then
Screen.MousePointer = 11
SA.NetWrite ("G")
Text1.Text = SA.NetRead(68, True)
Screen.MousePointer = 0
End If

End Sub

Private Sub Logon_Click()

Screen.MousePointer = 11
If (SA.ConnectStatus) Then
SA.NetWrite ("Q")
SA.Disconnect
End If
SA.HostAddress = "yourhost"
SA.Port = 21001
SA.VendorId = 65
SA.LoginUser = "yourname"
SA.LoginAccount = "youracct"
Screen.MousePointer = 0
SA.UserPassword = InputBox("Password for user (" + SA.LoginUser + ")")
Screen.MousePointer = 11
If (Not SA.Connect) Then
MsgBox ("Connection failed")
End If
Screen.MousePointer = 0

End Sub

Private Sub Logout_Click()

Screen.MousePointer = 11
SA.NetWrite ("Q")
SA.Disconnect
Screen.MousePointer = 0

End Sub

SA01

IDENTIFICATION DIVISION.
PROGRAM-ID. SA01.
DATE-WRITTEN. 02/10/98.
DATE-COMPILED.
AUTHOR. MINISOFT.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. HP-3000.
OBJECT-COMPUTER. HP-3000.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 DATA-BUFFER.
05 SALES-REGION-1 PIC X(4).
05 SALES-TOTAL-1 PIC S9(11).
05 SALES-REGION-2 PIC X(4).
05 SALES-TOTAL-2 PIC S9(11).
05 SALES-REGION-3 PIC X(4).
05 SALES-TOTAL-3 PIC S9(11).
05 SALES-REGION-4 PIC X(4).
05 SALES-TOTAL-4 PIC S9(11).
05 SALES-REGION-5 PIC X(4).
05 SALES-TOTAL-5 PIC S9(11).
01 ACTION PIC X.
01 NET-CD PIC S9(4) COMP.
01 RLEN PIC S9(4) COMP.

PROCEDURE DIVISION.

10-MAIN-LINE.
CALL "\NET_OPEN" USING 0, 65 GIVING NET-CD.
IF NET-CD = -1 THEN
DISPLAY "NET_OPEN ERROR"
PERFORM 15-END-PROG
ELSE DISPLAY "STARTED".
PERFORM 30-OPEN-DATA-BASE.
PERFORM 20-DO-ACTION
UNTIL ACTION = "Q".
PERFORM 15-END-PROG.

15-END-PROG.
CALL "\NET_CLOSE" USING \NET-CD\.
PERFORM 40-CLOSE-DATA-BASE.
DISPLAY "COMPLETE".
STOP RUN.

20-DO-ACTION.
CALL "\NET_READ" USING \NET-CD\, ACTION, 1 GIVING RLEN.
IF RLEN = -1 THEN
DISPLAY "NET_READ ERROR"
PERFORM 15-END-PROG
ELSE DISPLAY "In DO-ACTION".
IF ACTION = "G"; THEN
PERFORM 50-GET-RECORD
PERFORM 60-SEND-RECORD
ELSE NEXT SENTENCE.

30-OPEN-DATA-BASE.
DISPLAY "OPEN-DATA-BASE"

40-CLOSE-DATA-BASE.
DISPLAY "CLOSE-DATA-BASE"

50-GET-RECORD.
MOVE "USNE" TO SALES-REGION-1.
MOVE 96049737 TO SALES-TOTAL-1.
MOVE "USCE" TO SALES-REGION-2.
MOVE 65859530 TO SALES-TOTAL-2.
MOVE "USSO" TO SALES-REGION-3.
MOVE 85523299 TO SALES-TOTAL-3.
MOVE "USSW" TO SALES-REGION-4.
MOVE 75286145 TO SALES-TOTAL-4.
MOVE "USWE" TO SALES-REGION-5.
MOVE 132598367 TO SALES-TOTAL-5.

60-SEND-RECORD.
CALL "\NET_WRITE" USING \NET-CD\ DATA-BUFFER, 68 GIVING RLEN.
IF RLEN = -1 THEN
DISPLAY "NET_WRITE ERROR"
PERFORM 15-END-PROG
ELSE DISPLAY "In SEND-RECORD".

SA01NLD

SA01OBJ
NIFOBJ.MM.MINISOFT

Compile and Link for SA01

COB85XL SA01,SA01OBJ

LINK FROM=^SA01NLD;TO=SA01TEST.MM.MINISOFT;CAP=IA,BA,PH,PM

Add this to MSJOB.MM.MINISOFT

!SETVAR MSSERVER000065 "21001 0 SA01TEST.MM.MINISOFTS"

SA01CMD

RUN SERVER.MM.MINISOFT;PARM=16640;INFO="21001SA01TEST.MM.MINISOFT"

SA01JOB

!JOB SA01JOB,MGR.MINISOFT,MM;OUTCLASS=LP,1
!RUN SERVER.MM.MINISOFT;PARM=16640;INFO="21001 SA01TEST.MM.MINISOFT"
!EOJ