Category : Network Files
Archive   : BB100.ZIP
Filename : BULLETIN.PRG

* Program: Bulletin.prg (Bulletin Board Service)
* Authors: David R. Alison (CIS: 71121,3526)
* Greg Lief (CIS: 72460,1760)
* Roger S. Yamate (CIS: 71621,372)
* Version: Clipper 5.01
* Notes: Use this program as a central bulletin board
* service on a network. Demonstrates FREAD() & FWRITE().
*
* Libraries: CLIPPER.LIB, EXTEND.LIB
*
* Program originally written by David Alison as appeared
* in Nantucket News (Sept/Oct 1988).
*
* Revised by Greg Lief 11/3/88 to allow users to add bulletins
* and speed up screen painting. Also made UDF Errorbeep() more
* inclusive re: clearing screen and exiting to DOS (if
* fatal error).
*
* Revised by Roger S. Yamate 06/17/91 for Clipper 5.01.
* Added a PRINT function for Current Bulletins. (F10 Key)
* Deleted User ability to add Bulletins (System is Read-Only)
* Also, Utilize DIRECTORY() and ASORT() to order current
* Bulletins that can be read. (Order is by Date)
*
*
* Public Domain Software.

#include "Directry.ch"
//

PUBLIC memo2read, frame, blankscrn, mainscrn, print_flag, print_ind
frame = "ÚÄ¿³ÙÄÀ³ " && Create the frame for the boxes.
SET SCOREBOARD OFF
SET CURSOR OFF
i = 0

CLEAR
IF ISPRINTER() = .F.
Errorbeep("Printer NOT On-Line", .f.)
WAIT
CLEAR
QUIT
ENDIF


* Set up initial screen.
* Notice the use of the ASCII CHRs 176 for shadow and 189 for
* standard background.
Fillscr()


* save 'blank' screen at this point to be restored below in DO..WHILE LOOP
SAVE SCREEN TO blankscrn


* Draw the title box and drop shadow
@ 1,9 CLEAR TO 3,72
@ 1,9,3,72 BOX frame
@ 2,8 SAY CHR(176)
@ 3,8 SAY CHR(176)
@ 4,8 SAY REPLICATE( CHR(176), 63)
@ 2,29 SAY 'Bulletin Board Service'


* Load all bulletin files into an array. If a file has the
* extension TXT, it will be loaded into the array.
txt_files := DIRECTORY("*.txt", "D")
number = LEN(txt_files)
IF number = 0 && Check to see if no bulletins are available.
Errorbeep("No bulletins available at this time.", .f.)
WAIT
ELSE
txt_files := ASORT(txt_files,,, { |x,y| x[F_DATE] > y[F_DATE] })
atxt_menu := ARRAY(number)


* Open each bulletin and read the first line into the array
* txt_files. This will be used for the menu selection of
* which bulletin the user would like to read.
FOR i = 1 TO number
block = 50
buffer = space(50)
filename = txt_files[i,F_NAME]
handle = FOPEN(filename)
IF FERROR() <> 0
Errorbeep('Cannot read file, DOS error ' + str(ferror()))
WAIT
ELSE
bytes = FREAD(handle, @buffer, block)
IF bytes <> block
Errorbeep('Cannot read file ' + txt_files[i,F_NAME], .t.)
WAIT
RETURN
ELSE
buffer = MEMOTRAN(buffer, CHR(250), CHR(250))
IF AT(CHR(250), buffer) <> 0
atxt_menu[i] = LEFT((TRIM(SUBSTR(buffer, 1, + ;
AT( CHR(250), buffer) - 1) ) + ;
REPLICATE(CHR(250), 50) ), 50 )
ELSE
atxt_menu[i] = buffer
ENDIF
atxt_menu[i] = atxt_menu[i] + ' ' + DTOC(txt_files[i,F_DATE])
ENDIF
ENDIF
FCLOSE(handle) && Make sure we close the file.
NEXT


* Display the ACHOICE menu with the available bulletins.
@ 6,9 CLEAR TO 19,72
@ 6,9,19,72 BOX frame
@ 8,9 SAY CHR(195) + REPLICATE(CHR(196), 62) + CHR(180)
@17,9 SAY CHR(195) + REPLICATE(CHR(196), 62) + CHR(180)
FOR i = 7 TO 19
@ i, 8 SAY CHR(176)
NEXT
@20,8 SAY REPLICATE( CHR(176), 63 )


* Add in the menu highlights.
@ 7,11 SAY "Bulletins available"
@ 7,63 SAY "Updated"
@ 18,12 SAY "Highlight a bulletin and press Enter or press Esc to exit"


* save screen at this point for restoring after they read a bulletin
SAVE SCREEN TO mainscrn


* main loop -- user reads as many as bulletins as desired then exits
DO WHILE .T.
print_ind = 0
menuchoice = ACHOICE (9, 11, 16, 70, atxt_menu)
IF menuchoice = 0 && User pressed Esc to exit
EXIT
ENDIF
RESTORE SCREEN FROM blankscrn
print_file = txt_files[menuchoice,F_NAME] + '.txt'
Memoscr()
SET KEY -9 TO print_flag
MEMOEDIT(MEMOREAD(txt_files[menuchoice,F_NAME]), 1, 4, 17, 77, .f.)
SET KEY -9 TO
RESTORE SCREEN FROM mainscrn
ENDDO
ENDIF
CLEAR
RETURN

*------ end mainline ------


FUNCTION Fillscr

* fill the screen with background character CHR 178
PRIVATE i, j
FOR j = 0 TO 24
@ j, 0 SAY REPLICATE(CHR(178), 80)
NEXT
RETURN (0)


FUNCTION Errorbeep

* Sound an error-style tone on the speaker, clear screen,
* display error message.
PARAM msg, dos_msg


* Second param logical: .T. -- pause & display 'Return to DOS' message
* .F. -- don't pause
PRIVATE i
FOR i = 1 TO 2
TONE(300,1)
TONE(499,1)
NEXT

CLEAR

SET COLOR TO W+*/N,N/W,,,N/W
@ 10,0 SAY 'ERROR: ' + msg
SET COLOR TO

IF dos_msg
WAIT 'Press any key to return to operating system'
SET CURSOR ON
ENDIF
RETURN (0)


FUNCTION MemoScr

* lay out borders and frame for MEMOEDIT()

PRIVATE i
FOR i = 2 TO 17
@ i, 2 SAY CHR(176)
NEXT
@ 18,2 SAY REPLICATE( CHR(176), 74)
@ 1,3 CLEAR TO 17,77
@20,3 CLEAR TO 22,77
@20,3,22,77 BOX frame
@21,2 SAY CHR(176)
@22,2 SAY CHR(176)
@23,2 SAY REPLICATE( CHR(176), 74)
@21,8 SAY 'Commands: ' + chr(27) + chr(18) + chr(26) + ;
' F10(Print) Page Up Page Down Esc (Exit)'
RETURN (0)

FUNCTION print_flag
print_ind = print_ind + 1
SET CONSOLE OFF
SET COLOR TO W+*/N,N/W,,,N/W
@ 21,29 SAY "(Printing)"
SET COLOR TO
TYPE(print_file) TO PRINT
EJECT
@21,8 SAY 'Commands: ' + chr(27) + chr(18) + chr(26) + ;
' F10(Print) Page Up Page Down Esc (Exit)'
RETURN (print_ind)

** EOF: bulletin.prg