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 (Waterloo, Ontario, Canada) ! : (https://neilrieck.net) (mailto:[email protected]) ! 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? ([email protected]) "; user_pass$ user_pass$ = edit$( user_pass$, 4%+2%) ! no controls or white space user_pass$ = "[email protected]" 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 HomeNeil Rieck
Waterloo, Ontario, Canada.