Category : Files from Magazines
Archive   : DBMS9003.ZIP
Filename : HEAD2.MAR
Listing 2
*
* FILE_IO.PRG
*
* Demonstrate passing parameters to UDF's by REFERENCE
*
* Serves no purpose other than copy one file to another
*
* ***** W A R N I N G ****
* ***** ALL Error checking has been removed
*
*
size = 512
buffer = SPACE(size)
* Screen GETs
infile = " "
outfile = " "
inext = " "
outext = " "
CLEAR
@ 02,02 SAY "Enter file names: Copy from 12345678.999 to 12345678.999"
@ 02,32 GET infile PICTURE "!!!!!!!!"
@ 02,41 GET inext PICTURE "!!!"
@ 02,50 GET outfile PICTURE "!!!!!!!!"
@ 02,59 GET outext PICTURE "!!!"
READ
* Open the input file and test for failure
inhandle = FOPEN(TRIM(infile)+"."+TRIM(inext))
IF FERROR() <> 0
@ 05,05 SAY "Can not open INPUT file."
RETURN
ENDIF
* Open the output file and test for failure
IF FILE(TRIM(outfile)+"."+TRIM(outext))
outhandle = FOPEN(TRIM(outfile)+"."+TRIM(outext),1)
ELSE
outhandle = FCREATE(TRIM(outfile)+"."+TRIM(outext))
ENDIF
IF FERROR() <> 0
@ 05,05 SAY "Can not open OUTPUT file."
RETURN
ENDIF
* Initialize the loop indicator
i = size
* Loop through until input file is completely read
DO WHILE i != 0
i = FREAD(inhandle, @buffer, size)
* Test for writing error in case disk fills up
* Here we pass buffer to FWRITE by reference to
* save the overhead of making a copy.
o = FWRITE(outhandle, @buffer, i)
IF o != i
@ 05,05 SAY "DOS ERROR writing output file"
RETURN
ENDIF
ENDDO
* Close the open I/O files
FCLOSE(inhandle)
FCLOSE(outhandle)
RETURN
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/