; - - - - - - - - - - - - - - clip here - - - - - - - - - - - - - - ; SCANNER.ASP version 1.65 ; Copyright (C) 1992 by Jim Kutz. ; This software may be freely shared (provided the accompanying doc file is ; included), but may not be sold nor used for profit without permission of ; the author. All other rights reserved. ; DISCLAIMER: This software is shared 'as is', with no warranties expressed ; or implied. This software is not supported by Cleveland Free-net nor by ; CWRU. Like all script programs, it will stop working when and if the ; Free-net menu system is changed (in which case check with the author ; to see if there's a later version ). ; QUESTIONS, COMMENTS & IDEAS: On Free-net contact Jim Kutz (aa387) ; (refer to Version 1.61) On Internet: aa387@cleveland.freenet.edu ; HARDWARE/SOFTWARE REQUIREMENTS: IBM-compatible PC running MS-DOS and ; PROCOMM PLUS v2.01 with compiler (ASPCOMP.EXE) version 1.0, 1.01 or 1.0L. ; ATTENTION USERS: Before you can run this script, you must type in ; your newsgroup information and set your options in the procedures ; on the screen below. It's easy, if you follow the directions in the ; accompanying file. ; ============ END-USERS: Skip to the next double line ======= define false 0 define true 1 define capture call mode_switch with 0 define nibble call mode_switch with 1 define get_mail call fetch_mail with define shovel_out call move_files ; ================================================================ ; =================== This is the part you edit ================== ; ================================================================ ; ATTENTION USERS: Each newsgroup you wish to capture must be specified ; by placing a 'capture' command in the 'shopping_list' procedure below. ; See documentation for further instructions. proc SHOPPING_LIST get_mail "c:\inbox\" capture "skeptic" 3 "sk" "c:\freenet\skeptic\" nibble "nonsexist" 2 "ns" "c:\freenet\nonsexis\" endproc ; ATTENTION USERS: Below are all the control settings you can change. ; See documentation for further instructions. proc user_options define NORMAL_LIMIT 5 ; Asks for confirmation if message count per newsgroup exceeds this number. define NEVER_MORE true ; Suppress confirmation for NORMAL_LIMIT (above), and limits automatically. define MSGS_PER_FILE 250 ; Sets number of messages per 'bundled' file. Multiple files are created. define MOST_RECENT false ; When truncating (above), you can start from oldest or most recent msgs. define USE_1ST_UNREAD false ; If true, lower bound is 1'st unread message. Else is oldest unsaved message. define ALLOW_BACKTRACK false ; Allows you to 'backtrack' in a newsgroup by marking a message as unread (!) define NIBBLE_COUNT 7 ; Sets max. message count when CAPTURE is replaced by NIBBLE. define EARLY_DIRCHECK false ; Checks and corrects all your directory names right away, not on the fly. define EXIT_AFTER false ; If true, hangs up when done. If false, stays online and beeps you. define ZMODEM_CLEANUP true ; Suppresses garbage on screen after Zmodem aborts. define MAIL_LIST_LEVEL 1 ; Enable/disable mail listing option. 0=none 1=downloaded 2=entire mailbox define NEWS_LIST_LEVEL 1 ; Enable/disable news listing option. 0=none 1=downloaded 2=entire board define SEPARATE_NEWS_LISTINGS false ; If listings enabled, additional same-day news downloads listed separately define SEPARATE_MAIL_LISTINGS false ; separate listings for same-day mailfiles ; If listings enabled, additional same-day mail downloads listed separately define NEWSFILE_EXT ".txt" ; Optional 3-letter extension for newsgroup files. define MAILFILE_EXT ".txt" ; Optional 3-letter ext. for mail files define LISTNAME_EXT ".lst" ; Optional three-letter extension for listings. define SPEAKER_ENABLED true ; Turns sound on/off. If off, alerts are displayed in the status bar only. define TEMP_FILENAME "scanner.tmp" ; Changes the name of your download queue file. define BUFFER_MAX 400 ; # of msgs. in Free-net work directory which trigger a download. endproc ; ATTENTION USERS: Below is the 'custom exit' routine (optional). You can ; use it to chain to another script, or do a custom exit etc. This routine ; is always called just before the script exit, but does nothing unless ; you choose to put in commands. proc user_exit ; Your exit commands would go here. endproc ; INSTRUCTIONS for changing exit_settings. This script has to change Free-net ; terminal settings for dialogs to work. It doesn't know the original settings. ; The default exit settings are CBREAK, NOPAGE, NOPAUSE, NOCONFIRM, NOSHOWMENU ; To reverse any of these settngs, simply remove the semicolons from ; column one in the corresponding PAIR of instructions. proc exit_settings ; transmit "NOCBREAK^M" ; turn off 'hotkey' Free-net command mode. ; waitfor "Choice ==> " FOREVER ; transmit "PAGE^M" ; turn pager on ; waitfor "Choice ==> " FOREVER ; transmit "PAUSE^M" ; Free-net pauses after commands. ; waitfor "Choice ==> " FOREVER ; transmit "CONFIRM^M" ; Confirmation of exit enabled ; waitfor "Choice ==> " FOREVER ; transmit "SHOWMENU^M" ; Free-net menus always redisplayed ; waitfor "Choice ==> " FOREVER endproc ; ====== CAUTION: Don't change anything below this line ====== ; ====== unless you really know what you're doing. ====== proc main call init_script call main_handler call done_script endproc integer start_over = false ; flag for discard/restart option on DL abort menu. integer divert_calls = 0 ; used for multi-function calls in mode_switch. integer it_worked = 0 ; set to '1' to report success on exit integer result_code, error_code = 0 string dldir_old ; name of previous download dir. (saved, restored on exit) integer prompt_received ; for empty newsgroups integer was_usenet = 0 ; boolean, whether prev. newsgroup was Usenet. integer is_usenet = 0 ; boolean, whether current newsgroup is Usenet. integer resuming = 0 ; boolean, whether recovering from a derailed session. integer restart_flag = 0 ; boolean, set when work directory overflows. integer work_dir_full = 0 ; boolean, Free-net work directory full. integer autodl ; original zmodem autodownload setting ( off/on ) integer new_mail_flag = 0 ; used to watch for new mail flag set by "when". integer num_ops = 0 ; used to detect/avoid "menu at maximum depth" integer nibbling ; used to NIBBLE newsgroups. integer buffer_count = 0; # of messages awaiting download in work directory integer group_count = 0 ; # newsgroups awaiting download in work directory. integer already_listed = 0 integerlist_pointer = 0 ; pointer to end of list of file prefixes ; used to check for duplication. integer exit_delay proc main_handler restart_all: call clear_list if not start_over; restart could have occurred in init_script resuming... call shopping_list ; usual call is_usenet = 0 call move_files it_worked = 1 ; if script made it this far else call reset_history start_over = false goto restart_all ; rerun script normally endif endproc proc reset_history divert_calls = 1 ; makes mode_switch reroute CAPTURE calls to put_back_bak call shopping_list divert_calls = 0 endproc proc precheck_dirs divert_calls = 2 call shopping_list; makes mode_switch reroute CAPTURE calls to ConfirmDir divert_calls = 0 endproc proc mode_switch ; Allows multi-function "capture" command intparm nibble_mode strparm boardname intparm boardnum strparm filename strparm output_dirname nibbling = nibble_mode switch divert_calls case 0 ; usual case, processes corresponding newsgroup. group_count ++ if group_count > 38 ; since duplicate prefix checker only goes up to 40 call move_files endif call do_newsgroup with &boardname, &boardnum, &filename, &output_dirname endcase case 1 ; special call to resurrect .bak files and restore message counters. call put_back_bak with "fnetinfo.dat", &output_dirname endcase case 2 ; special call to confirm/change directory names in advance. strfmt s1 "Checking directory: %s" output_dirname statmsg s1 call ConfirmDir with &output_dirname pause 2 statrest endcase endswitch endproc proc put_back_bak ; restores fnetinfo.dat from fnetinfo.bak. strparm filename strparm output_dirname string filepath call SplicePath with &filepath, &output_dirname, &filename call restore_bak with &filepath endproc define newln message " " ; blank line. define statalarm call time_out with 180, ; sound alarm w/ string in status bar define statalarm2 call alert_msg2 with define rattle_cage statalarm "Your input is needed." proc init_script set aspdebug on ; traces run-time errors if compiled with /O /ML call bug_fix call welcome call setup_procomm call setup_freenet call user_options ; must be referenced even though it only has DEFINEs. group_count = 0 if EARLY_DIRCHECK ; if pre-checking of directories enabled call precheck_dirs endif if EXIT_AFTER exit_delay = 0 else exit_delay = 180 endif endproc proc setup_procomm fetch dldir dldir_old set atime 0 ; disable alarm / pause after successful downloads. set remotecmd off ; prevent remote-control of user's machine. set statline on ; make sure status-line ready for messages. set fgets_crlf off ; discard linefeed when getting string from file set txpace 20 ; transmit pacing 10 millisec. between chars. set waitcase off set zmodem timestamp off ; use your computer's datestamp on files. fetch zmodem autodload autodl ; save auto-download setting set zmodem autodload off ; let Free-net initiate transfer. set zmodem errdetect CRC32 ; set zmodem for 32-bit errorchecking. set zmodem recvcrash ON ; enable zmodem to resume aborted downloads. set abortdl keep ; keepaborted downloads set cdinxfer YES ; check for lost carrier during file transfers set relaxed on ; relaxed timeout for file transfers endproc proc setup_freenet ; defaults are restored during controlled exit. call extricate ; get back to "Your Choice ==>" prompt under any conditions statmsg "Streamlining terminal settings. See 'exit_settings' for controls." transmit "cbreak^M" ; enable 'hotkey' single-stroke commands. waitfor "Choice ==> " FOREVER transmit "nopage^M" ; turn off pager waitfor "Choice ==> " FOREVER transmit "nopause^M" ; turn off pause after each article waitfor "Choice ==> " FOREVER transmit "noconfirm^M" ; turn off confirmation of exit waitfor "Choice ==> " FOREVER transmit "noshowmenu^M" ; turn off repetitive menus. waitfor "Choice ==> " FOREVER statrest isfile TEMP_FILENAME if success ; previous session not completed, temporary queue file detected. resuming = 1 ; flag triggers resumption of any unfinished downloads. usermsg "Resuming from previous session using queue file 'scanner.tmp'" call move_files ; moves unfinished files from work directory to disk. resuming = 0 endif endproc ; Note on bug_fix: This routine contains dummy calls, because of a ; known bug in the ASPECT compiler which causes mysterious errors when ; an unreferenced procedure is included in a script compiled without ; the /O option. This was happening when either the CAPTURE or get_mail ; options were unused. proc bug_fix if 0 ; never called (intentionally). See comment above. capture "dummy_arg", 0, "du", "dummy_arg" nibble "dummy_arg", 0, "du", "dummy_arg" get_mail "c:\dummy_arg" shovel_out call dissect with $NULL endif endproc proc fetch_mail ; called in main using syntax: fetch_mail "" strparm dir_path string filepath = $NULL string list_filepath switch divert_calls; exit proc when shopping_list called for housekeeping case 0 when 2 "new mail" call set_mail_flag transmit "^M" ; to see if "new mail" prompt appears waitfor "Choice ==> " FOREVER if new_mail_flag call ConfirmDir with dir_path ; check/negotiate valid directory name call make_names with &dir_path, &filepath, &list_filepath, MAILFILE_EXT call mail_daemon with &filepath, &list_filepath, &dir_path endif cwhen 2 endcase case 2 ; precheck of directory name (only when mail call included) call ConfirmDir with &dir_path endcase endswitch endproc proc adjust_names ; avoids duplicate files using numbered extensions strparm filename, list_filepath, dir_path call select_ext with &dir_path, &filename ; renumber duplicate files call add_fext_prefix with &filename, MAILFILE_EXT if SEPARATE_MAIL_LISTINGS || ( MAIL_LIST_LEVEL == 2 ) call select_ext with $NULL, &list_filepath call add_fext_prefix with &list_filepath, LISTNAME_EXT endif endproc proc set_mail_flag ; called by WHEN command when new mail detected. new_mail_flag = 1 endproc proc mail_daemon strparm filename, listfile_path, dir_path long low_msg_num, hi_msg_num call adjust_names with &filename, &listfile_path, &dir_path transmit "mail" call GetMailStats with &low_msg_num, &hi_msg_num loop_back: ; if more mail detected at exit time new_mail_flag = false call make_mail_listing with &listfile_path, low_msg_num, hi_msg_num call xfer_to_workdir with &low_msg_num, &hi_msg_num, filename strfmt s1 "%ld-%ld" low_msg_num, hi_msg_num call range_cmd2 with "k", &s1 ; mark all messages as read call add_to_queue with &dir_path, &filename, 0L buffer_count = buffer_count + ( hi_msg_num - low_msg_num + 1 ) if notnew_mail_flag ; new mail can arrive during transfer or on exit call which_signal with , "[y/n] ", "Choice ==> ", $NULL, "p" if result_code == 1 ; new mail has arrived call adjust_names with &filename, &listfile_path, &dir_path transmit "n" call GetMailStats with &low_msg_num, &hi_msg_num low_msg_num ++ goto loop_back endif else goto loop_back endif endproc proc GetMailStats longparm lo_msg_num, hi_msg_num integer counter string current_string prompt_received = 0 when 0 "Enter Command: " CALL SETFLAG rflush set rxdata on statmsg "Examining menu to determine current and high message numbers." transmit "^M" find_loop: rget current_string 50 if failure rattle_cage call explain_options goto find_loop endif find current_string "Current" counter if found goto bingo else ; not found find current_string "no messages" counter if found hi_msg_num = -1l ; signal empty goto bingo endif goto find_loop endif bingo: set rxdata off call wait_for_flag with 45 cwhen 0 if hi_msg_num != -1l ; non-empty signal call parse_mail_hi_lo with ¤t_string, &lo_msg_num, &hi_msg_num endif endproc proc setflag prompt_received=1 endproc proc parse_mail_hi_lo strparm hi_lo_line longparm lo_msg_num, hi_msg_num string intstr integer pos, len find hi_lo_line "#" pos inc pos strlen hi_lo_line len len = len - pos + 1 substr intstr hi_lo_line pos len AtoL intstr, lo_msg_num find intstr "(" pos inc pos strlen intstr len len = len - pos + 1 substr intstr intstr pos len AtoL intstr hi_msg_num endproc integer prompt_type = 0 ; 0 = no prompt detected, 1 = enter cmd, 2 = Choice ==> proc extricate ; 'universal' exit to "Choice ==>' prompt under any conditions statmsg "Returning to main menu to clear the menu queue..." prompt_type = 0 call which_signal with "Command: ", "Choice ==> ", $NULL, "M^M" if result_code == 1 ; Script was started from inside a newsgroup. statmsg "Exiting to main level of Free-net." transmit "@cbreak^M" waitfor "" when 0 "Command: " transmit "q" when 1 "[y/n] " transmit "y" transmit "^M" ; enable hot keys ; enter mandatory C.R. waitfor "Choice ==> " FOREVER transmit "M^M" cwhen 0 cwhen 1 endif statrest endproc proc move_files if divert_calls return endif call transfer_files call delete_files endproc proc abort_script it_worked = 0 call done_script endproc proc done_script set zmodem timestamp on ; use original timestamp on downloaded files. if autodl set zmodem autodload ON ; remote host can initiate downloads. else set zmodem autodload OFF ; remote host can't initiate downloads. endif set atime 4 ; re-enable alarm after downloads. set dldir dldir_old call exit_settings call user_exit if it_worked call time_out2 with exit_delay,"Script finished successfully.",&n1 else call time_out2 with 180, "Script aborted. Try running it again.",&n1 endif exit ; script endproc ; ---- Procedures for transferring newsgroups to work directory ---- proc do_newsgroup ; sets up file transfer for a particular newsgroup. strparm boardname ; inline coding to reduce disk swapping. intparm boardnum strparm filename ; starts out as 2-letter file prefix. strparm output_dirname string listing_filspec long first_on_bb, last_on_bb, current_msg ; article #s in newsgroup long hi_prev_logged ; last article # captured to disk in prev. session. long next_to_save ; first article # to be logged if start_over ; 'flush' signal to abort all remaining calls to this procedure return endif call ConfirmDir with &output_dirname ; get/negotiate directory path substr filename, filename, 0, 2 ; truncates filename prefix to 2 letters. call add_to_list with &filename ; screens duplicates call make_names with &output_dirname, &filename, &listing_filspec, NEWSFILE_EXT call select_ext with &output_dirname, &filename if SEPARATE_NEWS_LISTINGS || ( NEWS_LIST_LEVEL == 2 ) call select_ext with $NULL, &listing_filspec call add_fext_prefix with &listing_filspec, LISTNAME_EXT endif restart: ; for re-doing truncated file when work directory was full. call GetLastLogged with &output_dirname, &hi_prev_logged; highest # on file call enter_board with &boardname, boardnum, &first_on_bb\ &last_on_bb, ¤t_msg ; outputs 3 numeric params. if hi_prev_logged < 0 n1 = 0 else n1 = hi_prev_logged endif if USE_1ST_UNREAD if ( current_msg > hi_prev_logged ) || ALLOW_BACKTRACK next_to_save = current_msg else goto plod_along endif else plod_along: if last_on_bb > hi_prev_logged if first_on_bb > (hi_prev_logged + 1) ; unsaved messages have expired next_to_save = first_on_bb else next_to_save = hi_prev_logged + 1 endif else next_to_save = -1L ; signal newsgroup empty endif endif strfmt s8\ "%s %i Low msg %ld Start %ld High %ld Prev. saved %ld"\ boardname, boardnum, first_on_bb, next_to_save, last_on_bb\ n1 call moveto_workdir with &output_dirname \ &filename, &next_to_save, &last_on_bb, &listing_filspec if restart_flag restart_flag = 0 ; reset flag already_listed = true goto restart ; re-do overflowed file and continue. else call exit_board endif endproc proc add_to_queue ; add name of newly created work dir. file to scanner.tmp strparm output_dirname, filename longparm last_on_bb if not ( work_dir_full || ( buffer_count > BUFFER_MAX ) \ || ( list_pointer >= 78 ) ) call add_file_to_list with &output_dirname, &filename call LogHiMsg with &output_dirname last_on_bb else ; Free-net work dir. may be getting full, so download it, then resume. statmsg "Downloading bundled msgs. from Free-net work directory." call exit_board if work_dir_full call transfer_files call add_file_to_list with &output_dirname, &filename; -> deletion list else ; buffer_max was reached but no overflow call add_file_to_list with &output_dirname, &filename cal transfer_files call LogHiMsg with &output_dirname last_on_bb endif call delete_files restart_flag = 1 ; set retry flag endif endproc proc enter_board strparm boardname ; go destination string intparm boardnum ; location of board on 'go' menu. longparm first_on_bb, last_on_bb, current_msg ; on return, contain BB stats. string boardstr last_on_bb=0 strlwr boardname ; convert to lowercase strcmp boardname "fav" if success ; next newsgroup will be Usenet, not Free-net is_usenet = 1 if was_usenet == 0 ; if not already in Usenet then enter. call check_depth with 40 transmit "go usenet^M" waitfor "Your Choice ==> " FOREVER transmit "7^M" waitfor "Enter command: " FOREVER transmit "fav^M" ; bring up list of 'favorite' newsgroups. waitfor "Enter command: " FOREVER endif else ; next newsgroup will be Free-net, not Usenet is_usenet = 0 if was_usenet ; if previous newsgroup was Usenet transmit "x" waitfor "==> " FOREVER was_usenet = 0 endif call check_depth with 40 transmit "go " transmit boardname transmit "^M" waitfor "Your Choice ==> " FOREVER endif was_usenet = is_usenet itoa boardnum, boardstr transmit boardstr call GetBBstats with &first_on_bb, &last_on_bb, &currnt_msg endproc proc add_file_to_list strpar output_dirname, filename statmsg "^Adding file to download list." fopen 1 TEMP_FILENAME "at" fputs 1 output_dirname fputc 1 10 fputs 1 filename fputc 1 10 fclose 1 statrest endproc proc moveto_workdir ; move nwsgroup articles to work directory file strparm output_dirname, filename longparm range_lo, range_hi strparm listing_filspec integer nothing_new if range_lo == -1l || range_lo > range_hi nothing_new=1 statmsg "There's nothing new in this newsgroup." else when 1 "quota exceeded" call over_quota nothing_new=0 call range_transfer with &output_dirname, &filename\ &range_lo, range_hi, &listing_filspec cwhen 1 endif endproc proc range_transfer strparm output_dirname, filename longparm range_lo, range_hi strparm listing_filspec long subrange_lo, subrange_hi, count, count0 count = range_hi - range_lo + 1 ; total count of msgs left to download if ( ( count > normal_limit ) || ( nibbling && ( count > NIBBLE_COUNT ) ) ) if not ( NEVER_MORE || nibbling ) ; if required to ask call showlong with "WARNING: Large number of unsaved messages: ", count call AskYesOrNo with "Do you want to download all of these messages?" if failure ; If user says no count0 = count ; remember old count re_entry: call get_long with "^M^J How many ressages do you want? ",&count if count > count0 message "^M^J There aren't that many messages. Try again." goto re_entry endif endif else ; automatic selection if nibbling count = NIBBLE_COUNT else count = normal_limit endif endif if MOST_RECENT range_lo = range_hi - count + 1 ; read newest messages. else range_hi = range_lo + count - 1 ; read oldest messages. endif endif call range_cmd with "K", &range_lo, &range_hi ; mark as read subrange_lo = range_lo subrane_hi = range_lo while not ( count <= 0 || start_over ) if count > MSGS_PER_FILE ; multiple bundled files required subrange_hi += MSGS_PER_FILE count -= MSGS_PER_FILE else subrange_hi += count count = 0 endif subrange_hi -- if not already_listed ; pevents double listing when work dir. full. call make_news_listing with &listing_filspec, filename\ subrange_lo, subrange_hi else already_listed = false endif statmsg s8 call subrange_xfer with &output_dirname, &filename, subrange_lo, subrange_hi if restart_flag ; needs to resume newsgroup after stopping to unload work dir if work_dir_full work_dir_full = 0 ; clear full flag else call inc_ext with &filename endf exitwhile ; falls back to do_newsgroup and flags 'goto restart' else buffer_count = buffer_count + ( subrange_hi - subrange_lo + 1 ); endif subrange_hi ++ subrange_lo = subrange_hi call inc_ext with &filename endwhile endproc proc subrange_xfer strparm output_dirname, filename longparm subrange_lo, subrange_hi call xfer_to_workdir with &subrange_lo, &subrange_hi, &filename call add_to_queue with &output_dirname, &filename, subrange_hi endproc proc xfer_to_workdir ; transferring messages to work dir. (mail or BB) longparm subrange_lo, subrange_hi strparm filename transmit "#" ; range prefix waitfor "to: " FOREVER transmit ">" ; command for range transfer to work directory file. waitfor ": " if subrange_lo != 0l ; that's zero-el, ( long integer constant ) LtoA subrange_lo, s1 transmit s1 else ; if no prev. backup termkey 94 ; transmits '^' signifying "lowest message on board" endif transmit "-" LtoA subrange_hi, s1 transmit s1 transmit "^M" waitfor "sages in: " FOREVER transmit filename transmit "^M" waitfor "[y/n]" FOREVER mspause 300 transmit "y^M" waitfor "mmand: " FOREVER endproc proc exit_board ; but doesn't exit Usenet, in case next board is in Usenet. transmit "x" if is_usenet waitfor "enter command: " FOREVER else waitfor "==>" FOREVER endif endproc proc over_quota work_dir_full = 1 statmsg "Work directory has reached capacity. No problem." endproc proc transfer_files string output_dirname, filename isfile temp_filename if not success return endif if was_usenet ; if still in Usenet, exit (if called by surprise from QUEUE) transmit "x" waitfor "==> " FOREVER was_usenet = 0 endif call check_depth with 40 transmit "go xfer^M" waitfor "==>" FOREVER transmit "3^" ; "receive file from Free-net" waitfor "==>" FOREVER set fgets_crlf off fopen 0 TEMP_FILENAME "rt" ; open file containing transfer list f success ; file won't exist if no newsgroups processed successfully while not eof 0 ; while not end-of-file fgets 0 output_dirname strcmp output_dirname $NULL if failure fgets 0 filename strcmp filename $NULL if failure call download_file with &output_dirname, &filename endif endif endwhile fclose 0 endif endproc procdownload_file strparm output_dirname, filename string filepath, new_name integer name_is_new = 0; call SplicePath with &filepath, &output_dirname, &filename isfile filepath if success if not resuming rattle_cage rename_loop: call ShowString with "^M^J File already exists on your disk: ", &filename call get_str with "Please enter another filename:", &new_name call SplicePath with &filepath, output_dirname, &new_name isfile filepath if success ; duplicate file usermsg "Bad choice." goto rename_loop else ; new name ok call re_name with &filename, &new_name filename = new_name name_is_new = 1 endif endif endif if not name_is_new call getfile2 with &filename, &output_dirname ; with retry/recovery else ; file had to be renamed. message "Adding renamed file to end of download list." call add_file_to_list with &output_dirname, &filename pause 1 endif endproc proc re_name ; renames a work dir. file & returns to 'xfer to PC'submenu. strparm old_name, new_name transmit "go files^M" waitfor "==> " transmit "4^M" waitfor "list]: " transmit old_name transmit "^M" waitfor "list]: " transmitnew_name transmit "^M" waitfor "==> " transmit "go xfer^M" waitfor "==> " transmit "3^M" waitfor "==> " endproc proc delete_files string filename isfile TEMP_FILENAME if not success call clear_list return endif call check_depth with 40 statmsg "Deleting the processed files from your Free-net work directory." transmit "go files^M" waitfor "Your Choice ==> " FOREVER set fgets_crlf off fopen 0 TEMP_FILENAME "rt" ; open file containing transfer list if success; file won't exist if no newsgroups processed successfully while not eof 0 ; while not end-of-file fgets 0 filename ; dummy read to skip over directory names strcmp filename $NULL if failure fgets 0 filename strcmp filename $NULL if failure transmit "3^M" waitfor "for list]: " FOREVER transmit filename call which_signal with "[y/n]: ", "Choice ==> ", $NULL, "^M" if result_code == 1 ; otherwise file did not exist so forget it. transmit "y^M" waitfor "Your Choice ==> " FOREVER endif endif endif endwhile fclose 0 delete TEMP_FILENAME ; delete download queue file. call clear_list endif statrest endproc proc make_mail_listing strparm listing_filspec longparm lo_msg_num, hi_msg_num if MAIL_LIST_LEVEL > 0 ; if listing is required statmsg "Creating listing of mail messages." if MAIL_LIST_LEVEL > 1 call log_open with &listing_filspec ; open logfile to hold list of titles. transmit "L" ; list entire newsgroup waitfor "mmand: " FOREVER log close ; close logfile else transmit "#" waitfor "to: " FOREVER transmit "L" waitfor ": " strfmt s1 "%ld-%ld" lo_msg_num, hi_msg_num transmit s1 pause 1 call log_open with &listing_filspec ; open logfile to hold list of titles. call ShowString with "Contents of mail file", &listing_filspec transmit "^M" waitfor "continue: " ; extra prompt only with mail files log close ; close logfile transmit "^M" waitfor "mmand: " FOREVER endif statrest endif endproc proc make_news_listing strparm listing_filspec, filename longparm range_lo, range_hi if NEWS_LIST_LEVEL > 0 ; if listing is required if NEWS_LIST_LEVEL > 1 call log_open with &listing_filspec ; open logfile to hold list of titles. transmit "L" ; list entire mewsgroup strfmt s1 "Creating listing file for entire newsgroup in file %s"\ listing_filspec waitfor "Command: " FOREVER else call log_open with &listing_filspec ; open logfile to hold list of titles. strfmt s1 "Listing file contents of: %s" filename statmsg s1 call ShowString with "Contents of file " &filename call range_cmd with "L", &range_lo, &range_hi endif log close ; close logfile statrest endif endproc proc log_open strparm listing_filspec re_open: log open listing_filspec ; open logfile to hold list of titles. if failure statalarm2 "Disk error. Can't open log file: ", listing_filspec call get_str with "^M^J Enter alternate file/path, or ENTER to check disk"\ &listing_filspec strcmp listing_filspec $NULL if success all disk_problem else goto re_open endif endif endproc proc make_names ; creates filenames by appending date to prefix already on outfilename. ; Also creates listing_pathspec, a full filepath with a list ext. ; e.g. 'skjan3.doc' strparm out_dir, outfilename, listing_filspec, extension string date_time, sub_str date date_time ; fetch date as mm/dd/yr substr sub_str date_time 0 2 ; month number call name_month with &sub_str ; substitute name of month, e.g. 'nov' strcmp outfileame $NULL if not success strcat outfilename, "-" endif strcat outfilename, sub_str ; append month to filename substr sub_str date_time 3 2 ; day number call shorten_numstr with &sub_str ; drop leading zero if any strcat outfilename sub_str ; append day to filename call SplicePath with &listing_filspec, &out_dir, &outfilename strcat outfilename, extension strcat listing_filspec LISTNAME_EXT endproc proc GetLastLogged ; look for prev. high msg. backed up. strparm out_dir longparm hi_prev_logged string path_str, out_str statmsg "Checking your disk for highest message previously saved, if any." call splicepath with &path_str, &out_dir, "fnetinfo.dat" set fgets_crlf off fopen 0 path_str "rt" ; open file fnetinfo.dat in data directory if success fgets 0 out_str ; get last msg. # AToL out_str hi_prev_logged fclose 0 ; close file else call ShowString with "No previous history file: ", &path_str message "New history file will be created." statmsg "Saving all messages from beginning of newsgroup." hi_prev_logged = -1l endif statrest endproc proc ogHiMsg ; record highest message in file fnetinfo.dat. strparm log_dir ; also creates .bak file ( if any ) from prev. session. longparm highest_now_logged string out_str, path_str call splicepath with &path_str, &log_dir, "fnetinfo.dat" call fopen_mk_bak with 1 &path_str "wt" LToA highest_now_logged out_str fputs 1 out_str fclose 1 endproc proc getfile2 ; zmodem with recovery features strparm filspec, output_dirname integer switch_val string dl_dir retry_gf2: transmit "4^M" ; use Zmodem waitfor "transfer :" FOREVER transmit "-t " ; text mode prefix transmit filspec call which_signal with "command.", "ERROR", $NULL, "^M" switch result_code ; set by which_signal above, depending on CFN response. case 1 ; Free-net rady with transfer if ZMODEM_CLEANUP set display off endif error_code = 0 set dldir output_dirname getfile zmodem set dldir dldir_old if failure usermsg "zmodem reporting abort or failure" message "zmodem reported abort or failure" error_code = 1 if ZMODEM_CLEANUP statmsg "Zmodem reporting abort or failure. Wait... " else statmsg "Ignore any garbage on your screen." endif else statmsg "Wait..." endif waitfor "Choice ==> " 120 if not waitfor transmit "^X^X^X" waitfor "Choice ==> " 120 if not waitfor rattle_cage if not connected statalarm "Connection lost or we got nuked." call abort_script endif message "Zmodem didn't work, and Free-net didn't go back to" message "the prompt even after the control-X signals were sent." endif endif set display on statrest if error_code goto restate_g2 ; troubleshooting menu endif endcase case 2 ; file did not exist statalarm2 "Work directory file not found: ", filspec set atime 0 call explain_missing return endcase endswitch return restate_g2: statalarm "Zmodem download aborted or failed." newln message " 1 retry download" message " 2 discard the current file and continue" message " 3 discard all files in Free-net work directory and continue" message " 4 back up to before these files were created and start over" message " 5 shell to Dos, then return to this menu" message " 6 change download drive/directory" message " 7 abort script (controlled exit)" newln call msg_no_cr with "Select ==> " keyget switch_val switch_val -= 48 ; convert ASCII to numeric switch switch_val case 1 goto retry_gf2 ; retry Zmodem. endcase case 2 exitswitch ; fall through ( discard this file ) endcase case 3 endcase case 4 fseek 0 0L 2 ; fast-forward download list to end-of-file start_over = true usermsg "Clearing all files and rewinding script." exitswitch ; falls through to delete_files... endcase; loops back in main_handler, restores .bak counters; reruns script case 5 shell ; to Dos goto restate_g2 ; then return to this menu. endcase case 6 ; Change download path. call get_str with "^M^J Enter download directory path for this file: "\ &dl_dir call ConfirmDir with &dl_dir set dldir dl_dir goto retry_gf2 endcase case 7 call abort_script endcase default usermsg "Invalid choice. Try again." goto restate_g2 endcase endswitch set atime 0 endproc; getfile2 proc explain_missing message "^M^J^M^J The missing file is one which this script created in your" message "Free-net work directory, containing the text of articles." message "This problem usually occurs when SCANNER was not able to" message "complete a previous session, leaving a file behind. If the" message "previous session was more than three days ago, the file has" message "probably expired (gone forever). If the previous session was" message "less than three days ago, and if you have more than one Free-net" message "account, make sure you're logged onto the same account^M^J" message "If you want the script to re-capture part of a newsgroup, go" message "to that directory and set back the counter in fnetinfo.dat," message "using a text editor. Then run the script again." message "^M^J Press any key to continue." keyget n1 endproc ; ======= Routines for putting up screenful of centered text ======== define center call line_out with integer row = 0 proc line_out strparm text_str integer length, offset integer color = 10 strlen text_str length offset = 38 - length / 2 atsay row offset color text_str row ++ endproc proc welcome call channel_two curoff call welcome_data call pause2 with 10 call channel_one endproc proc channel_two ; switch to alternate screen and clear it. vidsave 0 clear set statline off endproc proc channel_one ; return from alternate screen set statline on vidrest 0 curon endproc proc welcome_data center "SCANNER Automatic Newsgroup Monitoring Script" center "(for downloading from Cleveland Free-net/Usenet)." center "Version 1.63 Last update Dec. 30, 1992" center " " center "Brought to you by the Skeptics' Networking Technical Project." center " " center "beta testing by Cyn Bell-Moores." center " " center "Copyright (C) 1992 by Jim Kutz (aa387@cleveland.freenet.edu)" center "This software may be freely shared, but may not be sold" center "nor used for profit without permission of the author." center " " center "DISCLAIMER: This software is shared 'as is', with no" center "warranties express or implied. This software is not" center "supported by Cleveland Free-net nor by IRIS/INS/TELCOM." center "Send questions or suggestions by email to 'aa387'on CFN." center " " center "Visit these fine Sigs when you're on Cleveland Free-net" center " " center "Skeptics' Sig (go skeptic) Sysops' Sig (go sysop)" center " " center "Non-Sexist Sig (go nonesexist, go equal) Lotus Sig (go lotus)" center " " center "[ Press any key to continue, or wait 10 seconds. ]" endproc proc check_depth ; makes sure maximum menu depth not exceeded intparm depth inc num_ops if num_ops > depth transmit "M^M" ; return to main Free-net menu before doing the next 'go'. num_ops = 0 ; reset counter endif endproc proc range_cmd strparm cmd_name ; single letter, e.g. "L" longparm range_lo, range_hi strfmt s1 "%ld-%ld" range_lo, range_hi call range_cmd2 with &cmd_name, &s1 endproc proc range_cmd2 strparm cmd_name strparm range_str transmit "#" waitfor "to: " FOREVER transmit cmd_name waitfor ": " transmit range_str transmit "^M" waitfor "mand: " endproc proc wait_for_flag ; waits for global flag to be set by when cmd. intparm timer ; # seconds integer timer_a timer_a = timer * 10 wff: while not ( prompt_received || ( timer_a < 0 ) ) timer_a -- mspause 100 ; pause 100 millisec. endwhile if timer_a < 0 ; timed out statalarm "Free-net prompt not found. " call wff_help timer_a = 3000 ; set timer for 5 minutes and resume scanning for prompt. goto wff endif endproc proc wff_help message "^M^J^M^J The script is waiting for an overdue prompt from Free-net." message "You may be able to get it back on track using the keyboard to make" message "Free-net give the expected response, in which case the script will" message "resume. Otherwise you can exit the script (ESC), and run it again," message"in which case it will pick up where it left off. If you wish, you" message "can use the scrollback buffer Alt-F6. ^M^J^M^J" endproc ; ================= General purpose utilities =============== ; ---------- Set of routines to deal with file collisions -------------- proc select_ext ; figures out next numbered filename. strparm dir_path, filename string file_path, ext_str call SplicePath with &file_path, &dir_path, &filename ; make full path. call choose_ext with &file_path ; run it through sequential numberer. call get_ext with file_path, &ext_str ; pull off the correct extension call change_ext with &filename, ext_str ; ... and stick it on bare filename. endproc proc choose_ext ; renumbers path extension as needed strparm filspec string testspec, ext_str integer et_num strcpy testspec, filspec call clip_ext with &testspec call get_hi_ext with testspec, &ext_num if ext_num != 0 ext_num ++ itoa ext_num ext_str strcat testspec, "." strcat testspec ext_str filspec = testspec endif endproc proc get_hi_ext ; return # of highest numbered file with filspec. strparm filspec ; don't call w/ '&' on 1'st parameter. intparm ext_num integer cur_num ext_num = 0 strcat filspec, ".*" ; searching for extensions findfirst filspec if found while found atoi $FEXT cur_num if cur_num > ext_num ext_num = cur_num endif findnext endwhile if ext_num < 1 ext_num = 1 ; 'One' signals the original (un-numbered) file found. endif endif endproc proc inc_ext strparm filspec integer ext_num string ext_str strfmt s1 "input of inc_ext %s" filspec messge s1 call get_ext_num with &filspec, &ext_num ext_num ++ if ext_num < 2 ext_num = 2 endif itoa ext_num, ext_str call change_ext with &filspec, &ext_str endproc proc change_ext ; change extension on filspec to new_ext strparm filspec, new_ext call clip_ext with &filspec call add_ext with &filspec, new_ext endproc proc clip_ext strparm in_str string temp1, temp2 call split_name with &in_str, ".", &temp1, &temp2 in_str = temp1 endproc proc add_ext ; add extension to filename ( with dot ) strparm filspec, ext integer pos, last strlen filspec, last dec last find filspec, ".", pos ; see if filspec already has a trailing dot. if pos != last strcat filspec, "." ; if not, append one. endif find ext, "." ; see if extension already has a leading dot. if found substr ext, ext, 1, 80 ; if so, remove dot. endif strcat filspec, ext endproc proc Clip_str ; remove 'n' characters from end of target string strparm target_str intparm n integer len strlen target_str len len = len - n if len > 0 substr target_str target_str 0 len else strcpy target_str, $NULL endif endproc proc get_ext strparm in_str, ext string left_str = $NULL, temp_str = $NULL find in_str, "\" if found call split_name with &in_str, "\", &left_str, &temp_str else strcpy temp_str, in_str endif call split_name with &temp_str, ".", &left_str, &ext endproc proc split_name ; split in_str at rightmost occurrence of symbol strparm in_str, symbol, left_str, right_str ; output in left_str, right_str string temp_str integer len, pos, size, found_one = 0 strcpy temp_str, in_str strcpy left_str, $NULL strcpy right_str, $NULL sn_loop: strlen temp_str, len find temp_str, symbol, pos if found found_one = 1 size pos + 1 substr s1, temp_str, 0, size strcat left_str, s1 substr temp_str, temp_str, ize, 80 ; size actually goto sn_loop endif if found_one strcpy right_str, temp_str ; put remaining string in right_str call clip_str with &left_str, 1 else ; delimiter not found left_str = in_str right_str = $NULL endif endproc proc get_ext_num ; return extension number from filspec strparm filspec intparm ext_num string ext ext_num = 0 call get_ext with &filspec, &ext atoi ext, ext_num endproc proc shorten_numstr ; clips leading zeros ( from date/time strings ) strparm i_o_str integer day atoi i_o_str day itoa day i_o_str endproc proc name_month strparm month_str ; number of month, passed as string. Use & integer mo ; month number string month_names = "janfebmaraprmayjunjulaugsepoctnovdec" atoi month_str mo ; convert to integer mo -= 1 ; subtract 1 and... mo *= 3 ; multiply by 3 to get offset into name_str substr month_str, month_names, mo, 3; clip name, e.g. 'jul' into output_str endproc proc get_int ; get nonzero integer with prompt. strparm msg intparm int re_enter: call msg_no_cr with &msg get int if int == 0L usermsg "Invalid entry... Let's try it again." goto re_enter endif endproc proc get_long ; get nonzero long integer with prompt. strparm msg longparm long_int gl: call msg_no_cr with &msg get long_int if long_int == 0L usermsg "Invalid entry... Let's try it again." goto gl endif endproc proc get_str ; get string with prompt strparm msg, result_str call msg_no_cr with &msg get result_str endproc proc msg_no_cr strparm msg set msg_crlf off message msg message " " set msg_crlf on endproc proc ConfirmDir ; Confirm that directories exist. If not, ask if make. strparm dir_name ; On entry, old path. On exit, old or corrected path. loopDE: call DirExists with &dir_name f not found strfmt s1 "Directory %s does not exist." dir_name message s1 call AskYesOrNo with "Shall I create it?" if failure message "OK, then let's try it again." pause 2 call Prompt4Dir with &dir_name goto loopDE else call MkPath with &dir_name ; makes path or negotiates alternate path endif endif endproc ; proc DirExists ; see if directory exists, result in FOUND strparm dir_name string filspec call SplicePath with &filspec, &dir_name, "*.*" findfirst filspec, "D" ; works because of dummy entries used by MS-Dos endproc ; proc MkPath ; make nested subdirectories ( any depth ) strparm path_param string dest_path, cur_char, prev_char, source_path integer index, maxindex, dummyint strcpy dest_path, $NULL index=1 strcpy source_path, path_param call CheckBackSlash with &source_path ; add trailing backslash if none strlen source_path maxindex maxindex -- if maxindex > 0 strcpy dest_path source_path 1 ; xfer 0'th char from source to dest strcpy cu_char, dest_path while index <= maxindex prev_char = cur_char StrPeek source_path, index, dummyint key2ascii dummyint cur_char index ++ strcmp cur_char "\" ; compare if failure strcat dest_path cur_char ; append if not \ loopwhile else ; was \ strcmp prev_char ":" if success goto hopalong ; skip DirExists test for root directories. endif call DirExists with dest_path if not found MkDir dest_path if success message "created directory:" message dest_path else message "could not create directory:" message dest_path endif endif hopalong: strcat dest_path cur_char ; append if not \ endif endwhile endif endproc proc Prompt4Dir ; dialog appears whenever directory not found. strparm dir_name Message "^M^J Enter a directory for your saved files." Message " (e.g. 'a:' or c:\articles\ibm\qa\)" newln Message "Do NOT include a filename. If oe or more directories" Message "in your path does not yet exist, they will be created" Message "if you so desire ^M^J^M^J" call get_str with "Enter name ==>" &dir_name call ConfirmDir with &dir_name endproc proc SplicePath ; combines two parts of a path; fixes backslash between. strparm result, dir_name, filename strcmp dir_name $NULL ; for current directory if failure call CheckBackslash with &dirname result = dir_name strcat result, filename else strcpy result, filename endif endproc ; proc CheckBackSlash ; check/add backslash to a directory name strparm dir_name string end_char call GetLastChar with &end_char, &dir_name strcmp end_char, "\" if failure strcat dir_name "\" endif endproc ; proc GetLastChar ; returns last character from string strparm result, source integer length, keycode strlen source length ; get length if length > 0 length -- strpeek source length keycode key2ascii keycode result else strcpy result, $NULL endif endproc proc AskYesOrNo ; hotkey y/n with alert. Result in "if success..." strparm prompt integer key_code string key_char strcat prompt " [Y/N] ? " rattle_cage retry: newln message prompt KeyGet key_code ; single keys can only be fetched as integer vars key2ascii key_code key_char ; move result to string strupr key_char ; convert to uppercase strcmp key_char "Y"; test for yes if failure strcmp key_char "N"; test for no if failure usermsg "Try again !" newln goto retry else strcmp "Y" "N"; dummy compare to set "failure" flag endif endif endproc proc GetBBstats longparm lo_msg_num, hi_msg_num, cur_msg_num string string1 prompt_received = 0 when 0 "Command: " CALL SETFLAG ; watch for prompt while script busy. rflush set rxdata on ; hold received chars. in RC buffer for processing by script. statmsg "Examining menu to determine high and low message numbers." transmit "^M" call get_hi_low with &string1, &hi_msg_num ; grab line with low/hi info. if hi_msg_num != -1L ; empty newsgroup call get_current with &cur_msg_num ; grab line for current msg. set rxdata off call parse_hi_low with &string1, &lo_msg_num, &hi_msg_num else set rxdata off ; turn off intercept endif call wait_for_flag with 45 ; see if prompt there yet. If not, waits. cwhen 0 endproc proc get_hi_low ; scan news menu & grab line containing low/high msg. number strparm current_string ; on return, contains menu line with hi/lo info longparm hi_msg_num ; on return, contains -1 for empty newsgroup integer counter find_loop2: rget curren_string, 80, 60 if failure rattle_cage call explain_options goto find_loop2 endif find current_string "First" counter if found ; if word 'first' found in current string if counter != 1 ; if 'first' found but not at start of line goto find_loop2 ; try again else return endif else ; not found find current_string "There " counter if found ; if "There are no articles in this group" hi_msg_num = -1l ; signal empty return endif goto find_loop2 endif endproc proc explain_options message "^M^J^M^J The script did not find the expected menu information," message "and is now waiting for you to try and get it back on track. Try" message "Try exiting the newsgroup and re-entering. If that works, the" message "script will pick up where it left off. If not, abort and rerun it." endproc proc parse_hi_low ; extracts hi/low message numbers from captured menu line. strparm hi_lo_line longparm lo_msg_num, hi_msg_num string intstr integer pos, len find hi_lo_line "#" pos inc pos strlen hi_lo_line len len = len - pos + 1 substr intstr hi_lo_line pos len AtoL intstr, lo_msg_num find intstr "#" pos inc pos strlen intstr len len = len - pos + 1 substr intstr intstr pos len AtoL intstr hi_msg_num endproc proc get_current ; scan menu for current message number. longparm current_number string current_string integer byte_val = 0, len = 0 fmloop: rget current_string, 80, 45 ; read next menu line from buffer if failure rattle_cage call explain_options goto fmloop endif strlen current_str len if len < 2 ; skip empty strings goto fmloop endif clip_loop: strpeek current_string, 0, byte_val ; get first char. in string if (byte_val == 10) || (byte_val == 27 ) ; remove leading or substr current_string, current_string, 1, 80 goto clip_loop ; skip linefeeds, ESC, and empty strings endif strpeek current_string, 1, byte_val ; look at column #2 if byte_val == 32 goto fmloop ; skip lines starting with space, ESC, or wierd chars. endif call parse_current with ¤t_string, ¤t_number ; extract number if not current_number ; if line didn't contain any numbers, keep looking goto fmloop endif endproc proc parse_current ; extract long integer 'buried' in string strparm str longparm result integer byte, len strlen str len while ( len > 0 ) strpeek str 0 byte if ( byte > 47 ) && ( byte < 58 ) ; numeric exitwhile endif len -- substr str str 1 80 ; remove one leading char. from string. endwhile ; repeat until the message number is in the lead position. AtoL str result ; read the number into a long integer. endproc proc ShowLong ; Diagnostic: Displays descriptive label and long integer. strparm label longparm long_val newln strfmt s1 "%s: %ld" label, long_val message s1 endproc proc ShowString ; Diagnostic: Displays descriptive label and string strparm label, target_string strfmt s1 "%s %s" label, target_string newln message s1 endproc proc ShowInt; Diagnostic. Displays descriptive label and integer. strparm label intparm int_val newln newln strfmt s1 "%s: %d" label, int_val message s1 endproc ; ------------------- Alert routines ----------------------- proc alert_msg2 ; called by macro 'statalarm2'. Beeps w/ 2 msgs. in status line. strparm msg1, msg2 strfmt s1 "%s %S" msg1, msg2 statalarm s1 endproc proc soundoff integer dummy if speaker_enabled alarm 9999 else keyget dummy endif endproc proc add_fext_prefix ; Prefixes short file extensions with tag strparm filename ; e.g. 'myfile.2' becomes 'myfile.ma2' strparm tag string ext call get_ext with &filename, &ext call add_ext_prefix with &ext, tag call change_ext with &filename, ext endproc proc add_ext_prefix ; converts file ext. of '2' to 'ma2' strparm i_o ; on input, ext. string. On output, prefixed ext. string strparm tag ; to be used as extension prefix, e.g. 'ma2' string temp_str integer length find tag, "." ; see if extension already had a dot. if found substr tag, tag, 1, 80 ; if so, remove dot. endif strlen i_o length length = 3 - length ; length of unused space in file extension string. substr temp_str, tag, 0, length ; copy that many characters to temp_str strcat temp_str, i_o strcpy i_o, temp_str endproc proc which_signal ; sends and waits for one of 3 signals. ; Output [1..3] in global result_code strparm prompt1, prompt2, prompt3, trigger integer loop_counter = 0 result_code = 0 when 0 prompt1 call result1 when 1 prompt2 call result2 strcmp prompt3 $NULL if failure when 2 prompt3 call result3 endif transmit trigger ; usually ^M wsloop: while not ( result_code || ( loop_counter > 1000 ) ) ; 1 min. timeout loop loop_counter ++ mspause 50 endwhile ; wait until the when cmd. sets promp_type flag cwhen 0 cwhen 1 cwhen 2 strfmt s1 "Timeout waiting for prompt %s or %s" , prompt1, prompt2 if loop_counter > 1000 rattle_cage message s1 call explain_options loop_counter = 0 goto wsloop endif endproc proc result1 ; used with 'when' statements that don't allow parameters result_code = 1 endproc proc result2 result_code = 2 endproc proc result3 result_code = 3 endproc proc time_out intparm time_delay strparm msg integer timeout_count call time_out2 with &time_delay, &msg, &timeout_count if timeout_count < 0 newln message msg message "Hanging up due to inactivity" hangup call abort_script endif endproc proc time_out2 ; sounds alarm for time_delay secs and prompts for keypress intparm time_delay strparm msg intparm timeout_count ; returns -1 if user did not respond to alarm string msg_plus timeout_count = time_delay strcpy msg_plus ">>> " strcat msg_plus msg strcat msg_plus " Press any key." strcat msg_plus " <<<" set keys on ; intercept keystrokes kflush while not ( hitkey || ( timeout_count < 0 ) ) statmsg msg_plus ; flash the message if SPEAKER_ENABLED sound 1000 50 else mspause 500 endif statmsg " " mspause 500 timeout_count -- endwhile if ( timeout_count < 0 ) message msg_plus ; keep msg_plus onscreen endif statrest kflush set keys off endproc proc disk_problem integer option retry_dp: message "^M^J Disk management menu^M^J" message "1 Check disk space" message "2 Fix disk space" message "3 Retry previous operation" message "4 Abort script (controlled exit) ^M^J" call get_int with "Select: ==>" &option switch option case 1 call check_disk_space endcase case 2 call fix_disk_space endcase case 3 exitswitch endcase case 4 call abort_script endcase default usermsg "Invalid response" goto retry_dp endcase endswitch endproc proc check_disk_space long disk_space integer drive_num message "^M^J Enter disk number to check: " message "1 drive A" message "2 drive B" message "3 drive C" message "4 drive D" message "... and so on" call get_int with "^M^J Enter drive number: ", &drive_num diskfree drive_num, disk_space call ShowLong with "disk space is: " disk_space kflush if disk_space < 10000L message "^M^J The space on this disk is very low." call fix_disk_space endif endproc proc fix_disk_space call disk_blurb call AskYesOrNo with "^M^J Do you wish to 'shell' to MS-Dos" if success shell endif endproc proc disk_blurb message "^M^J^M^J If you select the option below, you will be able to clear" message "space on your disk, without exiting the script program. The" message "script will be put on hold, and you will be placed in MS-Dos." message "When you're done, type EXIT and the script will pick up where" message "it left off." endproc proc fopen_mk_bak ; like fopen, but creates .bak file before over-writing. intparm index ; also has repair loop for bad filenames. strparm filename, options string bak_path isfile filename if success ; if file already exists strcpy bak_path filename call change_ext with &bak_path, "bak" isfile bak_path if success delete bak_path endif rename filename bak_path endif set fgets_crlf off fopen_retry: fopen index, filename, options if failure statalarm2 "Error opening ", filename message "^M^J This could be a disk space problem." message "I am referring you to the disk management menu. ^M^J^M^J" call disk_problem goto fopen_retry endif endproc proc restore_bak strparm original_path string bak_path strcpy bak_path, original_path call change_ext with &bak_path, "bak" ; figure out full path to .bak file isfile bak_path if success ; if .bak file exists... isfile original_path if success delete original_path endif rename bak_path original_path endif endproc proc pause2 ; delay 'n' seconds (usually for display). Any key exits. intparm n n *= 10 set keys on while not ( hitkey || (n < 0) ) mspause 100 n -- endwhile if n >= 0 keyget n n9 = n ; used for callng up menu from welcome screen endif set keys off endproc proc dissect strparm str integer j, len, byte, count = 0 string out_str strlen str, len message "^M^J^M^J^M^J *****" message str set msg_crlf off for j =0 upto len strpeek str, j, byte ItoA byte out_str strcat out_str " " message out_str count ++ if count > 10 message "^M^J" count = 0 endif endfor set msg_crlf on message " " endproc ; --- Routines to check 2-letter file prefixes for duplicates ------- string prefix_list proc clear_list buffer_count = 0 ; reset file counter. group_count = 0 strcpy prefix_list $NULL list_pointer = 0 endproc proc check_list strparm target_str integer list_index = 0 string temp_str check_loop: if list_index <= list_pointer substr temp_str, prefix_list, list_index, 2 strcmp temp_str, target_str if success call get_prefix with &target_str goto check_loop endif list_index += 2 goto check_loop endif endproc proc get_prefix strparm target_str rattle_cage strfmt s1 "ERROR: Duplicate file prefix: %s in shopping_list" target_str message s1 message "Please enter a different two-letter prefix for this file." Call get_str with "Prefix: ", &target_str substr target_str, target_str, 0, 2 ; truncate to two chars. message "^M This new prefix will allow you to complete the current session." message "However, to avoid getting this message each time you run the" message "script, you will need to fix the duplicate in your shopping_list" message "and recompile the script. ^M" keyget n1 endproc proc add_to_list strparm target_str if list_pointer >= 78 statalarm "Overflow in add_to_list. Notify aa387@cleveland.freenet.edu." call abort_script endif call check_list with &target_str strcat prefix_list, target_str list_pointer += 2 endproc ; - - clip here ans save as SCANNER.ASP in your PCPLUS directory - -