;************************************************************************** ;* HOSTUTIL.ASP * ;* Copyright (C) 1992 DATASTORM TECHNOLOGIES, INC. * ;* All rights reserved. * ;************************************************************************** ;************************************************************************** ;* Structure of HOST.HDR for each message in the HOST.MSG file * ;* * ;* integer 2 bytes message number * ;* long 4 bytes offset * ;* integer 2 bytes message length * ;* char 1 bytes flag * ;* string 31 bytes destination (To:) * ;* string 31 bytes from * ;* string 37 bytes subject * ;* string 9 bytes date * ;* string 11 bytes time * ;* * ;* all strings include a NULL at the last position for a terminator * ;************************************************************************** ;************************************************************************** ;* Global Variables * ;************************************************************************** integer MSG_Number ; Number of Messages integer MSG_Num ; Number of Messages integer otermwidth integer msg_length, msg_flag, blocksize long chars_to_read string _DATE,_TIME string msg,destination,from,subject,line integer dummy string DDir ; Data Directory string Adir1,Adir2,Adir3,Adir4,Adir5 ; Alternate Directories string Anam1,Anam2,Anam3,Anam4,Anam5 ; Alternate Directories integer HTimeOut,WTimeOut ; Inactivity timers integer inverse,normal,high integer Log_It ; Activity log integer ANSI_ON ; use ansi sequences integer Pager ; Allow Host Paging integer expose ; show user password locally integer blanktimeout,blanker ; Screen Blanker Vars string searchstr STRING HOSTPARMFILE = "HOST.PRM" ; HOST PARAMETER FILE STRING MSGFILE = "HOST.MSG" ; MESSAGE FILE STRING HDRFILE = "HOST.HDR" ; HEADER FILE STRING TEMPFIL1 = "~HOST1.TMP" ; TEMP FILE ONE STRING TEMPFIL2 = "~HOST2.TMP" ; TEMP FILE TWO STRING HDRBAK = "HDR.OLD" ; BACKUP HEADER FILE STRING MSGBAK = "MSG.OLD" ; BACKUP MESSAGE FILE STRING TEMPFILE = "~HOST.TMP" ; TEMP FILE FOR MAIL PROCESSING STRING HOSTLOGFILE = "HOST.LOG" ; LOG FILE string VERSION = "1.70แ" ; script version DEFINE PUBLIC 0 ;* DEFINE PRIVATE 1 ;** MAIL DEFINE NEWMAIL 2 ;** FLAGS DEFINE DELETED 4 ;* ;************************************************************************** ;* Main Procedure of HostUtil.Asp * ;************************************************************************** include "include.asp" proc main integer pick = 0 ;* integer row=6 ,col= 32 ;** Definine Initial Values string temp = "READ/LEAVE MAIL" ;* set aspdebug on fetch termwidth otermwidth ; Get original termwidth & save set termwidth 80 ; Force 80 column termwidth getenv "PCPLUS" ddir ;Get DOS var PCPLUS,save in ddir strcmp ddir "" ; Compare to null if success ; success, variable not set ddir = "." ; set to current directory endif call BuildDFile with &HostParmFile ; Add path to hostparmfile call gethostparms ; Read Initial Parms call BuildDFile with &MsgFile ; * call BuildDFile with &HdrFile ; ** Add path to data files call BuildDFile with &TempFile ; * call BuildDFile with &HostLogFile ; * call BuildDFile with &MsgBak ; * call BuildDFile with &HdrBak ; * ; setvattr &inverse black ltgrey noblink ;* ; setvattr &normal ltgrey black noblink ;** Set Default Colors ; setvattr &high white black noblink ;* setvattr &normal ltmagenta black noblink ;* setvattr &inverse black ltgrey noblink ;** Define colors setvattr &high white black noblink ;* set msg_crlf off ; Set Message LineFeed Off set keys on ; Set Keys Off curoff ; Don't display cursor clear ; Clear Screen box 1 20 15 60 normal ; Draw Box atsay 3 22 normal $date ; fatsay 1 31 high "] HOST UTILITY %s [" version ; Information atsay 15 32 high "] Use Arrow Keys [" ; bars atsay 6 32 normal "READ/LEAVE MAIL" atsay 7 35 normal "PACK MAIL" atsay 8 27 normal "ALTERNATE DIRECTORIES/NAMES" atsay 9 33 normal "GENERAL OPTIONS" atsay 10 32 normal "FILE MAINTENANCE" atsay 12 38 normal "EXIT" while forever ; Loop Continuously atsay row col inverse temp while ! hitkey ; Loop Until Key is Hit atsay 3 49 normal $time0 ; Display Time endwhile keyget pick ; Get Key atsay row col normal temp switch pick ; Switch on Pick case 0x48E0 ; Gray Up Arrow ; Does Pick = Up arrow case 0x4800 ; Regular Up Arrow ; dec row ; if row == 11 row = 10 endif endcase case 0x50E0 ; Gray Down Arrow ; Does Pick = Down Arrow? case 0x5000 ; Regular Down Arrow ; inc row if row == 11 row = 12 endif endcase case 0x1B ; Does Pick = ESC row = 20 ; Set Row to 18 col = 38 ; Set Col to 38 temp = "EXIT" ; Set Temp to Exit atsay row col inverse temp ; Display clear ; Clear Screen curon ; Exit set termwidth otermwidth ; Restore TermWidth exit ; endcase case 0x000D ; Enter ; Does pick = Enter case 0xE00D ; Grey Enter ; switch row ; Switch on Row case 6 ; Does Row = 8 - Read Mail vidsave 0 ; Save Screen in Index 0 clear ; Clear curon ; Set Cursor On call readmail ; Call ReadMail curoff ; Set Cursor Off vidrest 0 ; Restore Screen Index 0 endcase case 7 ; Does Row = 9 - Pack Mail vidsave 0 ; Save Video, Index 0 clear ; Clear Screen call pack ; Call Pack message "`r`n`nHit any key..." keyget n0 vidrest 0 ; Restore Video Index 0 endcase case 8 ; Does Row = 12 - Modify Dir/Nam vidsave 0 ; Save Video Index 0 clear ; Clear call modifydirs ; Call ModifyDirs vidrest 0 ; Restore Video Index 0 endcase case 9 ; Does Row = 13 - Modify Misc vidsave 0 ; Save Video Index 0 clear ; Clear Screen call modifymisc ; Call ModifyMisc vidrest 0 ; Restore Vidoe Index 0 endcase case 10 ; Does Row = 10 - Maintenance vidsave 0 ; Save Video Index 0 clear ; Clear Screen call maintenance ; Call Maintenace vidrest 0 ; Restore Vidoe Index 0 endcase case 12 ; Does Row = 18 - Exit Option clear ; Clear curon ; Set Cursor On set termwidth otermwidth ; Restore TermWidth exit ; Exit endcase endswitch endcase endswitch if row < 6 ;* row = 12 ;** Allow for space between endif ;*** Exit & last option if row > 12 ;** row = 6 ;* endif SWITCH ROW ;* CASE 6 ;** TEMP = "READ/LEAVE MAIL" ;*** COL = 32 ;**** ENDCASE ;***** CASE 7 ;****** TEMP = "PACK MAIL" ;******* COL = 35 ;******** ENDCASE ;********* CASE 8 ;********** Switch on Row TEMP = "ALTERNATE DIRECTORIES/NAMES" ;*********** & Set Column COL = 27 ;*********** & Temp ENDCASE ;*********** Accordingly CASE 9 ;************ TEMP = "GENERAL OPTIONS" ;************ COL = 33 ;************ ENDCASE ;*********** CASE 10 ;********** TEMP = "FILE MAINTENANCE" ;********* COL = 32 ;******** ENDCASE ;******* CASE 12 ;****** TEMP = "EXIT" ;***** COL = 38 ;**** ENDCASE ;*** ENDSWITCH ;** ENDWHILE ;* endproc ;************************************************************************** ;* * ;* Function: SetFailure * ;* Purpose: set FAILURE to TRUE (same as success not TRUE) * ;* Input: None * ;* return: None * ;* * ;************************************************************************** proc SetFailure strcmp "X" "" ; Sets Failure flag to true endproc ;************************************************************************** ;* * ;* Function: SetSuccess * ;* Purpose: set success to TRUE (same as FAILURE not TRUE) * ;* Input: None * ;* return: None * ;* * ;************************************************************************** proc SetSuccess strcmp "" "" ; Sets Success flag to true endproc ;************************************************************************** ;* * ;* Function: FPUTI * ;* Purpose: Write Integer to file * ;* Input: File Index By Value, Integer Value By Referece * ;* return: * ;* Notes: * ;* * ;************************************************************************** proc FPutI intparm f_index,number integer lobyte,hibyte long fptr ftell f_index fptr ; Get Current Position hibyte = number & 0xFF00 ; Get High Byte (Strip Low Byte) hibyte = hibyte >> 8 ; Shift Right 8 Bits hibyte = hibyte & 0x00FF ; Strip High Byte lobyte = number & 0x00FF ; Get Low Byte fputc f_index hibyte ; Write High Byte to File fptr++ ; Inc FilePointer fseek f_index fptr 0 ; Seek Next Position fputc f_index lobyte ; Write Low Byte endproc ;************************************************************************** ;* * ;* Function: FGETI * ;* Purpose: Read Integer from file * ;* Input: File Index By Value, Integer Value By Referece * ;* return: * ;* Notes: * ;* * ;************************************************************************** proc fgeti intparm f_index,number integer temp long fptr ftell f_index fptr ; Get Current Position fgetc f_index temp ; Read Byte number = temp << 8 ; Shift Left 8 Bits ; to Convert to High Byte ; Store In Number fptr++ ; Inc FilePointer fseek f_index fptr 0 ; Seek FilePointer Position fgetc f_index temp ; Read Byte number = number + temp ; Add to High Byte endproc ;************************************************************************** ;* * ;* Function: FPUTL * ;* Purpose: Write Long Value To File * ;* Input: File Index by value, Long Value by reference * ;* return: * ;* Notes: * ;* * ;************************************************************************** proc fputl intparm f_index longparm number long hibyte,mid1byte integer mid2byte,lobyte,temp long fptr ftell f_index fptr ; Get Current Position hibyte = number & 0xFF000000 ; Strip All But High Byte hibyte = hibyte >> 24 ; Shift Right 24 Bits hibyte = hibyte & 0xFF ; Strip All But Low Byte temp = hibyte ; Store in Temp fputc f_index temp ; Write High Byte fptr++ ; Update FilePointer mid1byte = number & 0x00FF0000 ; Strip All But 3rd Byte mid1byte = mid1byte >> 16 ; Shift Right 16 Bits mid1byte = mid1byte & 0xFF ; Strip All But Low Byte temp = mid1byte ; Store in Temp fputc f_index temp ; Write 3rd Byte fptr++ ; Update FilePointer mid2byte = number & 0x0000FF00 ; Strip All But 2nd Byte mid2byte = mid2byte >> 8 ; Shift Right 8 Bits mid2byte = mid2byte & 0xFF ; Strip All But Low Byte fputc f_index mid2byte ; Write 2nd Byte fptr++ ; Update FilePointer lobyte = number & 0xFF ; Strip All But Low Byte fseek f_index fptr 0 ; Seek FilePointer Pos fputc f_index lobyte ; Write Low Byte endproc ;************************************************************************** ;* * ;* Function: FGETL * ;* Purpose: Read Long Value From File * ;* Input: File Index by value, Long Value by reference * ;* return: * ;* Notes: * ;* * ;************************************************************************** proc fgetl intparm f_index longparm number long hibyte,mid1byte,mid2byte integer lobyte,temp long fptr ftell f_index fptr ; Get Current Position fgetc f_index temp ; Read Byte hibyte = temp ; Store in Hybyte hibyte = hibyte << 24 ; Shift Left 24 Bits number = hibyte ; Store in Number fptr++ ; Update File Pointer fgetc f_index temp ; Read Byte into Temp mid1byte = temp ; Store in Mid1Byte mid1byte = mid1byte << 16 ; Shift Left 16 Bits number = number + mid1byte ; Add to Number fptr++ ; Update File Pointer fgetc f_index temp ; Read Byte into Number mid2byte = temp ; Store in Mid2Byte mid2byte = mid2byte << 8 ; Shift Left 8 number = number + mid2byte ; Add to Number fptr++ ; Update File Pointer fseek f_index fptr 0 ; Seek FilePointer fgetc f_index lobyte ; Read Byte into LoByte number = number + lobyte ; Add to Number endproc ;************************************************************************** ;* * ;* Function: DisplayFile * ;* Purpose: Sends an acsii file to remote user and pauses every * ;* 23 lines and displays a -MORE- prompt. * ;* Input: Filename to send * ;* Page length * ;* Return: Nothing * ;* Notes: Failure if doesn't exist. * ;* Success if file exist and is displayed * ;* * ;************************************************************************** proc DisplayFile strparm _file intparm page_length string response integer count=0 isfile _file ; Does File Exist? if failure ; No? set termwidth otermwidth ; Restore TermWidth exit ; Exit endif fopen 5 _file "R" ; Open File for Read while 1 ; Loop Continuously fgets 5 line ; Read Line if EOF 5 ; End_Of_File? exitwhile ; Exit While Loop endif message line ; Display Line message "`r" ; Carriage Return inc count ; Inc Count if count==page_length ; Count = Page_Length ? message "-MORE? (Y/n)-" ; Display More Message keyget n0 ; Get Key key2ascii n0 response ; Convert to Ascii message "`r `r" ; Do Cr, then space over ; message, do another CR strupr response ; Convert response to Uppercase strcmp response "N" if success ; Response = "N" ? exitwhile ; Exit Loop endif count=1 ; Reset Count endif endwhile fclose 5 ; Close File endproc ;*********************************************************************** ;* * ;* READMAIL * ;* * ;* This procedure reads and displays mail messages * ;* Modifies globals: msg, msg_number * ;* Labels : LOOP2 * ;* * ;*********************************************************************** proc ReadMail string choice integer msg_total, searchflag LOOP2: call CountMsg with &msg_total strfmt msg "`r`n`r`nTotal messages: %d`r`n`r`n" msg_total message msg message "L)eave mail`r`n" message "F)orward read`r`n" message "N)ew mail`r`n" message "S)earch mail`r`n" message "Q)uit`r`n`r`n? " keyget n0 ; Get keystroke if n0 == 0xE00D ; If Grey Enter key n0 = 0xD ; convert to normal Enter endif key2ascii n0 choice ; Convert scancode to ascii message choice message "`r`n" strupr choice switch choice case "L" call leavemail with "" "SYSOP" "" goto LOOP2 endcase case "F" message "`r`nStarting message number ( for first): " Get choice 5 message "`r`n" strcmp choice "" if success message "`n" msg_number=1 else atoi choice msg_number if msg_number>msg_total message "`r`nInvalid msg number!`r`n" goto LOOP2 endif endif while msg_number<=msg_total call ReadMsg with 0 if not success exitwhile endif endwhile message "`r`nEnd of messages.`r`n" goto LOOP2 endcase case "N" msg_number=1 while msg_number<=msg_total call ReadMsg with 1 if not success exitwhile endif endwhile message "`r`nEnd of messages.`r`n" goto LOOP2 endcase case "S" message "`r`n`r`nWhich field: T)o F)rom or S)ubject ? " Get choice 1 message "`r`n" strupr choice switch choice case "T" searchflag=2 endcase case "F" searchflag=3 endcase case "S" searchflag=4 endcase default return endcase endswitch message "Search string: " Get searchstr 30 message "`r`n" msg_number=1 while msg_number<=msg_total call ReadMsg with searchflag if not success exitwhile endif endwhile message "`r`nEnd of messages.`r`n" goto LOOP2 endcase case "Q" return endcase default goto LOOP2 endcase endswitch endproc ;************************************************************************** ;* * ;* Function: ReadMsg * ;* Purpose: Open and display a mail message * ;* Input: Nothing * ;* return: Nothing * ;* Notes: * ;* * ;************************************************************************** proc ReadMsg intparm readflag long offset, hdr_offset string flag,choice, reply="REPLY - " isfile hdrfile if failure message "`r`nNo mail file found!`r`n" return endif fopen 0 hdrfile "R+" if failure strfmt s0 "FATAL ERROR - Can't open %s file!" hdrfile message s0 Exit endif hdr_offset=(msg_number-1)*128 ; goto a specific record in ; in .HDR file fseek 0 hdr_offset 0 LOOP3: call fgeti with 0 &msg_num if EOF 0 inc msg_number return endif call fgetl with 0 &offset call fgeti with 0 &msg_length fgetc 0 msg_flag call interflag with &flag msg_flag fread 0 destination 31 dummy fread 0 from 31 dummy fread 0 subject 37 dummy fread 0 _date 9 dummy fread 0 _time 11 dummy switch readflag case 1 ; read new mail only if (msg_flag & 2) != NEWMAIL inc msg_number goto LOOP3 endif endcase case 2 ; search for TO: find destination searchstr if !found inc msg_number goto LOOP3 endif endcase case 3 ; search for FROM: find from searchstr if !found inc msg_number goto LOOP3 endif endcase case 4 ; search for SUBJECT find subject searchstr if !found inc msg_number goto LOOP3 endif endcase endswitch fclose 0 strfmt msg "`r`n Msg: %d (%s, sent %s at %s)`r`n" msg_num flag _date _time message msg strfmt msg "From: %s`r`n" from message msg strfmt msg " To: %s`r`n" destination message msg strfmt msg "Subj: %s`r`n`r`n" subject message msg isfile msgfile if failure message "No message file!" return else fopen 1 msgfile "R" if failure message "Can't open message file!" return endif fopen 2 tempfile "W" if failure message "Can't open temp file!" return endif fseek 1 offset 1 chars_to_read = msg_length while chars_to_read > 0 if chars_to_read > 79 blocksize = 79 else blockSize = chars_to_read endif fread 1 line blocksize dummy fwrite 2 line blocksize if failure message "Can't write to temp file!" return endif chars_to_read = chars_to_read - blocksize endwhile fclose 1 fclose 2 call DisplayFile with tempfile 17 delete tempfile message "`r`nR)eply D)elete Q)uit ( for another): " Get choice strcmp choice "" if success strpoke choice 0 13 endif strupr choice message "`r`n" switch choice case "R" substr msg subject 0 21 strcat reply msg call LeaveMail with subject reply from inc msg_number return endcase case "D" call DeleteMsg inc msg_number endcase case "Q" msg_number = 9999 return endcase case "`r" inc msg_number return endcase default choice="" endcase endswitch endif endproc ;************************************************************************** ;* * ;* Function: CountMsg * ;* Purpose: Count the number of messages * ;* Input: integer to be used for return value * ;* Return: number of messages * ;* Notes: * ;* * ;************************************************************************** proc CountMsg intparm num num=0 ; Set Num to 0 isfile hdrfile ; File Exist? if failure ; No? return ; Return (Number of Messages = 0) endif findfirst hdrfile ; FindFirst on HeaderFile div $fsize 128 num ; num = $fsize / 128 (remainder purged) endproc ;************************************************************************ ;* * ;* Function: ChangeFlag * ;* Purpose: modifies the flag byte for a message * ;* Input: * ;* return: * ;* Notes: * ;* * ;************************************************************************** proc ChangeFlag intparm flagbyte long hdr_offset fopen 0 hdrfile "R+" hdr_offset=((msg_number-1)*128)+8 fseek 0 hdr_offset 0 fputc 0 flagbyte fclose 0 endproc ;************************************************************************** ;* * ;* Function: DeleteMsg * ;* Purpose: mark a mail message for deletion * ;* Input: nothing * ;* return: nothing * ;* Notes: * ;* * ;************************************************************************** proc DeleteMsg long hdr_offset isfile hdrfile if failure return endif fopen 0 hdrfile "R" if failure errormsg "FATAL ERROR - Can't open HOST.HDR" set termwidth otermwidth ; Restore TermWidth exit endif hdr_offset=(msg_number-1)*128 fseek 0 hdr_offset 0 call fgeti with 0 &msg_num if EOF 0 fclose 0 return endif call fgetl with 0 &hdr_offset call fgeti with 0 &msg_length fgetc 0 msg_flag fread 0 destination 31 dummy fread 0 from 31 dummy fread 0 subject 37 dummy fread 0 _date 9 dummy fread 0 _time 11 dummy fclose 0 msg_flag=msg_flag+4 call ChangeFlag with msg_flag endproc ;************************************************************************** ;* * ;* Function: Pack * ;* Purpose: Compress the message base by removing messages that * ;* are marked for deletion * ;* Input: * ;* return: * ;* Notes: * ;* * ;************************************************************************** proc Pack long newoffset,offset integer number=1 integer chars, counter=0 isfile hdrfile if failure message "No mail messages!" return else message "Packing Mail..." fopen 0 hdrfile "R+" fopen 1 tempfil2 "W" endif while 1 call fgeti with 0 msg_num if EOF 0 fclose 0 fclose 1 delete hdrbak rename hdrfile hdrbak rename tempfil2 hdrfile delete msgbak rename msgfile msgbak rename tempfil1 msgfile msg_number=1 strfmt s0 "%d message(s) deleted!" counter message s0 return endif call fgetl with 0 offset call fgeti with 0 msg_length fgetc 0 msg_flag fread 0 destination 31 dummy fread 0 from 31 dummy fread 0 subject 37 dummy fread 0 _date 9 dummy fread 0 _time 11 dummy if (msg_flag & 4) == 4 counter++ loopwhile endif isfile msgfile if failure message "No message file!" set termwidth otermwidth ; Restore TermWidth exit endif fopen 2 msgfile "R+" if failure message "Can't open message file!" set termwidth otermwidth ; Restore TermWidth exit endif isfile tempfil1 if success fopen 3 tempfil1 "R+" fseek 3 0 2 ftell 3 newoffset else fopen 3 tempfil1 "W" newoffset=0 endif if failure message "Can't open temp file!" set termwidth otermwidth ; Restore TermWidth exit endif fseek 2 offset 1 chars = msg_length while chars != 0 if chars > 79 blocksize = 79 else blockSize = chars endif fread 2 line blocksize dummy fwrite 3 line blocksize if failure message "can't write to temp file!" set termwidth otermwidth ; Restore TermWidth exit endif chars -= blocksize endwhile fclose 2 fclose 3 call fputi with 1 number call fputl with 1 newoffset call fputi with 1 msg_length fputc 1 msg_flag fwrite 1 destination 31 fwrite 1 from 31 fwrite 1 subject 37 fwrite 1 _date 9 fwrite 1 _time 11 number++ endwhile endproc ;************************************************************************** ;* * ;* Function: LeaveMail * ;* Purpose: Leave a mail message to another user * ;* Input: topic and receiver in case this is a REPLY * ;* from READMAIL * ;* Return: Nothing * ;* Notes: * ;* * ;************************************************************************** proc LeaveMail strparm topic strparm sender strparm receiver string line_num, choice integer mailflag, line_count integer count,length long msgfile_offset isfile tempfile if success delete tempfile endif set msg_crlf off while 1 line_count=1 strcmp receiver "" if success message "`r`n`r`n To: " Get receiver 30 strupr receiver endif strcmp sender "" if success message "`r`nFrom: " Get Sender 30 strupr sender endif strcmp topic "" if success message "`r`nSubj: " Get topic 40 endif message "`r`n`r`n" message "Private Mail (Y/n)? " call GetYN if success mailflag=PRIVATE+NEWMAIL else mailflag=PUBLIC+NEWMAIL endif message "`r`n`r`n To: " message receiver message "`r`nFrom: " message sender message "`r`nSubj: " message topic message "`r`n`r`nIs this correct (Y/n/q)? " KeyGet N9 if (N9==0xE00D) || (N9==0xD) choice="Y" else key2ascii N9 choice endif message choice message "`r`n" strupr choice switch choice case "Y" endcase case "N" receiver = "" topic = "" loopwhile endcase case "Q" return endcase endswitch fopen 1 tempfile "W+" if failure message "FATAL ERROR - Can't open TEMP file!" set termwidth otermwidth ; Restore TermWidth Exit endif GETMESSAGE: fseek 1 0 2 while 1 strfmt line_num "%5d: " line_count message "`r`n" message line_num call MailGetLine with &line strcmp line "" if success exitwhile endif fputs 1 line ; write line to tempfile fputc 1 0x0A ; append LF to line line_count++ endwhile LOOP: message "`r`n`r`nS)ave A)bort D)isplay C)ontinue ? " while 1 keyget n0 if n0 > 96 ;* n0 = n0 - 32 ;** Convert to upper if needed endif ;* if (n0==83) || (n0==65) || (n0==68) || (n0==67) ;Is it (S,A,D,or C)? exitwhile endif endwhile key2ascii n0 choice strupr choice message choice if success message "`r`n" strupr choice switch choice case "S" message "`r`nSaving message ...`r`n" isfile msgfile if success fopen 0 msgfile "R+" if failure strfmt s0 "FATAL ERROR - Can't open %s file!" msgfile message s0 return endif else fopen 0 msgfile "W" endif fseek 0 0 2 ftell 0 msgfile_offset fclose 1 findfirst tempfile msg_length=$FSIZE fopen 1 tempfile "R+" length=msg_length chars_to_read = msg_length fseek 0 0 2 while chars_to_read > 0 if chars_to_read > 79 blocksize = 79 else blocksize = chars_to_read endif fread 1 line blocksize dummy fwrite 0 line blocksize if failure strfmt s0 "FATAL ERROR - Can't open %s file!" msgfile message s0 return endif chars_to_read = chars_to_read - blocksize endwhile fclose 0 fclose 1 delete tempfile ; count messages to get this message number call CountMsg with &msg_num ; write header info isfile hdrfile if success fopen 2 hdrfile "R+" if failure strfmt s0 "FATAL ERROR - Can't open %s file!" hdrfile message s0 return endif else fopen 2 hdrfile "W" endif fseek 2 0 2 inc msg_num call fputi with 2 msg_num call fputl with 2 msgfile_offset call fputi with 2 length fputc 2 mailflag fwrite 2 receiver 31 fwrite 2 sender 31 fwrite 2 topic 37 fwrite 2 $DATE 9 fwrite 2 $TIME0 11 fclose 2 endcase case "A" message "`r`nAbort message (Y/n)? " call GetYN if success fclose 1 delete tempfile return endif call setsuccess message "`r`n" goto LOOP endcase case "D" message "`r`n" count=1 rewind 1 fseek 1 0 0 while 1 fgets 1 line if EOF 1 exitwhile endif message line message "`r" inc count if count==23 count=1 message "-MORE? (Y/n)-" ; display prompt call GetYN message "`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b" if failure exitwhile endif endif endwhile goto LOOP endcase case "C" goto GETMESSAGE endcase default goto LOOP endcase endswitch endif call SetFailure return endwhile endproc ;************************************************************************** ;* Function: MailGetLine * ;* Purpose: Input a character string from the port or local keyboard * ;* Input: string parameter for return value * ;* Return: If success, string variable contains the string * ;* FAILURE if connection lost * ;* Notes: * ;************************************************************************** proc MailGetLine strparm s integer max=69 integer row,col,vid GetCur Row Col GetVAttr Row Col Vid AtGet Row Col Vid Max S endproc ;************************************************************************** ;* * ;* Function: GetParms * ;* Purpose: Open & read host parameter file or build with default * ;* parameters if one doesn't exist. * ;* Input: None * ;* Return: Parmeters, globally sets variables defined in host.asp * ;* Notes: Failure if can not create/read parm file * ;* * ;************************************************************************** proc GetHostParms string parmrec,temp integer stlen,prmlen Log_It = 1 ansi_on = 1 ;* blanktimeout = 300 ;** blanker = 1 ;*** expose = 0 ;**** pager = 1 ;***** wtimeout = 180 ;****** htimeout = 300 ;******* adir1=$null ;******** adir2=$null ;********* Define Default Parameters adir3=$null ;******** adir4=$null ;******* adir5=$null ;****** anam1="N/A" ;***** anam2="N/A" ;**** anam3="N/A" ;*** anam4="N/A" ;** anam5="N/A" ;* isfile hostparmfile ; Check if parm file exists if failure ; Nope fopen 0 hostparmfile "W" ; Create if failure ; Can't create strfmt s0 "`a`aUnable to create (%s) - No Host Parameter File Available" message s0 set termwidth otermwidth ; Restore TermWidth exit endif fputs 0 "DIR1=`n" ;* fputs 0 "DIR2=`n" ;** fputs 0 "DIR3=`n" ;*** fputs 0 "DIR4=`n" ;**** fputs 0 "DIR5=`n" ;***** fputs 0 "NAM1=N/A`n" ;****** fputs 0 "NAM2=N/A`n" ;******* fputs 0 "NAM3=N/A`n" ;******** fputs 0 "NAM4=N/A`n" ;********* Write Defaults to File fputs 0 "NAM5=N/A`n" ;******** Include Line Feed (`n) fputs 0 "ANSI=ON`n" ;******* fputs 0 "BLANKTIMEOUT=300`n" ;****** fputs 0 "BLANKER=ON`n" ;***** fputs 0 "EXPOSE=OFF`n" ;**** fputs 0 "PAGER=ON`n" ;*** fputs 0 "LOG_IT=ON`n" ;*** fputs 0 "WTIMEOUT=180`n" ;** fputs 0 "HTIMEOUT=300`n" ;* fclose 0 return endif fopen 0 hostparmfile "R" while 1 if eof 0 fclose 0 exitwhile endif fgets 0 parmrec strlen parmrec stlen strupr parmrec strcmp parmrec "DIR1=" 5 if success prmlen = stlen - 6 substr adir1 parmrec 5 prmlen endif strcmp parmrec "DIR2=" 5 if success prmlen = stlen - 6 substr adir2 parmrec 5 prmlen endif strcmp parmrec "DIR3=" 5 if success prmlen = stlen - 6 substr adir3 parmrec 5 prmlen endif strcmp parmrec "DIR4=" 5 if success prmlen = stlen - 6 substr adir4 parmrec 5 prmlen endif strcmp parmrec "DIR5=" 5 if success prmlen = stlen - 6 substr adir5 parmrec 5 prmlen endif strcmp parmrec "NAM1=" 5 if success prmlen = stlen - 6 substr anam1 parmrec 5 prmlen endif strcmp parmrec "NAM2=" 5 if success prmlen = stlen - 6 substr anam2 parmrec 5 prmlen endif strcmp parmrec "NAM3=" 5 if success prmlen = stlen - 6 substr anam3 parmrec 5 prmlen endif strcmp parmrec "NAM4=" 5 if success prmlen = stlen - 6 substr anam4 parmrec 5 prmlen endif strcmp parmrec "NAM5=" 5 if success prmlen = stlen - 6 substr anam5 parmrec 5 prmlen endif strcmp parmrec "ANSI=" 5 if success prmlen = stlen - 6 substr temp parmrec 5 prmlen strcmp temp "ON" 2 if success ansi_on = 1 else ansi_on = 0 endif endif strcmp parmrec "PAGER=" 6 if success prmlen = stlen - 7 substr temp parmrec 6 prmlen strcmp temp "ON" 2 if success PAGER = 1 else PAGER = 0 endif endif strcmp parmrec "EXPOSE=" 7 if success prmlen = stlen - 8 substr temp parmrec 7 prmlen strcmp temp "ON" 2 if success expose = 1 else expose = 0 endif endif strcmp parmrec "LOG_IT=" 7 if success prmlen = stlen - 8 substr temp parmrec 7 prmlen strcmp temp "ON" 2 if success log_it = 1 else log_it = 0 endif endif strcmp parmrec "BLANKER=" 8 if success prmlen = stlen - 9 substr temp parmrec 8 prmlen strcmp temp "ON" 2 if success BLANKER = 1 else BLANKER = 0 endif endif strcmp parmrec "BLANKTIMEOUT=" 13 if success prmlen = stlen - 14 substr temp parmrec 13 prmlen atoi temp blanktimeout if (blanktimeout < 1) || (blanktimeout > 30000) blanktimeout = 300 endif endif strcmp parmrec "WTIMEOUT=" 9 if success prmlen = stlen - 10 substr temp parmrec 9 prmlen atoi temp Wtimeout if (Wtimeout < 10) || (Wtimeout > 30000) Wtimeout = 180 endif endif strcmp parmrec "HTIMEOUT=" 9 if success prmlen = stlen - 10 substr temp parmrec 9 prmlen atoi temp HTimeout if (Htimeout < 10) || (Htimeout > 30000) Htimeout = 300 endif endif endwhile endproc ;************************************************************************** ;* * ;* Function: Dexist * ;* Purpose: Directory Exist Check * ;* return: Directory (Resets if invalid) * ;* Notes: * ;* * ;************************************************************************** PROC DEXIST ; Check for directory existence STRPARM NEWDIR ; Dir to check STRING ORIDIR,CURDIR ; Temp Strings strlen newdir n0 ; Check length if n0 < 2 ; Allow for root (\) call setsuccess return endif call strip_space with &newdir strupr newdir ; Convert to uppercase STRLEN NEWDIR N0 ; Get Length of newdir Dec N0 ; Dec by 1 (String Index Starts w/ 0) STRPEEK NEWDIR N0 N1 ; Check Last Character IF (N1 == 92) ; If `\` substr newdir newdir 0 n0 ; Strip backslash dec n0 ; Reset Length ENDIF GetDir 0 OriDir ; Get Original Directory strpeek newdir 1 n1 ; Look at second char in newdir if !(n1==58) ; If it's not a colon substr curdir oridir 0 2 ; Get current drive & put in curdir strcat curdir newdir ; Append newdir to curdir newdir = curdir ; newdir = curdir endif strpeek newdir 2 n1 ; Look at third char in newdir if !(n1==92) ; If it's not a backslash substr curdir newdir 0 2 ; Get drive & put in curdir substr newdir newdir 2 79 ; Store remainder back in newdir strcat curdir "\" ; Add backslash strcat curdir newdir ; Append newdir to curdir newdir = curdir ; newdir = curdir endif strcmp newdir oridir ; Is test dir same as current if success ; call setsuccess ; then it's ok return ; return endif ChDir NewDir ; Change to new directory GetDir 0 CurDir ; Get Current directory Strcmp Oridir Curdir ; is current different then original if success ; They're the same call setfailure ; Set Failure else call setsuccess ; Set Success endif ChDir OriDir ; Go back to original directory ENDPROC ;************************************************************************** ;* Function: Strip_Space * ;************************************************************************** proc strip_space strparm inline string char integer len strlen inline len ; Get Length if len < 2 return endif dec len ; Dec x 1, String Index Starts At 0 substr char inline len 1 ; Get Last Char strcmp char " " ; Space? while success ; Space dec len ; Dec length substr char inline len 1 ; Get Last Char strcmp char " " ; Space? if len < 1 call setfailure endif endwhile ; inc len ; Inc Length, Regain Last Char substr inline inline 0 len ; Get New Line endproc ;************************************************************************** ;* Function: Pad * ;************************************************************************** PROC pad strparm inline intparm tlen integer len STRLEN inline len ; Get Length WHILE len < tlen ; If Length < Desired Length STRCAT inline " " ; Add Space inc len ; Inc Length ENDWHILE ; ENDPROC ;************************************************************************** ;* * ;* Function: Toggle * ;* Purpose: Allow User To Toggle Value With Space Bar * ;* Input: Row,Column,Integer Value * ;* Return: Modified Value * ;* * ;************************************************************************** proc toggle intparm row,col,inval integer keyin string temp if inval temp = "ON " else temp = "OFF" endif atsay 7 23 high "Space Bar to Toggle, Enter to Accept" while 1 atsay row col inverse temp ; Display Current in Inverse keyget keyin ; Get Key switch keyin case 0x000D ; Enter case 0xE00D ; Gray Enter atsay 7 23 normal " " atsay row col normal temp return endcase case 0x0020 ; Space Bar if inval inval=0 ;* temp="OFF" ;** else ;*** Toggle Current Value inval=1 ;** temp="ON " ;* endif endcase endswitch endwhile endproc ;************************************************************************** ;* Function: ModifyDirs * ;************************************************************************** proc ModifyDirs integer ok,bad,choice string Odir1,Odir2,Odir3,Odir4,Odir5 ; Alternate Directories string Onam1,Onam2,Onam3,Onam4,Onam5 ; Alternate Directories clear box 0 1 11 78 normal atsay 0 24 normal "] SCRIPTED HOST MODE PARAMETERS [" setvattr &ok black red noblink setvattr &bad white red blink odir1=adir1 ;* odir2=adir2 ;** odir3=adir3 ;*** odir4=adir4 ;**** odir5=adir5 ;***** Set Original Values onam1=anam1 ;***** Used for Aborts onam2=anam2 ;**** onam3=anam3 ;*** onam4=anam4 ;** onam5=anam5 ;* again: atsay 10 26 ok "Verifying Alternate Directories..." call dexist with &adir1 ;* if failure ;** atsay 2 4 bad "BAD" ;*** else ;**** atsay 2 4 ok " OK" ;***** endif ;****** ;******* call dexist with &adir2 ;******** if failure ;********* atsay 3 4 bad "BAD" ;********** else ;*********** atsay 3 4 ok " OK" ;************ endif ;************* ;************** call dexist with &adir3 ;*************** if failure ;**************** See if atsay 4 4 bad "BAD" ;**************** Directory else ;**************** Exists, If Not atsay 4 4 ok " OK" ;**************** Display "Bad" endif ;*************** ;************** call dexist with &adir4 ;************* if failure ;************ atsay 5 4 bad "BAD" ;*********** else ;********** atsay 5 4 ok " OK" ;********* endif ;******** ;******* call dexist with &adir5 ;****** if failure ;***** atsay 6 4 bad "BAD" ;**** else ;*** atsay 6 4 ok " OK" ;** endif ;* fatsay 2 8 normal "DIR1 = %s" ADIR1 fatsay 3 8 normal "DIR2 = %s" ADIR2 fatsay 4 8 normal "DIR3 = %s" ADIR3 fatsay 5 8 normal "DIR4 = %s" ADIR4 fatsay 6 8 normal "DIR5 = %s" ADIR5 fatsay 2 46 normal "<--> NAM1 = %s" ANAM1 fatsay 3 46 normal "<--> NAM2 = %s" ANAM2 fatsay 4 46 normal "<--> NAM3 = %s" ANAM3 fatsay 5 46 normal "<--> NAM4 = %s" ANAM4 fatsay 6 46 normal "<--> NAM5 = %s" ANAM5 fatsay 8 4 normal "`"PCPLUS`" DOS Variable = %s" DDIR while 1 atsay 10 26 high "E)dit, A)bort, S)ave & exit " keyget choice switch choice case 0x65 ; e case 0x45 ; E atsay 10 25 high " " atsay 11 26 normal "] `"Enter`" Accept Current [" for n9 = 2 upto 7 ;* atsay n9 4 normal " " ;** Clear Bad/OK markers endfor ;* atget 2 15 inverse 30 ADIR1 default strupr adir1 call pad with &adir1 30 fatsay 2 15 normal "%s" ADIR1 atget 3 15 inverse 30 ADIR2 default strupr adir2 call pad with &adir2 30 fatsay 3 15 normal "%s" ADIR2 atget 4 15 inverse 30 ADIR3 default strupr adir3 call pad with &adir3 30 fatsay 4 15 normal "%s" ADIR3 atget 5 15 inverse 30 ADIR4 default call pad with &adir4 30 strupr adir4 fatsay 5 15 normal "%s" ADIR4 atget 6 15 inverse 30 ADIR5 default call pad with &adir5 30 strupr adir5 fatsay 6 15 normal "%s" ADIR5 atget 2 58 inverse 19 ANAM1 default call pad with &anam1 19 strupr anam1 fatsay 2 58 normal "%s" ANAM1 atget 3 58 inverse 19 ANAM2 default call pad with &anam2 19 strupr anam2 fatsay 3 58 normal "%s" ANAM2 atget 4 58 inverse 19 ANAM3 default call pad with &anam3 19 strupr anam3 fatsay 4 58 normal "%s" ANAM3 atget 5 58 inverse 19 ANAM4 default call pad with &anam4 19 strupr anam4 fatsay 5 58 normal "%s" ANAM4 atget 6 58 inverse 19 ANAM5 default call pad with &anam5 19 strupr anam5 fatsay 6 58 normal "%s" ANAM5 atsay 11 26 normal "ออออออออออออออออออออออออออ" call strip_space with &adir1 call strip_space with &adir2 call strip_space with &adir3 call strip_space with &adir4 call strip_space with &adir5 call strip_space with &anam1 call strip_space with &anam2 call strip_space with &anam3 call strip_space with &anam4 call strip_space with &anam5 goto again endcase case 0x61 ; a case 0x41 ; A adir1=odir1 ;* adir2=odir2 ;** adir3=odir3 ;*** adir4=odir4 ;**** adir5=odir5 ;***** anam1=onam1 ;****** Restore Original Values & Return anam2=onam2 ;***** anam3=onam3 ;**** anam4=onam4 ;*** anam5=onam5 ;** return ;* endcase case 0x73 ; s case 0x53 ; S atsay 10 26 high "Writing Parm File... " call writeparms atsay 10 26 high " " return endcase case 0x1B ; ESC return endcase endswitch endwhile endproc ;************************************************************************** ;* * ;* Function: ModifyMisc * ;* * ;************************************************************************** proc ModifyMisc integer _ansi_on,_expose,_pager,_blanker,_htimeout,_wtimeout,_blanktimeout integer _log_it, choice _log_it = log_it ;* _ansi_on = ansi_on ;* _expose = expose ;** _pager = pager ;*** _blanker = blanker ;**** Set values to restore on A)bort _htimeout = htimeout ;*** _wtimeout = wtimeout ;** _blanktimeout = blanktimeout ;* clear box 0 1 8 78 normal atsay 0 24 normal "] SCRIPTED HOST MODE PARAMETERS [" if ansi_on s0 = "ON " else s0 ="OFF" endif fatsay 2 13 normal " ANSI = %s" s0 if expose s0 = "ON " else s0 ="OFF" endif fatsay 3 7 normal "Show Password = %s" s0 if PAGER s0 = "ON " else s0 ="OFF" endif fatsay 4 10 normal "Allow Page = %s" s0 if log_it s0 = "ON " else s0 ="OFF" endif fatsay 5 8 normal "Activity Log = %s" s0 if BLANKER s0 = "ON " else s0 ="OFF" endif fatsay 2 41 normal "Screen BLANKER = %s" s0 fatsay 3 43 normal "BLANKTIMEOUT = %i" BLANKTIMEOUT fatsay 4 37 normal "Inactivity Warning = %i" WTIMEOUT fatsay 5 38 normal "Inactivity Hangup = %i" HTIMEOUT while 1 atsay 7 26 high "E)dit, A)bort, S)ave & exit " keyget choice switch choice case 0x65 ; e case 0x45 ; E atsay 7 26 high " " call toggle with 2 23 &ansi_on call toggle with 3 23 &expose call toggle with 4 23 &pager call toggle with 5 23 &log_it call toggle with 2 58 &blanker atsay 7 26 high "Range: 5-999 (secs)" atget 3 58 inverse 3 BLANKTIMEOUT default atsay 7 26 high " " if blanktimeout < 5 blanktimeout = 5 endif fatsay 3 58 normal "%i " BLANKTIMEOUT atsay 7 26 high "Range: 45-999 (secs)" atget 4 58 inverse 3 WTIMEOUT default atsay 7 26 high " " if wtimeout < 45 wtimeout = 45 endif atsay 7 26 high "Range: 60-999 (secs)" fatsay 4 58 normal "%i " WTIMEOUT atget 5 58 inverse 3 HTIMEOUT default atsay 7 26 high " " if htimeout < 60 htimeout = 60 endif fatsay 5 58 normal "%i " HTIMEOUT endcase case 0x61 ; a case 0x41 ; A ansi_on = _ansi_on ;* expose = _expose ;** pager = _pager ;*** blanker = _blanker ;**** Restore Values htimeout = _htimeout ;*** wtimeout = _wtimeout ;** blanktimeout = _blanktimeout ;* log_it = _log_it return endcase case 0x73 ; s case 0x53 ; S atsay 7 26 high "Writing Parm File... " call writeparms atsay 7 26 high " " return endcase case 0x1B ; ESC return endcase endswitch endwhile endproc ;************************************************************************** ;* * ;* Function: WriteParms * ;* * ;************************************************************************** proc writeparms fopen 0 hostparmfile "W" ; Create if failure ; Can't create strfmt s0 "`a`aUnable to create (%s) - No Host Parameter File Available" message s0 set termwidth otermwidth ; Restore TermWidth exit endif fputs 0 "DIR1=" fputs 0 adir1 fputs 0 "`n" fputs 0 "DIR2=" fputs 0 adir2 fputs 0 "`n" fputs 0 "DIR3=" fputs 0 adir3 fputs 0 "`n" fputs 0 "DIR4=" fputs 0 adir4 fputs 0 "`n" fputs 0 "DIR5=" fputs 0 adir5 fputs 0 "`n" fputs 0 "NAM1=" fputs 0 anam1 fputs 0 "`n" fputs 0 "NAM2=" fputs 0 anam2 fputs 0 "`n" fputs 0 "NAM3=" fputs 0 anam3 fputs 0 "`n" fputs 0 "NAM4=" fputs 0 anam4 fputs 0 "`n" fputs 0 "NAM5=" fputs 0 anam5 fputs 0 "`n" fputs 0 "ANSI=" if ansi_on fputs 0 "ON" else fputs 0 "OFF" endif fputs 0 "`n" fputs 0 "BLANKTIMEOUT=" itoa blanktimeout s0 fputs 0 s0 fputs 0 "`n" fputs 0 "BLANKER=" if blanker fputs 0 "ON" else fputs 0 "OFF" endif fputs 0 "`n" fputs 0 "EXPOSE=" if expose fputs 0 "ON" else fputs 0 "OFF" endif fputs 0 "`n" fputs 0 "PAGER=" if pager fputs 0 "ON" else fputs 0 "OFF" endif fputs 0 "`n" fputs 0 "LOG_IT=" if log_it fputs 0 "ON" else fputs 0 "OFF" endif fputs 0 "`n" fputs 0 "WTIMEOUT=" itoa wtimeout s0 fputs 0 s0 fputs 0 "`n" fputs 0 "HTIMEOUT=" itoa htimeout s0 fputs 0 s0 fputs 0 "`n" fclose 0 endproc ;************************************************************************** ;* * ;* Function: InterFlag * ;* Purpose: Interpret Mail Flag * ;* Input: Flag - Integer * ;* Return: Flag - String * ;* Notes: * ;* * ;************************************************************************** proc InterFlag strparm flagout intparm flagin flagout = "`"" if (flagin & private) ; If flag is private strcat flagout "PRIVATE" ; show private else ; if not strcat flagout "PUBLIC" ; show public endif ; if (flagin & newmail) ; strcat flagout "\NEWMAIL" ; endif ; if (flagin & deleted) ; strcat flagout "\DELETED" ; endif ; strcat flagout "`"" endproc ;************************************************************************** ;* Function: GetYN * ;* Purpose: Input a "Y" or a "N" response * ;* Input: None * ;* return: SUCCESS if Yes * ;* FAILURE if No * ;************************************************************************** proc GetYN string response while forever KeyGet N9 if n9==0xE00D n9=0xD endif key2ascii N9 response message response message "`r`n" strupr response switch response case "`r" call setsuccess exitwhile endcase case "Y" call SetSuccess exitwhile endcase case "N" call SetFailure exitwhile endcase endswitch endwhile endproc ;************************************************************************** ;* * ;* Function: BuildDFile * ;* Purpose: Add data directory to start of data files * ;* Input: DataFileString * ;* return: DDir + DataFileString * ;* * ;************************************************************************** proc BuildDFile strparm dfile string temp temp = ddir strlen temp n9 ; Get length of temp dec n9 ; Dec by 1 (string index ; starts at 0) strpeek temp n9 n8 ; Check last character if !(n8 == 92) ; If no `\` strcat temp "\" ; Add it endif strcat temp dfile dfile = temp endproc ;************************************************************************** ;* * ;* Function: Maintenance * ;* Purpose: Delete Message Base or Log File * ;* Input: * ;* return: * ;* * ;************************************************************************** proc maintenance string response clear box 4 11 9 68 normal atsay 4 31 normal "] FILE MAINTENANCE [" atsay 9 33 normal "] ESC to return [" atsay 6 32 normal "C)lear Log File" atsay 7 32 normal "D)elete Message Base" atsay 6 32 high "C" atsay 7 32 high "D" while forever KeyGet N9 if n9==0xE00D n9=0xD endif key2ascii N9 response strupr response switch response case "C" atsay 8 31 high "Are you sure (Y/n)? " call GetYN locate 0 0 message " `b" if success delete hostlogfile endif atsay 8 31 high " " endcase case "D" atsay 8 31 high "Are you sure (Y/n)? " call GetYN locate 0 0 message " `b" if success delete msgfile delete hdrfile endif atsay 8 31 high " " endcase case "`x01B" exitwhile endcase endswitch endwhile endproc