OpenVMS Source Code Demos

BASIC-TCPWARE-FTP-SAMPLE.BAS

1000	%title "VAX_BASIC_TCPWARE_FTP_SAMPLE.BAS"
	%ident "version 1.00"
	!0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
	!1         2         3         4         5         6         7         8         9         0         1         2         3
	!=========================================================================================================================
	! Title  : VAX_BASIC_TCPWARE_FTP_SAMPLE.BAS"
	! Author : Neil S. Rieck	(Kitchener/Waterloo/Cambridge, Ontario, Canada)
	!	 :			(http://www3.sympatico.ca/n.rieck) (mailto:n.rieck@sympatico.ca)
	! Purpose: to explore the possibility of controlling an FTP transfer from within VAX-BASIC applications
	! Notes  : 1.	written in VAX BASIC 3.8 running under OpenVMS 6.2 using Process Software's TCPware 5.3
	!	   2.	derived from file "ftp_sample.c" in TCPware's example directory which is
	!		copyrighted (c) by Process Software Corporation of Framingham, Massachusetts, USA.
	!	   3.	by declaring passing mechanisms in the "external" declarations we won't need to use VAX-BASIC's
	!		"LOC" function statement to substitute for DEC-Cs ampersand (address reference)
	!	   4.	optionally, rename this file to "ftp_sample.bas"
	!	   5.	build the executable as follows:
	!		$ basic  ftp_sample.bas
	!		$ link   ftp_sample, sys$input/options
	!			sys$share:tcpware_ftplib_shr/share
	!			sys$share:tcpware_socklib_shr/share
	!	   6.	interface to dcl as a foreign command like so:
	!		$ftp_sample :== $ sys$help:ftp_sample.exe
	!=========================================================================================================================
	! History:
	! ver who when   what
	! --- --- ------ ---------------------------------------------------------------------------------------------------------
	! 100 NSR 990619 1. original program
	!=========================================================================================================================
	option type =explicit				! no kid stuff...
	set no prompt
	!
	%include "$ssdef" %from %library "sys$library:basic$starlet"	! extract vms "ss" definitions
	!
	declare long constant bufsize% = 1024%		 ! value recommended in the TCPware programmer's guide
	!
	declare	long	rc%				,! return code			&
			ccb%				,! connection control block	&
			debug_flag%			,!				&
			test_case%			,!				&
		string	choice$				,!				&
			host_name$			,!				&
			remote_dir$			,!				&
			junk$				,!				&
			user_name$			,!				&
			user_pass$			 !
	!
	external long function ftp_account(		long by value	,		! declaration not yet tested	&
							string by desc	)		!
	!
	external long function ftp_allocate_ccb(	long by ref	)		!
	!
	external long function ftp_append_file(		long by value	,		! declaration not yet tested	&
							string by desc	,		!				&
							string by desc	,		!				&
							long by ref	,		!				&
							long by ref	)		!
	!
	external long function ftp_close_connection(	long by value	)		!
	!
	external long function ftp_create_directory(	long by value	,		! declaration not yet tested	&
							string by desc	)		!
	!
	external long function ftp_deallocate_ccb(	long by ref	)		!
	!
	external long function ftp_delete_directory(	long by value	,		! declaration not yet tested	&
							string by desc	)		!
	!
	external long function ftp_delete_file(		long by value	,		! declaration not yet tested	&
							string by desc	)		!
	!
	external long function ftp_get_ccb(		long by value	,		! declaration not yet tested	&
							long by ref	,		!				&
							long by ref	,		!				&
							word by ref	)		!
	!
	external long function ftp_get_file(		long by value	,		! declaration not yet tested	&
							string by desc	,		!				&
							string by desc	,		!				&
							long by ref	,		!				&
							long by ref	)		!
	!
	external long function ftp_get_list(		long by value	,		!				&
							string by desc	,		!				&
							string by desc	)		!
	!
	external long function ftp_get_name_list(	long by value	,		!				&
							string by desc	,		!				&
							string by desc	)		!
	!
	external long function ftp_login_user(		long by value	,		!				&
							string by desc	,		!				&
							string by desc	)		!
	!
	external long function ftp_open_connection(	long by value	,		!				&
							long by ref	,		!				&
							string by desc	,		!				&
							word by ref	,		!				&
							long by ref	)		!
	!
	external long function ftp_password(		long by value	,		!				&
							string by desc	)		!
	!
	external long function ftp_print_directory(	long by value	,		! declaration not yet tested	&
							string by desc	,		!				&
							word by ref	)		!
	!
	external long function ftp_put_file(		long by value	,		!				&
							string by desc	,		!				&
							string by desc	,		!				&
							long by ref	,		!				&
							long by ref	)		!	
	!
	external long function ftp_quote(		long by value	,		!				&
							string by desc	)		!
	!
	external long function ftp_rename_file(		long by value	,		! declaration not yet tested	&
							string by desc	,		!				&
							string by desc	)		!
	!
	external long function ftp_set_debug(		long by value	,		!				&
							long by ref	,		!				&
							long by ref	)		! ??? must test...
	!
	external long function ftp_set_directory(	long by value	,		!				&
							string by desc	)		!
	!
	external long function ftp_set_pasv(		long by value	,		!				&
							long by ref	)		!
	!
	external long function ftp_set_stru(		long by value	,		!				&
							string by desc	)		!
	!
	external long function ftp_set_type(		long by value	,		! declaration not yet tested	&
							string by desc	)		!
	!
	external long function ftp_user(		long by value	,		!				&
							string by desc	)		!
	!
	!==========================================================================================
	!
	print "VAX_BASIC_TCPWARE_FTP_SAMPLE.BAS"
	print "================================"
	!
	!	<<< have the system allocate a connection control block and save the address in ccb% 
	!
	print ">>> ftp func: allocate"
	rc% = ftp_allocate_ccb( ccb% )					! allocate a ccb and then address in ccb%
	gosub display_rc
	!
	!	<<< set the debug flag >>>
	!
	!	note: this is bit sensitive. 1=Command, 2=Reply, 3=Both
	!	source: TCPWARE_INCLUDE:ftpdef.h
	!
	input ">>> ftp debug: C/ommand, R/eply, B/oth, O/ff (default=B/oth) ";choice$
	choice$ = edit$(choice$,32+4+2)
	select choice$
	    case "O"							! O/ff
		debug_flag% = 0%					!
	    case "C"							! C/ommand (send)
		debug_flag% = 1%					!
	    case "R"							! R/eply (receive)
		debug_flag% = 2%					!
	    case else							! B/oth
		debug_flag% = 3%					!
	end select
	print ">>> set debug to: ";debug_flag%
	rc%= ftp_set_debug( ccb%, debug_flag%, )			! leave last parameter BLANK
	gosub display_rc
	!
	!	<<< open a connection >>>
	!
	input ">>> host name? (default=venera.isi.edu) ";host_name$
	host_name$ = edit$(host_name$, 4%+2%)				! no controls or white space
	host_name$ = "venera.isi.edu" if host_name$ = ""
	!
	!	note: it isn't stated in the manual, but you'll get an error if timeout isn't >=20 or 0
	!
	print ">>> open"
	rc% = ftp_open_connection( ccb%,, host_name$,, 20%)
	gosub display_rc
	!
	!	<<< do a user login >>>
	!
	input "user name? (default=anonymous) "; user_name$
	user_name$ = edit$( user_name$, 4%+2%)				! no controls or white space
	user_name$ = "anonymous" if user_name$ = ""
	!
	input "user pass? (default=anybody@your-site.com) "; user_pass$
	user_pass$ = edit$( user_pass$, 4%+2%)				! no controls or white space
	user_pass$ = "anybody@venera.isi.edu" if user_pass$ = ""
	!
	print "login method: "
	print "  method: 1=login_user (default)"
	print "  method: 2=user - password"
	print "  method: 3=quote"
	input "method? (1-3, default=1) ";junk$
	!
	select junk$
	    case "2"							! user - password
		print ">>> ftp func: user"
		rc% = ftp_user		( ccb%, user_name$ )
		gosub display_rc
		!
		print ">>> ftp func: password"
		rc% = ftp_password	( ccb%, user_pass$ )
		gosub display_rc
	    case "3"							! quote
		print ">>> ftp func: quote (sending USER via quote method)"
		rc% = ftp_quote( ccb%, "USER "+ user_name$ )
		gosub display_rc
		!
		print ">>> ftp func: quote (sending PASS via quote method)"
		rc% = ftp_quote( ccb%, "PASS "+ user_pass$ )
		gosub display_rc
	    case else							! login_user
		print ">>> ftp func: login user"
		rc% = ftp_login_user	( ccb%, user_name$ , user_pass$ )
		gosub display_rc
	end select
	!
	!	<<< get a directory listing >>>
	!
	print ">>> ftp func: get list"
	rc% = ftp_get_list( ccb%, "", "SYS$OUTPUT")
	gosub display_rc
	!
	!	<<< get a directory listing (2cd time) >>>
	!
	!	note: in this list...
	!	1. only file names are listed
	!	2. only one version of any file is displayed
	!	2. files with no extensions are directories
	!
	print ">>> ftp func: get name list"
	rc% = ftp_get_name_list( ccb%, "", "SYS$OUTPUT")
	gosub display_rc
	!
	!	<<< move to remote directory >>>
	!
	if user_name$ <> "anonymous" then
		input ">>> remote directory? (default=none) ";remote_dir$
		remote_dir$ = edit$(remote_dir$, 4%+2%)				! no controls or white space
		if remote_dir$ <> "" then
			print ">>> ftp func: set directory"
			rc% = ftp_set_directory( ccb%, remote_dir$ )
			gosub display_rc
			!
			print ">>> ftp func: get name list"
			rc% = ftp_get_name_list( ccb%, "", "SYS$OUTPUT")
			gosub display_rc
		end if
	end if
	!
	!	<<< close the connection >>>
	!
	print ">>> ftp func: close"
	rc% = ftp_close_connection( ccb% )
	gosub display_rc
	!
	!	<<< deallocate the ccb >>>
	!
	print ">>> ftp func: deallocate"
	rc% = ftp_deallocate_ccb( ccb% )
	gosub display_rc
	!
	goto fini
	!------------------------------------------------------------
	!
	!	<<< display return code >>>
	!
	display_rc:
	print ">>> ";
	select (rc% and 7%)
	    case 0%		! warning
		print "-w-";
	    case 1%		! success
		print "-s-";
	    case 2%		! error
		print "-e-";
	    case 3%		! informational
		print "-i-";
	    case 4%		! fatal
		print "-f-";
	    case else
		print "-?-";	! this should never happen
	end select
	print " rc: ";str$(rc%)
	return
	!
	!------------------------------------------------------------
	!
	!	<<< that's all folks >>>
	!
	fini:
	end

Back to OpenVMS
Back to OpenVMS Demo Index
Back to Home
Neil Rieck
Kitchener - Waterloo - Cambridge, Ontario, Canada.