[continued from previous message]

!********************************************************************
!
! Copyright 2011 by Dave Froble Enterprises, Inc.
!
! This program is the sole property of Dave Froble
! Enterprises, Inc. and may not be copied in whole
! or in part without the express written permission
! of Dave Froble Enterprises, Inc.
!
!********************************************************************
!
! Modification history:
!
!********************************************************************

Option Size = ( Integer Word , Real Double )
%Include "FL:SUPLIB.INC"
%Include "FL:KBCOMM.INC"
%Include "FL:TCP_STRUCT.INC"
%Include "SYS$SHARE:TCPIP$INETDEF.BAS"


%Include "$SSDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
%Include "$IODEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
%Include "$JPIDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"

External Long Function SYS$ASSIGN, ! System services &
SYS$DASSGN, &
SYS$QIOW


Declare Long ByteCount%, ! Longwords &
Long ClientNameLen%, &
Long ClientPort%, &
Long D9%, &
Long ReuseAdrVal%, &
Long ShareVal%, &
Long Sock%, &
Long Stat%, &
Long Temp%


!**************************************************
! Declare Variables of User Defined Structures
!**************************************************

Declare IOSB_Struct IOSB, ! I/O status blk &
ItemList_2 ServerItemLst, ! Server item list &
ItemList_2 SockOptItemList, ! Socket options list &
ItemList_2 ShareSockItemList, ! Share sock list &
ItemList_3 ClientItemLst, ! Client item list &
Sock_Addr ClientAdr, ! Client IP adr/port &
Sock_Addr ServerAdr, ! Server IP adr/port &
Socket_Options SocketOption, ! Socket options &
Buff ClientName, ! Client name buffer &
Buff ServerName, ! Server name buffer &
IP_Adr IP, ! Ip address &
Buff MSG ! Message buffer



200 !**************************************************
! Program Initialization
!**************************************************

GoSub 4990

Print #KB% ! Display banner
Print #KB%, P8$; " "; DATEL(D9%,4%); " "; TIME$(0%)

BuffSize% = LEN(MSG::BUF$)


!**************************************************
! Read from command file, get Socket Device
!**************************************************

Print #KB%
Print #KB%, "Beginning to read command file"

!Open "SYS$INPUT:" As File #91%
Open "TT:" As File #91%
Print "Socket device> ";
Linput #91%, SockDev$
Print "Client IP> ";
Linput #91%, ClientIP$
Print "Client port> ";
Linput #91%, Z2$
Close #91%

Call NRVAL( Z2$ , Z2 , E% )
ClientPort% = Z2

Print #KB%
Print #KB%, "Command file read:"
Print #KB%, " Socket device is: "; SockDev$
Print #KB%, " Client IP: "; ClientIP$
Print #KB%, " Client port:"; ClientPort%


!**************************************************
! Open MailBox, read data
!**************************************************

!Print #KB%
!Print #KB%, "Beginning to read MailBox"

!Open Dev$ as file 91%
!Field #91%, 32% as Mbx$
!Get #91%
!SockDev$ = Trm$(Mbx$)
!Print #KB%, Mbx$; SockDev$
!Get #91%
!Print #KB%, Mbx$
!Call NRVAL( Trm$(Mbx$) , Z1 , E% )
!ClientIP% = Z1
!Get #91%
!Print #KB%, Mbx$
!Call NRVAL( Trm$(Mbx$) , Z2 , E% )
!ClientPort% = Z2

Print #KB%, "ClientIP%"; ClientIP%
IP::IP% = ClientIP%
ClientIP$ = NUM1$(Ascii(IP::IP1$)) + "." &
+ NUM1$(Ascii(IP::IP2$)) + "." &
+ NUM1$(Ascii(IP::IP3$)) + "." &
+ NUM1$(Ascii(IP::IP4$))

!Print #KB%
!Print #KB%, "Mailbox read:"
!Print #KB%, " Socket device: "; SockDev$
!Print #KB%, " Client IP: "; ClientIP$
!Print #KB%, " Client port:"; ClientPort%


!**************************************************
! Assign a channel to Socket Device
!**************************************************

Stat% = SYS$ASSIGN( SockDev$ , ConnectCh% , , )
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
Print #KB%, "Unable to assign connection channel - "; E$
GoTo 4900
End If

Print #KB%, "Internal VMS channel for connection socket:"; ConnectCh%


! Now tell listener we have the socket

!Lset Mbx$ = "Done"
!Put #91%
!Close #91%

Input "Wait for listener to close socket", I0$


1000 !************************************************************
! Main Processing
!************************************************************


1100 !**************************************************
! Read the Incoming Message
!**************************************************
Read_Msg:
Print #KB%, "Reading client message ...."

GoSub Read_Socket ! Read byte count
If E%
Then Print #KB%, E$
GoTo Deassign_Channel
End If

Print #KB%, ByteCount%; "bytes read from socket"
Call PARSE( Left(MSG::BUF$,ByteCount%) , LF , Z$ , Msg$ )
Call NIVAL( Z$ , MsgLen% , E% )
Print #KB%, Len(Msg$); "message bytes in first buffer"
GoTo Msg_Completed If Len(Msg$) >= MsgLen%

Read_Loop:
GoSub Read_Socket
If E%
Then Print #KB%, E$
GoTo Deassign_Channel
End If
Print #KB%, ByteCount%; "bytes read from socket"
Msg$ = Msg$ + LEFT(MSG::BUF$,ByteCount%)
GoTo Read_Loop Unless Len(Msg$) >= MsgLen%


!**************************************************
! Message Received, Display Message
!**************************************************
Msg_Completed:
Print #KB%
Print #KB%, "Message received, message is"; Len(Msg$); "bytes"
Print #KB%, Msg$


!**************************************************
! Reply to Client
!**************************************************
Write_Msg:
Print #KB%, "Writing message to client ...."

RET.MSG$ = "Worker process received <" + Msg$ + ">"


Write_Loop:
NumByte% = Len(RET.MSG$)
If FnWriteSocket%( NUM1$(NumByte%)+LF ) ! Write # bytes
Then Print #KB%, "Error in write NumByte% - "; E$
GoTo Deassign_Channel
End If

While Len(RET.MSG$)
Z$ = Left(RET.MSG$,BuffSize%)
RET.MSG$ = Right(RET.MSG$,BuffSize%+1%)
If FnWriteSocket%( Z$ )
Then Print #KB%, "Error in write - "; E$
GoTo Deassign_Channel
End If
Next


!**************************************************
! Break the Connection
! Deassign Channel
!**************************************************
Deassign_Channel:
Print #KB%, "Deassigning connection channel ...."

Stat% = SYS$DASSGN( ConnectCh% By Value )
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
Print #KB%, "Unable to deassign connection channel - "; E$
GoTo 4900
End If

GoTo 4950


4900 !************************************************************
! Exit Point
!************************************************************

Print #KB%
E% = KBINPT( "Type <CR> to exit ...." , 0% , I0$ , E% )


4950 Print #KB%
Print #KB%, "End of "; P8$
Print #KB%
GoTo 32760



!************************************************************
! Subroutines
!************************************************************


4990 !**************************************************
! Program Initialization
!**************************************************

P9$ = "TCP_WORKER" ! Program name
P8$ = "Worker Program To Service A Connection Request"
On Error GoTo 32000 ! Enable error trapping
KB% = 99% ! Keyboard channel
KB.MODE% = 0% ! Mode for keyboard ope
n
Call KBOPEN( KB% , KB.MODE% ) ! Open keyboard
X3% = 0% ! No cursor addressing
Z% = CTRLC ! ^C trap
Call SYPRAM(U1$,U1%,U2$,U3$,D9%,U5$,T2$) ! Read sys parameters
E1$ = " not a valid " ! Std error text
E2$ = "Unable to " ! Std error text
DI0$ = STRING$(4%,0%) ! DI zero string
Return !



6800 !**************************************************
! Read From Socket
!**************************************************
Read_Socket:
Stat% = SYS$QIOW( , ! Event flag &
ConnectCh% By Value, ! VMS channel &
IO$_READVBLK By Value, ! Function code &
IOSB::Stat%, ! I/O status block &
, ! AST routine &
, ! AST parameter &
MSG::BUF$ By Ref, ! P1 - I/O buffer &
BuffSize% By Value, ! P2 - length of buffer
&
, ! P3 &
, ! P4 &
, ! P5 &
) ! P6

If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
E$ = "Unable to queue read client message - " + E$
E% = -1%
Return
End If

Stat% = IOSB::Stat%
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
E$ = "Unable to read client message - " + E$
E% = -1%
Return
End If

ByteCount% = IOSB::Cnt%
E% = 0%

Return



20000 !**************************************************
! Write to Socket
!**************************************************

Def* FnWriteSocket%( Z0$ )

MSG::BUF$ = Z0$
ByteCount% = Len( Z0$ )

Stat% = SYS$QIOW( , ! Event flag &
ConnectCh% By Value, ! VMS channel &
IO$_WRITEVBLK By Value, ! Function code &
IOSB::Stat%, ! I/O status block &
, ! AST routine &
, ! AST parameter &
MSG::BUF$ By Ref, ! P1 - I/O buffer &
LEN(Z0$) By Value, ! P2 - length of buffer
&
, ! P3 - remote address &
, ! P4 &
, ! P5 &
) ! P6

If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
E$ = "Unable to queue write to socket - " + E$
SaveStat% = Stat%
FnWriteSocket% = -1%
Exit Def
End If

If ( IOSB::Stat% And SS$_NORMAL ) = 0%
Then If IOSB::Stat% = SS$_ABORT &
Or IOSB::Stat% = SS$_CANCEL
Then E$ = "Timeout"
Else Call VMSERR( IOSB::Stat% , E$ )
End If
E$ = "Unable to write to socket - " + E$
SaveStat% = IOSB::Stat%
FnWriteSocket% = -1%
Exit Def
End If

Fnend



32000 !******************** ERROR TRAPS ********************


32700 Print ! Final error trap
Print "Unforseen error detected in <"; P9$; ">"
On Error GoTo 0

32760

32766 Chain U1$ Unless U1$=""


32767 End

--
David Froble Tel: 724-529-0450
Dave Froble Enterprises, Inc. E-Mail: davef@tsoft-inc.com
DFE Ultralights, Inc.
170 Grimplin Road
Vanderbilt, PA 15486

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)