Okay, here it is...
Below is a sample of the actual socket program :
* $$ JOB JNM=ASMPROG,CLASS=0,DISP=H ,
* $$ LST CLASS=S,DISP=H
* $$ PUN CLASS=R,DISP=K,DEST=(*,DOUG)
// JOB ASMPROG ONLINE ASSEMBLER COMMAND LEVEL PROGRAM
// DLBL IJSYSPH,'LIBR.SYSPCH',0,SD
// EXTENT SYSPCH,SPAWKA,1,0,26010,300
ASSGN SYSPCH,DISK,VOL=SPAWKA,SHR
// LIBDEF *,SEARCH=(PRD2.TCPIP,PRD2.SCEEBASE,PRD2.COBLVSE,CADB.PROD, X
CADB.DATABASE,PRD2.PROD,PRD2.CONFIG,USER.ONLINE)
// LIBDEF PHASE,CATALOG=PRD2.TCPIP
// EXEC DFHEAP1$,PARM='XOPTS (CICS NOEPILOG)'
TITLE 'SOCKET - CICS SOCKET SERVER -
COMMON CODE'
PRINT NOGEN
***********************************************************************
* TERMINAL DATA AREA *
DFHEISTG DSECT , ******************************************************
INBUFF DS F
BUFFLENG DS F
ECB1 DS 14F
TCPDESC DS F
BUFLNGTH DS H
LNKPROG DS CL8
RECMSG DS CL30
CONSMSG DS CL30
BUFFERIN DS CL2048
EJECT
---------------------------------------------------------------------
* PROGRAM INITILIZATION *
---------------------------------------------------------------------
SOCKET DFHEIENT CODEREG=(R8)
USING SRBLOK,R7
BEGIN LA R7,ECB1 GET ADDRESS OF ECB
LA R5,BUFFERIN GET ADDRESS OF BUFFER
ST R5,INBUFF SAVE ADDRESS OF BUFFER
SOCKET OPEN,TCP,PASSIVE=YES,LOPORT=6000,DESC=TCPDESC,ECB=ECB1,-
CICS=YES
LTR R15,R15 DID IT WORK?
BNZ BADTCP NO
LA R7,ECB1 GET ADDRESS OF ECB
EXEC CICS WAIT EVENT ECADDR(R7)
EXEC CICS START TRANSID('SOCK')
RECV MVC BUFFLENG,=F'2048' SET BUFFER LENGTH
SOCKET RECEIVE,TCP,DATA=(INBUFF,BUFFLENG),DESC=TCPDESC, -
ECB=ECB1,CICS=YES
LTR R15,R15 DID IT WORK?
BNZ BADTCP NO
LA R7,ECB1 GET ADDRESS OF ECB
EXEC CICS WAIT EVENT ECADDR(R7)
TR BUFFERIN(256),TOEBCDIC TRANSLATE INPUT TO EBCDIC
TR BUFFERIN+256(256),TOEBCDIC TRANSLATE INPUT TO EBCDIC
TR BUFFERIN+512(256),TOEBCDIC TRANSLATE INPUT TO EBCDIC
TR BUFFERIN+768(256),TOEBCDIC TRANSLATE INPUT TO EBCDIC
TR BUFFERIN+1024(256),TOEBCDIC TRANSLATE INPUT TO EBCDIC
TR BUFFERIN+1280(256),TOEBCDIC TRANSLATE INPUT TO EBCDIC
TR BUFFERIN+1536(256),TOEBCDIC TRANSLATE INPUT TO EBCDIC
TR BUFFERIN+1792(256),TOEBCDIC TRANSLATE INPUT TO EBCDIC
CLC BUFFERIN+8(3),=C'QUIT ' END?
BE CLOSE YES
MVC LNKPROG,BUFFERIN MOVE PROGRAM NAME
CLC LNKPROG,=C'PROGNAME'
BE LINKXX
B CLOSE
LINKXX EXEC CICS LINK PROGRAM(LNKPROG) COMMAREA(BUFFERIN) -
LENGTH(2048)
SEND TR BUFFERIN(256),TOASCII TRANSLATE OUTPUT TO ASCII
TR BUFFERIN+256(256),TOASCII TRANSLATE OUTPUT TO ASCII
TR BUFFERIN+512(256),TOASCII TRANSLATE OUTPUT TO ASCII
TR BUFFERIN+768(256),TOASCII TRANSLATE OUTPUT TO ASCII
TR BUFFERIN+1024(256),TOASCII TRANSLATE OUTPUT TO ASCII
TR BUFFERIN+1280(256),TOASCII TRANSLATE OUTPUT TO ASCII
TR BUFFERIN+1536(256),TOASCII TRANSLATE OUTPUT TO ASCII
TR BUFFERIN+1792(256),TOASCII TRANSLATE OUTPUT TO ASCII
MVC BUFFLENG(4),=F'2048'
SOCKET SEND,TCP,DATA=(INBUFF,BUFFLENG),DESC=TCPDESC, -
ECB=ECB1,CICS=YES
LTR R15,R15 DID IT WORK?
BNZ BADTCP NO
LA R7,ECB1 GET ADDRESS OF ECB
EXEC CICS WAIT EVENT ECADDR(R7)
B RECV
CLOSE MVC RECMSG(12),=C'SOCK SERVER '
MVC RECMSG+12,BUFFERIN MOVE MESSAGE BACK FOR DISPLAY
MVC CONSMSG,RECMSG
EXEC CICS WRITE OPERATOR TEXT(CONSMSG)
QUIT SOCKET CLOSE,TCP,DESC=TCPDESC,ECB=ECB1,CICS=YES
LTR R15,R15 DID IT WORK?
BNZ BADTCP NO
LA R7,ECB1 GET ADDRESS OF ECB
EXEC CICS WAIT EVENT ECADDR(R7)
BADTCP EXEC CICS RETURN
LTORG
*
* EBCDIC TO ASCII
*
* 0 1 2 3 4 5 6 7 8 9 A B C D E F
TOASCII DC X'200102030405060708090A0B0C0D0E0F' 00-0F
DC X'101112131415161718191A1B1C1D1E1F' 10-1F
DC X'00000000000000000000000000000000' 20-2F
DC X'00000000000000000000000000000000' 30-3F
DC X'200000000000000000005A2E3C282B7C' 40-4F
DC X'2600000000000000000021242A293B5E' 50-5F
DC X'2D2F00000000000000007C2C255F3E3F' 60-6F
DC X'000000000000000000603A2340273D22' 70-7F
DC X'00616263646566676869008B00000000' 80-8F
DC X'006A6B6C6D6E6F707172000000000000' 90-9F
DC X'007E737475767778797A000000000000' A0-AF
DC X'00000000000000000000000000000000' B0-BF
DC X'7B414243444546474849000000000000' C0-CF
DC X'7D4A4B4C4D4E4F505152000000000000' D0-DF
DC X'5C00535455565758595A000000000000' E0-EF
DC X'303132333435363738390000000000FF' F0-FF
*
* ASCII TO EBCDIC
*
* 0 1 2 3 4 5 6 7 8 9 A B C D E F
TOEBCDIC DC X'000102030405060708090A0B0C0D0E0F' 00-0F
DC X'101112131415161718191A1B1C1D1E1F' 10-1F
DC X'405A7F7B5B6C507D4D5D5C4E6B604B61' 20-2F
DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' 30-3F
DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' 40-4F
DC X'D7D8D9E2E3E4E5E6E7E8E94AE04F5F6D' 50-5F
DC X'79818283848586878889919293949596' 60-6F
DC X'979899A2A3A4A5A6A7A8A9C06AD0A100' 70-7F
DC X'00000000000000000000000000000000' 80-8F
DC X'00000000000000000000000000000000' 90-9F
DC X'00000000000000000000000000000000' A0-AF
DC X'00000000000000000000000000000000' B0-BF
DC X'00000000000000000000000000000000' C0-CF
DC X'00000000000000000000000000000000' D0-DF
DC X'00000000000000000000000000000000' E0-EF
DC X'00000000000000000000000000000000' F0-FF
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
END
/*
* STEP2 : ASSEMBLE TRANSLATED SOURCE
CLOSE SYSPCH,04D
IF $RC > 4 THEN
GOTO EOJT
// DLBL IJSYSIN,'LIBR.SYSPCH',0
// EXTENT SYSIPT
ASSGN SYSIPT,DISK,VOL=SPAWKA,SHR
// OPTION CATAL,NODECK,SYM,ERRS
PHASE SOCKET ,*
INCLUDE DFHEAI
// EXEC ASMA90,SIZE=(ASMA90,64K),PARM='RENT,EXIT(LIBEXIT(EDECKXIT)), C
SIZE(MAX-200K,ABOVE)'
CLOSE SYSIPT,SYSRDR
IF $RC > 4 THEN
GOTO EOJT
* STEP3 LNKEDT ASSEMBLED PROGRAM
// EXEC LNKEDT
/. EOJT
/&
// JOB RESET
ASSGN SYSIPT,SYSRDR IF 1A93D, CLOSE SYSIPT,SYSRDR
ASSGN SYSPCH,04D IF 1A93D, CLOSE SYSPCH,04D
/&
* $$ EOJ
This is fairly unsophisticated, but here's how it works. This is a CICS
program that I start in our PLTPI. The first thing it does when a client
connects is start a second transaction to handle the next request. The task
listens in a passive mode for a client connection. The client actually
connects to TCP/IP and sends a record to initiate the process. The first 8
positions of the record is really the name of one of your CICS programs that
you want to execute. The rest of the record can be blanks or data you want
to give your mainframe. The SOCKET program translates from ascii to ebcdic
and LINKS to the program name you sent, passing any data into the COMMAREA.
The commarea size of the LINKED program should match the buffer size of the
SOCKET program, 2048 in this example. When the LINKED program is finshed it
places anything it wants to send the client in it's COMMAREA and issues an
EXEC CICS RETURN.
The SOCKET program gets that COMMAREA back into it's buffer, translates it
from ebcdic to ascii and SENDs it out the same Client.
I've used a Visual Basic Client myself, but our Applications Staff has a
Powerbuilder Client.
The Visual Basic is "event" driven. An example of the Form code follows:
Dim FileEnd As String
Private Sub cmdNext_Click()
strdata = ""
tcpClient.SendData "prognameDATADATADATADATA..."
End Sub
Private Sub cmdQuit_Click()
tcpClient.SendData "QUIT "
tcpClient.Close
Response = MsgBox("Connection Terminated", vbOKOnly, "Quit")
End
End Sub
Private Sub Form_Unload(Cancel As Integer)
tcpClient.SendData "QUIT "
Response MsgBox("Connection Terminated", vbOKOnly, "Quit")
End
End Sub
Private Sub Form_Load()
'The name of the Winsock control is tcpClient.
'Note: to specify a remote host, you can use either the IP
'address (ex: "121.111.1.1") or the computer's "friendly"
'name as shown here.
FileEnd = ""
tcpClient.RemoteHost = "10.1.5.13"
tcpClient.RemotePort = 6000
Static strhold As String
'Invoke the Connect method to initiate a connection
tcpClient.Connect
End Sub
Private Sub tcpClient_DataArrival(ByVal bytesTotal As Long)
Static strhold As String
Static FileEnd As String
Static strdata1 As String
Static strdata As String
If FileEnd <> "END" Then
tcpClient.GetData strdata1
strdata = strdata + strdata1
Text1.Text = strdata
strhold = strdata
FileEnd = Mid(strdata, 19, 3)
tcpClient.SendData strhold
End If
End Sub
We use this in a production environment and it's been very stable and
reliable.