* MailMan * A TBBS Type 7 replacement utility. This program allows the user to enter all * or part of another user's name. If the name is not found in the database then * a search is done on the database to find any close matches. If the user * selects one of the matches then the TBBS Type 7 is called from TBBS. * This program gets its list of available user names from the TBBS USERLOG.BBS * file or from a distribution list named MAILMAN.DNL in the same directory. * The sysop can pass the name of the message base on the calling menu Opt Data * line. If no message base is passed then the user will be given a list of * available message boards when they find who they want to write to. SET ESCAPE OFF && don't allow user to abort program SET EXCLUSIVE OFF && allow multi-user database access SET EXACT OFF && check content not length SET TYPEAHEAD TO 1 && buffer only 1 character IF "&"+"&" $ OPTDATA() && is there an optional switch? board = LTRIM(RTRIM(SUBS(OPTDATA(),AT("&"+"&",OPTDATA())+2))) && get board name ELSE && otherwise board = "" && blank board name ENDIF press = "" && blank variable for key press IF UANSI() && does user have ANSI ability? SET COLOR TO BG+/N && bright cyan on black ENDIF SELECT 1 && switch to database slot one IF .NOT. FILE("mailman.DBF") && is database here? IF UANSI() && does user have ANSI ability? SET COLOR TO G && green ENDIF ? "* Creating new record file..." && show user what is happening CREATE newstruc && create structure extended file USE newstruc && open the file APPEND BLANK && add a blank record to file REPLACE field_name WITH "USERNAME" && store field name "USERNAME" to file REPLACE field_type WITH "C" && field will be Character REPLACE field_len WITH 30 && field will store up to 30 characters USE && close file CREATE mailman FROM newstruc && make real database from Newstruc ERASE newstruc.dbf && remove temp file IF FILE("mailman.ndx") && is old index file here? ERASE mailman.ndx && delete it ENDIF USE && close any open file ENDIF IF .NOT. FILE("mailman.ndx") && no index file? USE mailman EXCLUSIVE && open file to index on INDEX ON username TO mailman && make index USE && close database file ENDIF USE mailman && open database file SET INDEX TO mailman.ndx && open index file SELECT 2 && change to file area number two IF .NOT. FILE("mailman!.DBF") && is database here? IF UANSI() && does user have ANSI ability? SET COLOR TO G && green ENDIF ? "* Creating new config file..." && show user what is happening CREATE newstruc && make temp file USE newstruc && open temp file APPEND BLANK && make a record REPLACE field_name WITH "LAST_SCAN" && make field name "LAST_SCAN" REPLACE field_type WITH "D" && field type will be Date REPLACE field_len WITH 8 && field length must be 8! USE && close file CREATE mailman! FROM newstruc && make config file from temp ERASE newstruc.dbf && get rid of temp file USE mailman! && open config file APPEND BLANK && make a record REPLACE last_scan WITH DATE() -1 && force real scan now USE && close file ENDIF USE mailman! && open config file IF DATE() # last_scan && date is not the same as last scan! IF FILE("userlog.bbs") && is the userlog.bbs here? ? "* Updating list..." && tell user about delay IF FILE("mailman.dnl") && is new name file here? ERASE mailman.dnl && not needed, erase ENDIF FOPEN ulog "userlog.bbs" 0 2048 && open 2K in 2K blocks (4 users) IF ulog = -1 && if there are any errors SET ALTERNATE TO mailman.err && output text file SET ALTERNATE ON && turn file output on ? DTOC(DATE()) + " " + TIME() + " MAILMAN: Error on opening USERLOG.BBS" ? " MAILMAN Error was: " + MESSAGE(FERROR(ulog)) SET ALTERNATE OFF && stop text file output SET ALTERNATE TO && close text file ? "Press any key..." && prompt user for input key = INKEY(120) && wait 120 seconds or key press QUIT && leave program ENDIF USE && close file SELECT 1 && switch to main user data file ZAP && Clear out the .DBF (remove all records) DO WHILE .T. && start loop 1 FBREAD ulog bytes ulog 0 2048 && read 4 user records IF bytes = 0 && past end of file? EXIT && stop loop 1 ENDIF pass = 1 && count which user DO WHILE .T. && start 2nd loop * Extract User Name readout = FBEXTRACT(ulog, (pass * 512) - 512 + 1, 50) offset = AT(CHR(0), readout) && find end of name user = UPPER(SUBSTR(readout, 1, offset - 1)) && get username from BBS APPEND BLANK && add a blank record to database REPLACE username WITH user && Add User info to database pass = pass + 1 && Increment Counter IF pass = (bytes / 512) + 1 && end of data block? EXIT && leave loop 2 ENDIF ENDDO && end of loop 2 ENDDO SELECT 2 && switch to 2nd database USE mailman! && open config file REPLACE last_scan WITH DATE() && save marker for today USE && close database ENDIF ENDIF SELECT 1 && switch to 1st database IF FILE("mailman.dnl") && is new name file here? ? "* Updating list..." && tell user about delay ZAP && erase old info from dbf APPEND FROM mailman.dnl TYPE SDF && add new info ENDIF IF RECCOUNT() > 0 && database not empty? IF FILE("mailman.dnl") && is old name list here? ERASE mailman.dnl && delete old name list ENDIF ELSE IF UANSI() && does user have ANSI ability? SET COLOR TO W+ && bright white ENDIF ? "ERROR: Nobody is listed in the database at this time." ? IF UPRIV() = 255 && is this a sysop? SET ALTERNATE TO mailman.ptm && open text file SET CONSOLE OFF && turn screen off SET ALTERNATE ON && turn on file output ?? "; Distribution Name List creation template for MAILMAN.PRG" ? "; List All Users On System" ? ";" ? "#FILE " + HOMEPATH() + "MAILMAN.DNL" ? "%NAME%" SET ALTERNATE OFF && turn off file output SET CONSOLE ON && turn screen on SET ALTERNATE TO && close file ? " Please create a text file with all of the names called 'MAILMAN.DNL' or" ? " copy the USERLOG.BBS to this directory. The printer file 'MAILMAN.PTM'" ? " has been created in the " + HOMEPATH() + " directory." ? ? " You can use this file with the ULEDIT program to create the 'MAILMAN.DNL'" ? " file from your userlog." ELSE ? " Please inform the sysop that he needs to add some names to this utility." ENDIF ? IF UANSI() && does user have ANSI ability? SET COLOR TO W && white ENDIF ? "Press any key..." && prompt user for input key = INKEY(120) && wait 120 seconds or key press RETURN && leave program ENDIF ?? " There are " + LTRIM(STR(RECCOUNT())) + " names in the current list." IF UANSI() && does user have ANSI ability? SET COLOR TO G+ && bright green ENDIF ? "Type part of the name you want to find and press Enter. ? = list everyone." ? IF UANSI() && does user have ANSI ability? SET COLOR TO GR+ && yellow ENDIF key = "" && blank variable for user input ACCEPT "Send Message To: " TO key && get name from user IF EMPTY(key) && is it blank? IF UANSI() && does user have ANSI ability? SET COLOR TO W && white ENDIF RETURN && leave program ENDIF ? key = UPPER(LTRIM(RTRIM(key))) && word fix up (uppercase) IF VAL(key) > 0 .AND. VAL(key) <= RECCOUNT() && user typed a number GOTO VAL(key) && they know the record # IF username # UNAME() && not user's own name DO letter && write the letter ENDIF ENDIF SEEK key && do fast search junk = FOUND() && did we find a match? IF key # UPPER(TRIM(username)) && this is not a match? junk = .F. && set flag to "no find" IF " " $ key && is a space in the name? key = TRIM(LEFT(key,AT(" ",key))) && trim to one word IF LEN(TRIM(key)) < 1 && too small? key = "?" && force global search ENDIF ENDIF ENDIF IF .NOT. junk && name not found? IF "?" $ key && is it a global search? key = " " && this should match everyone ELSE IF UANSI() && does user have ANSI ability? SET COLOR TO BG+ && bright cyan ENDIF ? "Searching for " + CHR(34) && show what we are looking for IF UANSI() && does user have ANSI ability? SET COLOR TO W+ && bright white ENDIF ?? key && show user name search key IF UANSI() && does user have ANSI ability? SET COLOR TO BG+ && bright cyan ENDIF ?? CHR(34) + " matches..." && end line ENDIF IF UANSI() && does user have ANSI ability? SET COLOR TO W && normal white ENDIF ?? " Press (P) to pause, (S) to stop." && show page pause keys GO TOP && start at top of list lcount = 2 && line count starts at 2 junkn = 0 && number of users shown goober = .F. && flag to exit loop ON KEY DO checkkey && allows "p" and "s" checking DO WHILE .NOT. EOF() .AND. .NOT. goober && start loop IF key $ username && is key inside username IF UANSI() && does user have ANSI ability? SET COLOR TO W+ && bright white ENDIF IF MOD(junkn,2) = 0 && new line? lcount = lcount + 1 && add one to line count IF lcount > UMORE() .AND. UMORE() # 0 && is screen full lcount = 2 && reset line counter to 2 IF UANSI() && does user have ANSI ability? SET COLOR TO RB+ && bright magenta ENDIF ? "-More, (S)top-" && show prompt press = UPPER(CHR(INKEY(120))) && wait 120 seconds or key press IF UANSI() && does user have ANSI ability? SET COLOR TO W+ && bright white ENDIF ?? REPLICATE(CHR(8),14) + SPACE(14) + REPLICATE(CHR(8),14) && backspace IF press = "S" && did they press "S"? EXIT && leave loop ENDIF ?? RIGHT(STR(RECNO()),5) + ") " && put on same line ELSE && otherwise ? RIGHT(STR(RECNO()),5) + ") " && start a new line ENDIF IF UANSI() && does user have ANSI ability? SET COLOR TO G+ && bright green ENDIF ?? username && don't trim - make even columns ELSE ?? RIGHT(STR(RECNO()),5) + ") " && show record number IF UANSI() && does user have ANSI ability? SET COLOR TO G+ && bright green ENDIF ?? TRIM(username) && trim to make print faster ENDIF junkn = junkn + 1 && count number of names junk = .T. && flag that something was shown ENDIF SKIP && move to next record in database ENDDO && end loop ON KEY && turn key checking off IF junk && was something shown? IF UANSI() && does user have ANSI ability? SET COLOR TO GR+ && yellow (bright brown) ENDIF junky = "" && blank variable for user input ACCEPT "Type number of choice: " TO junky && get user input junky = VAL(junky) && turn it into a number IF junky < 1 .OR. junky > RECCOUNT() && is it inside valid range? junk = .F. && turn flag off IF UANSI() && does user have ANSI ability? SET COLOR TO W && white ENDIF RETURN && leave program ELSE GOTO junky && go to selected record number ENDIF ENDIF ENDIF IF junk .AND. username # UNAME() && name found and not this user? DO letter && write the letter! ELSE && otherwise ? IF username # UNAME() && if name is not this user IF UANSI() && does user have ANSI ability? SET COLOR TO R+ && bright red ENDIF ? CHR(34) + key + CHR(34) + " is not found in our files." ? IF UANSI() && does user have ANSI ability? SET COLOR TO G+ && bright green ENDIF ? "It may be they are not a member of this board or you spelled their name" ? "incorrectly. Please use a different spelling and try again." ELSE IF UANSI() && does user have ANSI ability? SET COLOR TO G+ && bright green ENDIF ? "That is YOUR name. It is not polite to leave mail to yourself on a BBS." ? "It uses up the system resources when it is not needed. Some sysops will" ? "even lower your access level for doing this." ENDIF ENDIF ? IF UANSI() && does user have ANSI ability? SET COLOR TO W && white ENDIF ? "Press any key..." && prompt user key = INKEY(120) && wait 120 seconds or key press RETURN && leave program PROCEDURE letter && calls message write function from TBBS CLEAR TYPEAHEAD && blank keyboard buffer od = board + " /F:" + CHR(34) + TRIM(username) + CHR(34) && build opt data DOTBBS TYPE 7 OPTDATA od && call message write QUIT && leave this program RETURN && this line will never execute PROCEDURE checkkey && checks for Pause or Stop key press PRIVATE press && variable is only valid here press = INKEY() && get key from input buffer IF UPPER(CHR(press)) = "P" && did they press "P"? press = INKEY(120) && wait for 120 seconds or key press ENDIF IF UPPER(CHR(press)) = "S" && they pressed "S"? goober = .T. && flag to exit loop ENDIF lcount = 2 && reset line count to 2 RETURN && leave this procedure