;Host Mode include file - Do not compile! ;*********************************************************************** ;* * ;* SUBS.WAS * ;* Copyright (C) 1992 Datastorm Technologies, Inc. * ;* All rights reserverd. * ;* * ;* Purpose: Contains most of the lower level com and file I/O * ;* routines for Host Mode. * ;* * ;*********************************************************************** ;*********************************************************************** ;* * ;* WARNING!!!! * ;* * ;* Do not modify this script file unless you have a good under- * ;* standing of the Windows ASPECT language. If you do modify this * ;* script, PLEASE MAKE A BACKUP before doing so. * ;* * ;*********************************************************************** ;*********************************************************************** ;* * ;* HOSTSETUP * ;* * ;* The procedure opens the HOST.PRM file and reads in variables. * ;* Also sets up the paths for the mail files. * ;* * ;* Calls: HOSTMSGBOX, * ;* * ;* Called by: MAIN * ;* * ;* Modifies globals: sysop, local_logon, parmfile, hdrfile, msgfile, * ;* logfile, usrfile, welcome_msg, upload_path, * ;* dnload_path, new_usr_leve, connect_type, * ;* system_type, goodbye_option, old_menu, new_menu * ;* * ;*********************************************************************** proc HostSetup string junk sysop=0 local_logon=0 set aspect spawn on fetch aspect scriptpath parmfile addfilename parmfile HOSTPRMFILE fetch aspect scriptpath hdrfile addfilename hdrfile HOSTHDRFILE fetch aspect scriptpath msgfile addfilename msgfile HOSTMSGFILE fetch aspect scriptpath logfile addfilename logfile HOSTLOGFILE fetch aspect scriptpath usrfile addfilename usrfile HOSTUSRFILE fetch aspect scriptpath newsfile addfilename newsfile HOSTNWSFILE fetch aspect scriptpath nufile addfilename nufile HOSTNUFILE fetch aspect scriptpath dnldfile addfilename dnldfile HOSTDNLDFILE fetch aspect scriptpath nufile addfilename nufile HOSTNUFILE fetch aspect scriptpath logfile addfilename logfile HOSTLOGFILE fopen 0 parmfile READ TEXT if not success HostMsgBox("FATAL ERROR - Can't open HOST.PRM!") exithost() endif fgets 0 welcome_msg ; note: upload_path and dnload_path used to be loaded from file, now they are specified by DASWIN program fgets 0 junk assign upload_path, publicDataDirectory set upldpath, publicDataDirectory fgets 0 junk assign dnload_path, publicDataDirectory set dnldpath, publicDataDirectory fgetc 0 new_usr_level new_usr_level-=1 fgetc 0 connect_type connect_type-=1 fgetc 0 system_type system_type-=1 fgetc 0 goodbye_option goodbye_option-=1 fclose 0 save_prm() set aspect control off ; turn off script button set aspect keys on ; we do all keys set aspect rxdata on ; we do all incoming data set terminal enquiry off set terminal statusline off set viewgif no ; don't view GIF files set autodnld off ; Don't autodownload on host set zmodem errdetect crc32 ; Use 32-bit CRC set zmodem recvcrash protect ; Don't let users overwrite files set zmodem sendcrash negotiate ; Let user recover his downloads set zmodem timestamp off ; Stamp files with system date/time set zmodem txmethod streaming ; Use fastest transmit method when userexit call ExitHost endproc ;*********************************************************************** ;* * ;* STARTCALL * ;* * ;* This procedure gets * ;* clears modem and sends sign-on message * ;*Calls HOSTPUTS * ;* * ;* Called by: MAIN * ;* * ;* Modifies globals: welcome_msg, t * ;* * ;* * ;* * ;*********************************************************************** proc StartCall ; clears modem buffers and sends sign-on message pause 1 ; pause a moment, then flush the rxflush ; buffers to remove any wierd modem txflush ; message or handshake characters HostPutS("`r`n`r`n") HostPutS(welcome_msg) ; display welcome message HostPutS("`r`n") endproc ;*********************************************************************** ;* * ;* GETUSER * ;* * ;* This procedure prompts a user to login. * ;* * ;* * ;* Calls: XKEYGET, HOSTLOG, SETFAILURE, GETUSERNAME, GETUSERPSWD, * ;* PARSEUSRREC, SETSUCCESS * ;* * ;* Modifies globals: tempkey, connect_type, ontime * ;* * ;*********************************************************************** proc GetUser while 1 if $keyhit XKeyGet(&tempkey) endif if (! $carrier) && (connect_type==MODEM_CON) HostLog("Lost Carrier", "") SetFailure() return endif GetUserName() ; Get the users name if success GetUserPswd() ; Get the users password if success ParseUsrRec() ; strfind and parse user record if success ; If found and parsed time ontime ; get current time SetSuccess() return else SetFailure() ; Error getting user record return endif else SetFailure() ; Error getting password return endif else ; Error getting user name SetFailure() return endif endwhile endproc ;*********************************************************************** ;* * ;* GETUSERNAME * ;* * ;* This procedure get the first and last name from the remote user. * ;* * ;* * ;* Calls: HOSTLOG, SETFAILURE, HOSTPUTS, HOSTGETS, HOSTGETYN, * ;* HOSTHANGUP * ;* * ;* Modifies globals: connect_type, first, last, name * ;* * ;*********************************************************************** proc GetUserName integer i, len, tries tries = 0 if (! $carrier) && (connect_type==MODEM_CON) HostLog("Lost Carrier", "") SetFailure() return endif pause 1 rxflush while tries < 3 tries++ HostPutS("`r`n`r`nFirst name: ") HostGetS(&first, NAMEMAX, DISP) ; Get first (and optionally last) if not success ; return FAILURE if CD drops exitwhile endif strlen first len ; len = length of first name if len == 0 ; If length is zero loopwhile ; go to top of loop endif strfind first " " i ; Is there a last name? (SPACE) if not found strfind first ";" i ; (Look for SEMICOLON if no SPACE) endif if found ; YES, there is a last name: strpoke first i 0 ; terminate the first name i++ ; i -> 1st character in last name substr last first i 80 ; ulast is last name else HostPutS("`r`nLast name: ") HostGetS(&last, NAMEMAX, DISP) ; Get last name if not success exitwhile endif strlen last len if len == 0 loopwhile endif endif strupr first strupr last name = first strcmp last "" if not success strcat name " " strcat name last endif HostPutS("`r`n") HostPutS(name) HostPutS("`r`nIs this correct (Y/N)? ") HostGetYN() if success return else ; if user says NO tries-- ; don't count it as a try endif endwhile if connect_type==MODEM_CON HostHangup() endif HostLog("unknown caller", "failed to enter name.") SetFailure() endproc ;*********************************************************************** ;* * ;* GETUSERPSWD * ;* * ;* This procedure get the users password. * ;* * ;* * ;* Calls: HOSTPUTS, HOSTLOG, SETFAILURE, HOSTGETS, SETSUCCESS, * ;* HOSTHANGUP * ;* * ;* Modifies globals: connect_type, passwrd, name * ;* * ;*********************************************************************** proc GetUserPswd integer i, tries tries = 0 HostPutS("`r`n") while tries < 3 if (! $carrier) && (connect_type==MODEM_CON) HostLog("Lost Carrier", "") SetFailure() return endif HostPutS("`r`nPassword: ") HostGetS(&passwrd, PSWDMAX, MASK) ; Get passwrd if not success exitwhile endif strlen passwrd i if i > 0 strupr passwrd SetSuccess() return endif tries++ endwhile if connect_type==MODEM_CON HostHangup() endif HostLog(name, "failed to enter password.") SetFailure() endproc ;*********************************************************************** ;* * ;* HOSTGETS * ;* * ;* This procedure gets a string from the remote user. * ;* * ;* * ;* Calls: HOSTGETC, SETSUCCESS, HOSTPUTS * ;* * ;* Modifies globals: none * ;* * ;*********************************************************************** proc HostGetS strparm s intparm max, dodisp integer i string response strpoke s 0 0 i = 0 while 1 HostGetC(&response) if not success exitwhile endif switch response case "`r" SetSuccess() exitwhile endcase case "`b" if i != 0 HostPutS(response) i-- strpoke s i 0 endif endcase case " " ; This SPACE case must immediately if i == 0 ; precede the default so it will loopwhile ; fall through endif default if i < max if dodisp HostPutS(response) else HostPutS("*") endif strcat s response i++ endif endcase endswitch endwhile endproc ;*********************************************************************** ;* * ;* HOSTGETYN * ;* * ;* This procedure get a Y or N from the remote user. * ;* * ;* * ;* Calls: HOSTGETC, HOSTPUTS, SETSUCCESS, SETFAILURE * ;* * ;* Modifies globals: none * ;* * ;*********************************************************************** proc HostGetYN string response while 1 HostGetC(&response) if not success return endif strupr response HostPutS(response) switch response case "Y" SetSuccess() return endcase case "N" default SetFailure() return endcase endswitch endwhile endproc ;*********************************************************************** ;* * ;* HOSTGETC * ;* * ;* This procedure gets a character from the remote user. * ;* * ;* * ;* Calls: XKEYGET, HOSTLOG, SETFAILURE, SETSUCCESS * ;* * ;* Modifies globals: local_logon, connect_type * ;* * ;*********************************************************************** proc HostGetC strparm c integer i = -1 while i == -1 if $keyhit ; If a key is pressed XKeyGet(&i) ; get the key endif if !local_logon #ifndef test if $RXDATA ; If data available at port comgetc i ; get the next character endif if (! $carrier) && (connect_type==MODEM_CON) ; If carrier drops HostLog("Lost Carrier", "") SetFailure() ; set error return code return ; and return to caller endif #endif endif endwhile strfmt c "%c" i SetSuccess() endproc ;*********************************************************************** ;* * ;* HOSTPUTS * ;* * ;* This procedure send a string to the remote user and displays it * ;* in the terminal window. * ;* * ;* Calls: NONE * ;* * ;* Called by: EVERYTHING!! 168 times * ;* * ;* Modifies globals: local_logon * ;* * ;*********************************************************************** proc HostPutS strparm s if !local_logon transmit s ; send the string to the remote user endif termwrites s ; send the string to the local screen endproc ;*********************************************************************** ;* * ;* PARSEUSRREC * ;* * ;* This procedure looks up a user in .USR file and parse record * ;* into globals. * ;* * ;* * ;* Calls: ADDUSER, COPYSFLD, SETSUCCESS, GETUSERPSWD, HOSTPUTS, * ;* HOSTHANGUP, HOSTLOG, SETFAILURE, HOSTMSGBOX * ;* * ;* Modifies globals: name, first, last, passwrd, usrfile, record, * ;* access_level, remarks, connect_type, system_type * ;* * ;* NOTES: * ;* access_level - User's access level ("0", "1", or "2") * ;* comment - User's comment field * ;* first - User's first name * ;* last - User's last name * ;* name - User's full name (first and last) * ;* passwrd - User's password * ;* record - Raw record (terminated with a line feed) * ;* * ;* HOSTS.USR record: * ;* * ;* lastname;firstname;passwrd;n;comment....... * ;* (n is the access_level level {'0','1',or '2'}) * ;* * ;*********************************************************************** proc ParseUsrRec integer i, tries=1 string tmp, tmp2 strfind name " " i ; i = index of blank name separator if found strcpy first name i ; copy first name i++ ; i = index of last name substr last name i 79 ; extract last name endif strfmt tmp "%s;%s" last first ; 'tmp' is what we're looking for strfmt tmp2 "%s;%s;%s" last first passwrd strlen tmp i ; i = length of name part isfile usrfile if not success AddUser() return else fopen 1 usrfile READ TEXT ; Try to open user file endif if success ; If opened while not FEOF 1 ; loop until end of file fgets 1 record ; Get record strcmp record tmp i ; Scan record for user if success ; If this is our guy, while tries<3 strlen tmp2 i strcmp record tmp2 i if success ; Copy password CopySFld(&passwrd, record, &i, FLD_SEP) ; Copy access level level CopySFld(&access_level, record, &i, FLD_SEP) ; Copy comment CopySFld(&remarks, record, &i, FLD_SEP) SetSuccess() return else GetUserPswd() if success strfmt tmp2 "%s;%s;%s" last first passwrd endif tries++ endif endwhile HostPutS("`r`n`r`nPassword incorrect.`r`n") if connect_type==MODEM_CON HostHangup() endif HostLog(name, "failed password check.") SetFailure() return endif endwhile fclose 1 if system_type==CLOSED_SYSTEM HostPutS("`r`nSorry, this is a closed system.`r`n") if connect_type==MODEM_CON HostHangup(); endif HostLog(name, "attempted to login to closed system.") SetFailure() return endif AddUser() return else HostMsgBox("FATAL ERROR - Can't open HOST.USR file!") endif SetFailure() endproc ;*********************************************************************** ;* * ;* COPYSFLD * ;* * ;* This procedure will copy a string field (SFLD) from any position * ;* within the source string, to the destination string. Also, it * ;* will increment the index by the length of the field copied. * ;* * ;* Calls: NONE * ;* * ;* Modifies globals: none * ;* * ;* NOTES: * ;* Input: (&destination,source,&index,field_separator) * ;* * ;* Return: destination and int are updated. * ;* * ;* Notes: Terminates when a field_separator or line feed is * ;* encountered. If neither is encountered, the rest of the * ;* field is copied. * ;* * ;*********************************************************************** proc CopySFld strparm dst strparm src intparm index intparm fldsep integer newidx string endstr,tmp substr endstr src index 79 ; copy end of string to local var strfmt tmp "%c" fldsep ; tmp = field separator as a string strfind endstr tmp newidx ; see if a separator is in the string if not found ; If separator not found: strfind endstr "\n" newidx ; is a line feed in the string? if not found ; If not: strlen endstr newidx ; use the whole string endif endif strcpy dst endstr newidx ; copy field index = index + newidx + 1 ; set caller's index endproc ;*********************************************************************** ;* * ;* HOSTHANGUP * ;* * ;* This procedure attempts to hangup the line several times. * ;* * ;* * ;* Calls: HOSTPUTS, TXWAIT * ;* * ;* Modifies globals: none * ;* * ;*********************************************************************** proc HostHangup integer hanguptries=3 while $TXCOUNT>0 ; wait for tx buffer to clear endwhile if not $carrier return endif while hanguptries-- pause 1 hangup if not $carrier exitwhile endif endwhile if $carrier HostPutS ("`r`nERROR: Unable to hangup.`r`n") endif endproc ;*********************************************************************** ;* * ;* SETFAILURE * ;* * ;* This procedure sets the IF FAILURE flag to TRUE. * ;* * ;* * ;* Calls: NONE * ;* * ;* Modifies globals: none * ;* * ;*********************************************************************** proc SetFailure strcmp "X" "Y" ; compare is always FALSE endproc ;*********************************************************************** ;* * ;* SETSUCCESS * ;* * ;* This procedure sets the IF SUCCESS flag to TRUE. * ;* * ;* * ;* Calls: NONE * ;* * ;* Modifies globals: none * ;* * ;*********************************************************************** proc SetSuccess strcmp "X" "X" ; compare is always TRUE endproc ;*********************************************************************** ;* * ;* XKEYGET * ;* * ;* This procedure processes local keystrokes. * ;* * ;* * ;* Calls: EXITHOST, HOSTHANGUP * ;* * ;* Modifies globals: none * ;* * ;*********************************************************************** proc XKeyGet intparm key integer real_key keyget key ; get the key value switch key case 0x409 ; ALT-TAB ; these special keys must be case 0x14 ; CAPS LOCK ; must be passed to the case 0x890 ; NUM LOCK ; main window to be recognized termkey key key=0x00 endcase case 0x458 ; E&xit Host case 0x558 ExitHost() endcase case 0x444 case 0x544 ; &Disconnect User HostHangup() longjmp 1 1 endcase case 0x452 case 0x552 longjmp 1 1 ; &Recycle host endcase default keytoascii key real_key ; convert virtual key into key=real_key ; ASCII value for return endcase endswitch endproc ;*********************************************************************** ;* * ;* GETNEWPSWD * ;* * ;* This procedure gets the password for a new user. * ;* * ;* * ;* Calls: HOSTPUTS, HOSTGETS, SETSUCCESS, HOSTHANGUP, HOSTLOG, * ;* SETFAILURE * ;* * ;* Modifies globals: passwrd, connect_type, name * ;* * ;*********************************************************************** proc GetNewPswd integer i, tries string newpswd tries = 0 HostPutS("`r`n") while tries < 3 HostPutS("`r`nPlease verify: ") HostGetS(&newpswd, PSWDMAX, MASK) ; Get passwrd if not success exitwhile endif strlen passwrd i if i > 0 strupr passwrd strupr newpswd strcmp passwrd newpswd if success SetSuccess() return endif endif tries++ endwhile if connect_type==MODEM_CON HostHangup() endif HostLog(name, "failed to verify password.") SetFailure() endproc ;*********************************************************************** ;* * ;* ADDUSER * ;* * ;* This procedure adds a new user the the HOST.USR file. * ;* * ;* Calls: GETNEWPSWD, HOSTMSGBOX, DISPLAYFILE, HOSTLOG, SETSUCCESS, * ;* SETFAILURE * ;* * ;* Modifies globals: usrfile, record, last, first, passwrd, * ;* new_usr_level, access_level, name * ;* * ;*********************************************************************** proc AddUser GetNewPswd() if success isfile usrfile if not success fopen 1 usrfile CREATE TEXT if not success HostMsgBox("FATAL ERROR - Can't create HOST.USR file!") exithost() endif else fopen 1 usrfile WRITE TEXT if not success HostMsgBox("Can't open HOST.USR file!") exithost() endif fseek 1 0 2 ; go to end of file endif strfmt record "%s;%s;%s;%i;* NEW USER *" last first passwrd new_usr_level itoa new_usr_level access_level fputs 1 record if not success HostMsgBox("Didn't write user info! - Proc AddUser") endif fclose 1 DisplayFile(nufile, 23) HostLog(name, "first login - added to user file.") SetSuccess() return endif SetFailure() endproc ;*********************************************************************** ;* * ;* EXITHOST * ;* * ;* This procedure allows safe shutdown of Host Mode script. * ;* * ;* * ;* Calls: HOSTHANGUP, HOSTMSGBOX, HOSTLOG, RESTORE_PRM * ;* * ;* Modifies globals: connect_type, action_status, meta_status, * ;* dial_status, setup_status * ;* * ;*********************************************************************** proc ExitHost string auto_ans_off if (connect_type==MODEM_CON) || (local_logon==TRUE) rxflush txflush transmit "^M" statmsg "Closing Host Mode ..." BEEP set txpace 50 if $CARRIER HostHangup() fetch modem autoansoff auto_ans_off pause 1 transmit auto_ans_off waitfor "OK" 8 else fetch modem autoansoff auto_ans_off pause 1 transmit auto_ans_off waitfor "OK" 8 endif endif HostMsgBox("Host Mode aborted") HostLog("Host mode offline.", "") restore_prm() if action_status actionbar on endif if meta_status metakeys on endif if dial_status dialdir on endif if setup_status setup on endif statmsg " " pwtitlebar "PROCOMM PLUS for Windows" clear exit endproc ;*********************************************************************** ;* * ;* DISPLAYFILE * ;* * ;* This procedure sends an ASCII file to the remote user with paging. * ;* * ;* * ;* Calls: SETFAILURE, HOSTPUTS, HOSTGETC, SETSUCCESS * ;* * ;* Modifies globals: none * ;* * ;*********************************************************************** proc DisplayFile strparm _file ; file to transmit intparm page_length ; how many lines before -MORE- prompt string line, response integer count=0 isfile _file ; check for the file if not success ; if it doesn't exist SetFailure() ; return return endif fopen 5 _file READ ; open the file while 1 ; loop forever fgets 5 line ; get a line if FEOF 5 ; check for EOF exitwhile endif HostPutS(line) ; display line inc count ; increment line counter if count==page_length ; if count == page length display a prompt HostPutS("-MORE-") HostGetC(&response) ; get user input HostPutS("`b`b`b`b`b`b") strupr response strcmp response "N" ; if the user says NO then if success exitwhile endif count=1 ; reset line counter endif endwhile fclose 5 ; close the file SetSuccess() endproc ;*********************************************************************** ;* * ;* HOSTMSGBOX * ;* * ;* This procedure displays a dialog box with an error message for * ;* 3 seconds. * ;* * ;* Calls: NONE * ;* * ;* Modifies globals: message * ;* * ;*********************************************************************** proc HostMsgBox strparm _message beep mspause 500 beep mspause 500 dialogbox 48 20 174 65 15 "Host Mode Message" vtext 1 16 167 26 center message enddialog message=_message updatedlg -1 pause 3 destroydlg endproc ;*********************************************************************** ;* * ;* CHAT * ;* * ;* This procedure allows the sysop and a remote user to converse * ;* online. * ;* * ;* * ;* Calls: HOSTPUTS, HOSTGETC, SETFAILURE * ;* * ;* Modifies globals: msg, name, status * ;* * ;*********************************************************************** proc Chat string c long timer HostPutS("`r`nPaging Host Operator ...`r`n") strfmt msg "Remote user %s is requesting to chat." name dialogbox 26 22 200 67 13 pushbutton 59 38 76 14 "OK" normal default vtext 9 13 178 9 center msg enddialog status=$DIALOG alarm alarm timer=$LTIME while ($LTIME < (timer+8)) if status==10 destroydlg HostPutS("Host Operator is online!`r`n`r`n") HostPutS("Press ESC to end chat.`r`n`r`n") while 1 HostGetC(&c) if failure SetFailure() return endif switch c case "`r" strcat c "`n" endcase case "`x1b" return endcase endswitch transmit c termwrites c endwhile endif status=$DIALOG endwhile destroydlg HostPutS("`r`nHost Operator is not available!`r`n") endproc ;*********************************************************************** ;* * ;* COUNTMSG * ;* * ;* This procedure counts the number of mail messages. * ;* * ;* * ;* Calls: HOSTMSGBOX, EXITHOST * ;* * ;* Modifies globals: hdrfile * ;* * ;*********************************************************************** proc CountMsg intparm number integer dummy string msg_entry number=0 ; start with 0 messages isfile hdrfile ; is HOST.HDR present if not success ; if not return return endif fopen 4 hdrfile READ ; open HOST.HDR if not success ; error opening the file HostMsgBox("FATAL ERROR - Can't open HOST.HDR file!") ExitHost() ; exit script endif while 1 ; loop forever fread 4 msg_entry 128 dummy ; read 1 message entry if FEOF 4 ; if EOF, close file and return fclose 4 return endif inc number ; otherwise add 1 to message count endwhile endproc ;*********************************************************************** ;* * ;* MAILGETLINE * ;* * ;* This procedure accepts a string from the user for entering mail. * ;* * ;* * ;* Calls: HOSTGETC, SETSUCCESS, HOSTPUTS * ;* * ;* Modifies globals: none * ;* * ;*********************************************************************** proc MailGetLine strparm s integer max=70 integer i string response strpoke s 0 0 i = 0 while 1 HostGetC(&response) if not success exitwhile endif switch response case "`r" SetSuccess() exitwhile endcase case "`b" if i != 0 HostPutS(response) i-- strpoke s i 0 endif endcase case " " ; This SPACE case must immediately if i>55 ; precede the DEFAULT so it will i=max ; fall through endif ; do wordwrap stuff here!!! default if i == max HostPutS(response) strcat s response SetSuccess() exitwhile else HostPutS(response) strcat s response i++ endif endcase endswitch endwhile endproc ;*********************************************************************** ;* * ;* CHECKMAIL * ;* * ;* This procedure notifies a user that there is new mail waiting. * ;* * ;* * ;* Calls: HOSTPUTS * ;* * ;* Modifies globals: hdrfile, _date, _time, name * ;* * ;*********************************************************************** proc CheckMail integer msg_num, msg_length, msg_flag, dummy string destination, from, subject long offset isfile hdrfile ; is HOST.HDR present if not success ; if not return return endif fopen 0 hdrfile READ ; open HOST.HDR for read only if not success ; error opening file return endif while 1 ; loop forever fgeti 0 msg_num ; get the message number if FEOF 0 ; if EOF exit the while loop exitwhile endif fgetl 0 offset ; get message file offset fgeti 0 msg_length ; get length of message fgetc 0 msg_flag ; get message flag fread 0 destination 31 dummy ; get TO: fread 0 from 31 dummy ; get FROM: fread 0 subject 37 dummy ; get subject fread 0 _date 9 dummy ; get message date fread 0 _time 11 dummy ; get message time strcmp destination name ; compare message TO: and user name if success ; if this is there message if (msg_flag & 2)==NEWMAIL ; check to see if NEWMAIL flag is set HostPutS("`r`n`aYou have mail waiting!`r`n`r`n") exitwhile ; leave the while loop endif endif endwhile fclose 0 ; close HOST.HDR endproc ;*********************************************************************** ;* * ;* CHANGEFLAG * ;* * ;* This procedure modifies the flag byte for a message. * ;* * ;* * ;* Calls: NONE * ;* * ;* Modifies globals: hdrfile, msg_number * ;* * ;*********************************************************************** proc ChangeFlag intparm flagbyte long hdr_offset fopen 0 hdrfile WRITE ; open HOST.HDR as write only if not success ; error opening file return endif hdr_offset=((msg_number-1)*128)+8 fseek 0 hdr_offset 0 ; seek to flag byte of current message fputc 0 flagbyte ; write the passed parameter fclose 0 ; close HOST.HDR endproc ;*********************************************************************** ;* * ;* DELETEMSG * ;* * ;* This procedure marks a mial message for deletion. * ;* * ;* * ;* Calls: HOSTMSGBOX, HOSTPUTS, CHANGEFLAG * ;* * ;* Modifies globals: hdrfile, msg_number, _date, _time, name, * ;* access_level * ;* * ;*********************************************************************** proc DeleteMsg integer msg_num, msg_length, msg_flag, dummy long offset, hdr_offset string destination, from, subject isfile hdrfile if not success return endif fopen 0 hdrfile READ if not success HostMsgBox("Can't open HDRFILE - Proc DeleteMsg") return endif hdr_offset=(msg_number-1)*128 fseek 0 hdr_offset 0 fgeti 0 msg_num if FEOF 0 fclose 0 return endif fgetl 0 offset ; get message file offset fgeti 0 msg_length ; get length of message fgetc 0 msg_flag ; get message flag fread 0 destination 31 dummy ; get TO: fread 0 from 31 dummy ; get FROM: fread 0 subject 37 dummy ; get subject fread 0 _date 9 dummy ; get message date fread 0 _time 11 dummy ; get message time strcmp destination name ; compare message TO: and user name if not success strcmp from name ; compare message FROM: and user name if not success strcmp access_level "2" ; is this user a level 2 security if not success ; if not send message and return HostPutS("`r`nYou can't delete this message.`r`n") return endif endif endif fclose 0 ; close HOST.HDR msg_flag=msg_flag+4 ; add DELETED flag to the flag byte ChangeFlag(msg_flag) ; pass new message flag to ChangeFlag HostPutS("`r`nMessage has been marked for deletion.`r`n`r`n") endproc ;*********************************************************************** ;* * ;* TXWAIT * ;* * ;* This procedure waits for the TX buffer to empty before returning. * ;* * ;* * ;* Calls: NONE * ;* * ;* Modifies globals: none * ;* * ;*********************************************************************** proc txwait while $TXCOUNT>0 endwhile pause 3 endproc ;**** End of SUBS.WAS ****