Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : BR02A.ZIP
Filename : SAMP_UDF.PRG

 
Output of file : SAMP_UDF.PRG contained in archive : BR02A.ZIP

* SAMP_UDF.PRG
*
* This is the code for the default UDF for B_BACK and B_REST (BACKRITE.LIB)
* You can use this code as a basis for your own screen control UDF.
* To invoke your own UDF, instead of the default one, specify the name
* of your UDF in parameter 5 of B_BACKUP, or parameter 4 of B_RESTORE.
* See the documentation for more details.

* (C) 1989, Mark J. Bachrach and David McConnell, All Rights Reserved
* Author: Mark J. Bachrach


FUNCTION myudf
PARAMETERS status, filenum, maxnum, filename, percent
PRIVATE msg1, msg2, key_in

* Check for key and abort
IF INKEY() = 27
BREAK
ENDIF
CLEAR TYPEAHEAD

msg2 = ''
DO CASE
CASE status = 0 && Start-up
PUBLIC disk_counter
disk_counter = 0
SCROLL(0,0,24,79,0)
@ 1,26 TO 3,51 DOUBLE
@ 2,28 SAY "BACK*RITE, Version 0.2"
@ 5,26 SAY "Status:"
@ 20,20 say " 1"
@ 21,20 say " 1 2 3 4 5 6 7 8 9 0"
@ 22,20 say "0 0 0 0 0 0 0 0 0 0 0"
@ 23,20 say "ÚÄÄÄÄÂÄÄÄÄÂÄÄÄÄÂÄÄÄÄÂÄÄÄÄÂÄÄÄÄÂÄÄÄÄÂÄÄÄÄÂÄÄÄÄÂÄÄÄÄ¿"
@ 24,20 say CHR(219)
@ 24, 7 say "0% Complete:"
msg1 = "Start-up"
b_status()
CASE status = 1 && Initialization
SCROLL(7,1,19,79,0)
msg1 = "Initializing Disk"
b_status()
CASE status = 2 && Disk Change
disk_counter = disk_counter + 1
msg1 = 'Disk Change'
TONE(900,5)
b_status()
@ 8, 28 TO 11, 52 DOUBLE
@ 9, 33 SAY "Place Disk #" + STR(disk_counter,2)
@ 10, 34 SAY "in Drive " + drive
IF TYPE('zapdisk') # "U"
IF zapdisk
@ 18, 9 SAY "WARNING: Files on root directory of drive " + ;
drive + " will be erased!"
ENDIF
ENDIF

CASE status = 3 && Backing up a file
msg1 = "Backing-up: " + filename
msg2 = "File #" + STR(filenum,3) + " of" + STR(maxnum,3)
b_status()
CASE status = 4 && Restoring a file
msg1 = "Restoring: " + filename
msg2 = "File #" + STR(filenum,3) + " of" + STR(maxnum,3)
b_status()
CASE status = 5 && Erasing disk
SCROLL(7,1,19,79,0)
msg1 = "Erasing target disk."
b_status()
CASE status = 6 && Searching (Partial Restore)
msg1 = "Searching"
msg2 = "File #" + STR(filenum,3) + " of" + STR(maxnum,3)
b_status()
CASE status = 7 && Finish backup or restore
msg1 = "Operation Complete!"
b_status()
FOR i = 1 TO 3
TONE(1400,1)
TONE(001,1)
NEXT
RELEASE disk_counter
CASE status = 8 && ERROR, code in PERCENT
TONE(300,8)
CLEAR
@ 12, 20 SAY "A fatal error has occured!"
DO CASE
CASE percent = 1
msg1 = "No files found matching specification."
CASE percent = 2
msg1 = "Error opening file."
CASE percent = 3
msg1 = "Error reading file."
CASE percent = 4
msg1 = "Error writing to drive."
CASE percent = 5
msg1 = "Back-up drive full to start."
ENDCASE
@ 16, 25 SAY msg1
ENDCASE

********

FUNCTION b_status
@ 5,34 say SUBSTR(msg1+SPACE(30), 1, 30)
@ 6,34 say SUBSTR(msg2+SPACE(30), 1, 30)
@ 24,21 SAY REPL(CHR(219),INT(percent/2))
@ 24, 5 SAY STR(percent,3,0)


  3 Responses to “Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : BR02A.ZIP
Filename : SAMP_UDF.PRG
”

  1. Daniel says:
    January 27, 2013 at 3:59 pm

    Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. Joshie says:
    March 18, 2014 at 4:57 pm

    This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. DiskingRound says:
    January 14, 2015 at 10:57 pm

    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/