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
SA01CMD
SA01JOB
!JOB SA01JOB,MGR.MINISOFT,MM;OUTCLASS=LP,1 !RUN SERVER.MM.MINISOFT;PARM=16640;INFO="21001 SA01TEST.MM.MINISOFT" !EOJ