C
C File name:	UDPSAMPLE.FOR
C Product:	TCPware for OpenVMS
C Version:	V5.6
C Edit level:	12
C
C Copyright (c) 2001, 2002 by
C Process Software LLC
C Framingham, Massachusetts
C
C Copyright (c) 2000 by
C Process Software
C Framingham, Massachusetts
C
C This software is furnished under a  license  for  use  on  a
C single  computer  system  and  may  be  copied only with the
C inclusion of the above copyright notice.  This  software, or
C any  other  copies thereof, may not be provided or otherwise
C made available to any other person except for  use  on  such
C system  and to one who agrees to these license terms.  Title
C to and ownership of the software shall at all  times  remain
C in Process Software LLC's name.
C
C The information  in  this  document  is  subject  to  change
C without  notice  and should not be construed as a commitment
C by  Process Software LLC.   Process Software LLC assumes  no
C responsibility for any errors that may appear in this document.
C
C	Erik Antelman			Febuary 1987
C
C This is a sample FORTRAN program that uses the UDPDRIVER
C services to transmit or receive datagrams.  This program:
C	o Prompts for the operation (transmit or receive),
C	o Prompts for a destination host name (if transmit)
C	o Prompts for the port number
C	o Prompts for the number of datagrams
C	o Opens the receive port (if receive)
C	o Transmits or receives a data datagram, and
C	o Closes the receive port (if receive).
C
	PROGRAM		UDPSAMPLE
	INCLUDE		'($IODEF)'

	EXTERNAL	HNS_LOOKUPHOST
	INTEGER*4	HNS_LOOKUPHOST
	EXTERNAL	SYS$QIOW, SYS$ASSIGN
	INTEGER*4	SYS$QIOW, SYS$ASSIGN

	INTEGER*4	ISTAT, REPEAT, ECBDSC(2), IA, I, J
	INTEGER*2	UDP_CHAN, IOSB(4), INLEN, SRCL

	CHARACTER	DIRECTION
	CHARACTER*32	SRCS
	CHARACTER*132	STRING

	BYTE		PACKET(256), IA_B(4)

	EQUIVALENCE	(IA_B(1),IA)

	STRUCTURE	/SRCDST_S/
		INTEGER*4	SIA
		INTEGER*2	SPN, %FILL
		INTEGER*4	DIA
		INTEGER*2	DPN, %FILL
	END STRUCTURE

	RECORD	/SRCDST_S/	SRCDST

	STRUCTURE	/ECB_ENTRY/
		INTEGER*2	PID
		INTEGER*4	VALUE
	END STRUCTURE

	RECORD /ECB_ENTRY/	ECB(1)

	TYPE *,'UDPDRIVER SAMPLE PROGRAM'
C
C	Prompt the user for the host name, port number, and
C	transfer direction:
C
	SRCDST.SIA = 0
	SRCDST.SPN = 0
	SRCDST.DIA = 0
	SRCDST.DPN = 0

100	TYPE 101
101	FORMAT (' Operation (T=Transmit, R=Receive) ? ',$)
	ACCEPT 103, DIRECTION
103	FORMAT (A)
	IF (DIRECTION .EQ. 't') DIRECTION = 'T'
	IF (DIRECTION .EQ. 'r') DIRECTION = 'R'
	IF ((DIRECTION .NE. 'T') .AND. (DIRECTION .NE. 'R')) GOTO 100

        IF (DIRECTION .EQ. 'T') THEN
	  CALL LIB$GET_INPUT(STRING,
     +	                     'Destination Host Name ? ',INLEN)
	  ISTAT = HNS_LOOKUPHOST(STRING(1:INLEN),SRCDST.DIA)
	  IF (.NOT. ISTAT) THEN
	    TYPE *,'%SAMPLE-F-Failed to find host''s entry'
	    GOTO 1000
	  END IF
	  TYPE 104
104	  FORMAT (1X,'Destination Port Number ? ',$)
	  ACCEPT *,SRCDST.DPN
	ELSE
	  TYPE 121
121	  FORMAT (1X,'Port Number to Receive on ? ',$)
	  ACCEPT *,SRCDST.SPN
	END IF

	TYPE 131
131	FORMAT (' Times To Repeat Operation ? ',$)
	ACCEPT *,REPEAT
C
C	Assign a channel to UDP driver:
C
	ISTAT = SYS$ASSIGN('_UDP0:',UDP_CHAN,,)
	IF (.NOT. ISTAT) THEN
	  TYPE *, '%SAMPLE-F-Failed to assign _UDP0:'
	  GOTO 1000
	END IF

	IF (DIRECTION .EQ. 'R') GOTO 500
C
C	Transmit datagrams containing the current date/time:
C
	DO I=1,REPEAT
	  CALL LIB$DATE_TIME(STRING)
	  STRING = 'The current date and time is '//
     +	           STRING(1:35)//CHAR(13)//CHAR(10)
	  J = INDEX(STRING,CHAR(10))
	  ISTAT = SYS$QIOW(,%VAL(UDP_CHAN),%VAL(IO$_WRITEVBLK),
     +	                   IOSB,,,%REF(STRING),%VAL(J),
     +	                   SRCDST,,,)
	  IF (ISTAT) ISTAT = IOSB(1)
	  IF (.NOT. ISTAT) TYPE *,'%SAMPLE-W-Failed to transmit'
	  IF (ISTAT) TYPE 401,J,STRING(1:J)
	END DO
	TYPE *,'%SAMPLE-I-Transmitted ',REPEAT,' datagrams.'
	GO TO 1000

401	FORMAT (1X,'Transmitted datagram of ',I5,' bytes: ',/,
     +	        1X,<J>A)
C
C	Receive datagrams until an error status is returned:
C
500	ECB(1).PID = 1
	ECB(1).VALUE = SRCDST.SPN
	ECBDSC(1) = 6
	ECBDSC(2) = %LOC(ECB)
	ISTAT = SYS$QIOW(,%VAL(UDP_CHAN),%VAL(IO$_SETMODE
     +	                 .OR. IO$M_CTRL .OR. IO$M_STARTUP),
     +	                 IOSB,,,,ECBDSC,,,,)
	IF (ISTAT) ISTAT = IOSB(1)
	IF (.NOT. ISTAT) THEN
	  TYPE *,'%SAMPLE-F-Error during open',ISTAT
	  GOTO 1000
	END IF
C
C	Receive datagrams:
C
	DO I=1,REPEAT
	  ISTAT = SYS$QIOW(,%VAL(UDP_CHAN),%VAL(IO$_READVBLK),
     +	                   IOSB,,,PACKET,%VAL(256),SRCDST,,,)
	  IF (ISTAT) ISTAT = IOSB(1)
	  IF (.NOT. ISTAT) GOTO 590
	  IA = SRCDST.SIA
	  CALL LIB$SYS_FAO('!UB.!UB.!UB.!UB,!UW',SRCL,SRCS,
     +	                   %VAL(IA_B(1)),%VAL(IA_B(2)),
     +	                   %VAL(IA_B(3)),%VAL(IA_B(4)),
     +	                   %VAL(SRCDST.SPN))
	  TYPE 501,IOSB(2),SRCS(1:SRCL),(PACKET(J),J=1,IOSB(2))
	END DO
	TYPE *,'%SAMPLE-I-Received ',REPEAT,' datagrams.'
C
C	Close the port:
C
590	ISTAT = SYS$QIOW(,%VAL(UDP_CHAN),%VAL(IO$_SETMODE .OR.
     +	        IO$M_CTRL .OR. IO$M_SHUTDOWN),IOSB,,,,,,,,)
	IF (ISTAT) ISTAT = IOSB(1)
	IF (.NOT. ISTAT) TYPE *,'%SAMPLE-F-Error during close'
	GO TO 1000

501	FORMAT (1X,'Received datagram of ',I5,' bytes from ',
     +	        A<SRCL>,':',/,1X,<IOSB(2)>A)

1000	END