Category : Communication (modem) tools and utilities
Archive   : ASPHST.ZIP
Filename : HOSTUTIL.ASP

 
Output of file : HOSTUTIL.ASP contained in archive : ASPHST.ZIP
; HOSTUTIL v 1.02a
;**************************************************************************
;* *
;* HOST.ASP V1.02a *
;* Copyright (C) 1992, 1993 Datastorm Technologies, Inc. *
;* All rights reserved. *
;* *
;* An ASPECT script file that facilitates the configuration of the *
;* host mode script. *
;* *
;* This ASPECT SCRIPT is intended only as a sample of ASPECT programming. *
;* DATASTORM makes no warranty of any kind, express or implied, including *
;* without limitation, any warranties of mechantability and/or fitness *
;* for a particular purpose. Use of this program is at your own risk. *
;* *
;* Author: Michael Schamberger - 1993 *
;* *
;**************************************************************************
;**************************************************************************

;**************************************************************************
;* 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
integer ECFlag
long Chars_To_Read
string _Date,_Time
string Msg,Destination,From,Subject,Line
integer Dummy
string DataDir ; Data Directory
string ADir1,ADir2,ADir3,ADir4,ADir5 ; Alternate Directories
string ANam1,ANam2,ANam3,ANam4,ANam5 ; Alternate Directories
string ADir6,ADir7,ADir8,ADir9,ADir0 ; Alternate Directories
string ANam6,ANam7,ANam8,ANam9,ANam0 ; Alternate Directories
integer HTimeOut,WTimeOut ; Inactivity timers
integer Inverse,Normal,High
integer LogIt ; Activity log
integer AnsiOn ; 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 HOSTUSERFILE = "PCPLUS.USR" ; host user 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 PCPLUSPARM = "PCPLUS.PRM" ; PCPLUS parm file
string Version = "1.02" ; script version

define PUBLIC 0 ;*
define PRIVATE 1 ;** mail
define NEWMAIL 2 ;** flags
define DELETED 4 ;*

define OPTION1 "READ/LEAVE MAIL"
define OPTION2 "PACK MAIL"
define OPTION3 "ALTERNATE DIRECTORY PATHS & NAMES"
define OPTION4 "GENERAL OPTIONS"
define OPTION5 "FILE MAINTENANCE"
define OPTION6 "EDIT USER RECORD"
define OPTION7 "EXIT"

;**************************************************************************
;* Main Procedure of HostUtil.Asp *
;**************************************************************************

include "INCLUDE.INC"

proc Main

set ASPDEBUG ON

call TermSetup ; Setup terminal and dirs
call GetColors ; Define terminal colors
call GetHostParms ; Read Initial Parms
call Menu ; Opening menu
endproc

;**************************************************************************
;* Function: Menu *
;* Purpose: Menu of options *
;* Input: None *
;* return: None *
;**************************************************************************

proc Menu
integer OptCol1,OptCol2,OptCol3 ;* Option Rows (calculated
integer OptCol4,OptCol5,OptCol6 ;* from length of option)
integer OptCol7
integer Pick = 0 ;*
integer Row=6 , Col ;** Definine Initial Values
string Temp ;*

call ColCalc with OPTION1 &OptCol1
call ColCalc with OPTION2 &OptCol2
call ColCalc with OPTION3 &OptCol3
call ColCalc with OPTION4 &OptCol4
call ColCalc with OPTION5 &OptCol5
call ColCalc with OPTION6 &OptCol6
call ColCalc with OPTION7 &OptCol7

box 1 20 15 60 Normal ; Draw Box
atsay 3 22 Normal $DATE ; Display date
fatsay 1 31 High "] HOST UTILITY %s [" version ; Information
atsay 15 32 High "] Use Arrow Keys [" ; bars

atsay 6 OptCol1 Normal OPTION1
atsay 7 OptCol2 Normal OPTION2
atsay 8 OptCol3 Normal OPTION3
atsay 9 OptCol4 Normal OPTION4
atsay 10 OptCol5 Normal OPTION5
atsay 11 OptCol6 Normal OPTION6
atsay 13 OptCol7 Normal OPTION7

Col = OptCol1 ; Set column to 1st column
Temp = OPTION1 ; Temp to 1st Option

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 == 12
Row = 11
endif
endcase
case 0x50E0 ; Gray Down Arrow ; Does Pick = Down Arrow?
case 0x5000 ; Regular Down Arrow ;
inc Row
if Row == 12
Row = 13
endif
endcase
case 0x1B ; Does Pick = ESC
Row = 20 ; Set Row to 18
col = OptCol7 ; 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 11 ; Does Row = 10 - Maintenance
vidsave 0 ; Save Video Index 0
clear ; Clear Screen
call EditUser ; Call EditUser
vidrest 0 ; Restore Vidoe Index 0
endcase
case 13 ; 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 = 13 ;** Allow for space between
endif ;*** Exit & last option
if Row > 13 ;**
Row = 6 ;*
endif

switch Row ;*
case 6 ;**
Temp = OPTION1 ;***
Col = OptCol1 ;****
endcase ;*****
case 7 ;******
Temp = OPTION2 ;*******
Col = OptCol2 ;********
endcase ;*********
case 8 ;********** switch on row
Temp = OPTION3 ;*********** & set Column
Col = OptCol3 ;*********** & temp
endcase ;************ accordingly
case 9 ;*************
Temp = OPTION4 ;**************
Col = OptCol4 ;***************
endcase ;***************
case 10 ;**************
Temp = OPTION5 ;*************
Col = OptCol5 ;************
endcase ;***********
case 11 ;**********
Temp = OPTION6 ;*********
Col = OptCol6 ;********
endcase ;*******
case 13 ;******
Temp = OPTION7 ;*****
Col = OptCol7 ;****
endcase ;***
endswitch ;**
endwhile ;*
endproc

;**************************************************************************
;* Function: TermSetup *
;* Purpose: define terminal options and directories *
;* Input: None *
;* return: None *
;**************************************************************************

proc TermSetup

fetch TERMWIDTH OTERMWIDTH ; Get original termwidth & save
set TERMWIDTH 80 ; Force 80 column termwidth

getenv "PCPLUS" DataDir ;Get DOS var PCPLUS,save in ddir
strcmp DataDir "" ; Compare to null
if SUCCESS ; SUCCESS, variable not set
DataDir = "." ; set to current directory
endif
strupr DataDir ; Convert to uppercase

call BuildDFile with &HOSTPARMFILE ; Add path to HOSTPARMFILE
call BuildDFile with &HOSTUSERFILE ; Add path to HOSTUSERFILE
call BuildDFile with &PCPLUSPARM ; Add path to PCPlus parm file
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 ; *
set MSG_CRLF OFF ; Set Message LineFeed Off
set KEYS ON ; Set Keys Off
curoff ; Don't display cursor
clear ; Clear Screen
endproc

;**************************************************************************
;* *
;* Function: RowCalc *
;* Purpose: Calculate the row of a title based on length *
;* Input: Title (string) *
;* Return: Row (integer) *
;* *
;**************************************************************************

proc ColCalc
strparm Title
intparm Col
integer Len

strlen Title Col
div Col 2 Len
Col = 40 - Len
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
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,ParmLen

LogIt = 1
AnsiOn = 1 ;*
BlankTimeOut = 300 ;**
Blanker = 1 ;***
Expose = 0 ;**** Define default host settings
Pager = 1 ;****
WTimeout = 180 ;***
HTimeout = 300 ;**
ECFlag = 0 ;*

ADir0 = $NULL ;*
ADir1 = $NULL ;**
ADir2 = $NULL ;***
ADir3 = $NULL ;****
ADir4 = $NULL ;*****
ADir5 = $NULL ;***** Define default directory paths
ADir6 = $NULL ;****
ADir7 = $NULL ;***
ADir8 = $NULL ;**
ADir9 = $NULL ;*

ANam0 = "N/A" ;*
ANam1 = "N/A" ;**
ANam2 = "N/A" ;***
ANam3 = "N/A" ;****
ANam4 = "N/A" ;*****
ANam5 = "N/A" ;***** Define default directory titles
ANam6 = "N/A" ;****
ANam7 = "N/A" ;***
ANam8 = "N/A" ;**
ANam9 = "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 "DIR0=`n" ;*
fputs 0 "DIR1=`n" ;**
fputs 0 "DIR2=`n" ;***
fputs 0 "DIR3=`n" ;****
fputs 0 "DIR4=`n" ;*****
fputs 0 "DIR5=`n" ;***** Write default directory paths
fputs 0 "DIR6=`n" ;****
fputs 0 "DIR7=`n" ;***
fputs 0 "DIR8=`n" ;**
fputs 0 "DIR9=`n" ;*

fputs 0 "NAM0=N/A`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 directory titles
fputs 0 "NAM5=N/A`n" ;***** Include Line Feed (`n)
fputs 0 "NAM6=N/A`n" ;****
fputs 0 "NAM7=N/A`n" ;***
fputs 0 "NAM8=N/A`n" ;**
fputs 0 "NAM9=N/A`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" ;*
fputs 0 "EC=OFF`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

call CheckRec with &ADir0 "DIR0=" ParmRec ParmLen StLen
call CheckRec with &ADir1 "DIR1=" ParmRec ParmLen StLen
call CheckRec with &ADir2 "DIR2=" ParmRec ParmLen StLen
call CheckRec with &ADir3 "DIR3=" ParmRec ParmLen StLen
call CheckRec with &ADir4 "DIR4=" ParmRec ParmLen StLen
call CheckRec with &ADir5 "DIR5=" ParmRec ParmLen StLen
call CheckRec with &ADir6 "DIR6=" ParmRec ParmLen StLen
call CheckRec with &ADir7 "DIR7=" ParmRec ParmLen StLen
call CheckRec with &ADir8 "DIR8=" ParmRec ParmLen StLen
call CheckRec with &ADir9 "DIR9=" ParmRec ParmLen StLen

call CheckRec with &ANam0 "NAM0=" ParmRec ParmLen StLen
call CheckRec with &ANam1 "NAM1=" ParmRec ParmLen StLen
call CheckRec with &ANam2 "NAM2=" ParmRec ParmLen StLen
call CheckRec with &ANam3 "NAM3=" ParmRec ParmLen StLen
call CheckRec with &ANam4 "NAM4=" ParmRec ParmLen StLen
call CheckRec with &ANam5 "NAM5=" ParmRec ParmLen StLen
call CheckRec with &ANam6 "NAM6=" ParmRec ParmLen StLen
call CheckRec with &ANam7 "NAM7=" ParmRec ParmLen StLen
call CheckRec with &ANam8 "NAM8=" ParmRec ParmLen StLen
call CheckRec with &ANam9 "NAM9=" ParmRec ParmLen StLen

strcmp ParmRec "ANSI=" 5
if SUCCESS
ParmLen = stlen - 6
substr temp ParmRec 5 ParmLen
strcmp temp "ON" 2
if SUCCESS
AnsiOn = 1
else
AnsiOn = 0
endif
endif

strcmp ParmRec "PAGER=" 6
if SUCCESS
ParmLen = stlen - 7
substr temp ParmRec 6 ParmLen
strcmp temp "ON" 2
if SUCCESS
PAGER = 1
else
PAGER = 0
endif
endif

strcmp ParmRec "EXPOSE=" 7
if SUCCESS
ParmLen = stlen - 8
substr temp ParmRec 7 ParmLen
strcmp temp "ON" 2
if SUCCESS
expose = 1
else
expose = 0
endif
endif

strcmp ParmRec "LOG_IT=" 7
if SUCCESS
ParmLen = stlen - 8
substr temp ParmRec 7 ParmLen
strcmp temp "ON" 2
if SUCCESS
LogIt = 1
else
LogIt = 0
endif
endif

strcmp ParmRec "BLANKER=" 8
if SUCCESS
ParmLen = stlen - 9
substr temp ParmRec 8 ParmLen
strcmp temp "ON" 2
if SUCCESS
BLANKER = 1
else
BLANKER = 0
endif
endif

strcmp ParmRec "BLANKTIMEOUT=" 13
if SUCCESS
ParmLen = stlen - 14
substr temp ParmRec 13 ParmLen
atoi temp blanktimeout

if (blanktimeout < 1) || (blanktimeout > 30000)
blanktimeout = 300
endif
endif

strcmp ParmRec "WTIMEOUT=" 9
if SUCCESS
ParmLen = stlen - 10
substr temp ParmRec 9 ParmLen
atoi temp Wtimeout
if (Wtimeout < 10) || (Wtimeout > 30000)
Wtimeout = 180
endif
endif

strcmp ParmRec "HTIMEOUT=" 9
if SUCCESS
ParmLen = stlen - 10
substr temp ParmRec 9 ParmLen
atoi temp HTimeout
if (Htimeout < 10) || (Htimeout > 30000)
Htimeout = 300
endif
endif

strcmp ParmRec "EC=" 3 ; See if record is EC entry
if SUCCESS ; yes?
ParmLen = stlen - 4 ; start after "="
substr temp ParmRec 3 ParmLen ; Extract EC data
strcmp temp "ON" 2 ;***** Set ECFlag
if SUCCESS ;***** 0 = off, 1 = on
ECFlag = 1 ;****
else ;***
ECFlag = 0 ;**
endif ;*
endif
endwhile
endproc

;**************************************************************************
;* *
;* Function: CheckRec *
;* Purpose: Determine if current record matches desired setting *
;* Input: Literal,Record,Record Length, String Length *
;* Return: Setting *
;* *
;**************************************************************************

proc CheckRec
strparm RecUnit
strparm Literal
strparm ParmRec
intparm ParmLen
intparm SLen

strcmp ParmRec Literal 5
if SUCCESS
ParmLen = SLen - 6
substr RecUnit ParmRec 5 ParmLen
endif
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
integer Len,Char

call Strip_Space with &NewDir
strupr NewDir ; Convert to uppercase

strlen NewDir Len ; Check length
if Len < 2 ; Allow for root (\)
call SetSuccess
return
endif

strlen NewDir Len ; Get Length of NewDir
dec Len ; Dec by 1 (String Index Starts w/ 0)
strpeek NewDir Len Char ; Check Last Character
if (Char == 92) ; If `\`
substr NewDir NewDir 0 Len ; Strip backslash
dec Len ; Reset Length
endif

GetDir 0 OriDir ; Get Original Directory

strpeek NewDir 1 Char ; LoOk at second char in NewDir
if !(Char==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 Char ; LoOk at third char in NewDir
if !(Char==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,oval
string temp

oval = inval

if inval
temp = "ON "
else
temp = "OFF"
endif

atsay 7 23 high "Space Bar to Toggle, Enter to Accept, ESC abort"

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
case 0x1B ; ESCAPE (Abort)
inval=oval
if inval
temp = "ON "
else
temp = "OFF"
endif
atsay row col Normal temp ; Display Current
exitwhile
endcase
endswitch
endwhile
atsay 7 23 high " "
endproc

;**************************************************************************
;* Function: ModifyDirs *
;**************************************************************************

proc ModifyDirs
integer choice
string ODir1,ODir2,ODir3,ODir4,ODir5 ; Alternate Directories
string ONam1,ONam2,ONam3,ONam4,ONam5 ; Alternate Directories
string ODir6,ODir7,ODir8,ODir9,ODir0 ; Alternate Directories
string ONam6,ONam7,ONam8,ONam9,ONam0 ; Alternate Directories

clear
box 0 1 17 78 Normal
atsay 0 24 Normal "] SCRIPTED HOST MODE PARAMETERS ["
atsay 2 10 high "Directory Paths"
atsay 2 54 high "Directory Titles"

ODir0=ADir0 ;*
ODir1=ADir1 ;**
ODir2=ADir2 ;***
ODir3=ADir3 ;****
ODir4=ADir4 ;*****
ODir5=ADir5 ;******
ODir6=ADir6 ;*******
ODir7=ADir7 ;********
ODir8=ADir8 ;*********
ODir9=ADir9 ;***** Store Original Values
;***** Can be restored
ONam0=ANam0 ;***** Used for Aborts
ONam1=ANam1 ;*********
ONam2=ANam2 ;********
ONam3=ANam3 ;*******
ONam4=ANam4 ;******
ONam5=ANam5 ;*****
ONam6=ANam6 ;****
ONam7=ANam7 ;***
ONam8=ANam8 ;**
ONam9=ANam9 ;*

for N9 = 3 upto 12
N8 = N9 - 3
fatsay N9 2 high "%1i)" N8
endfor

call VerifyDir with &ADir0 3
call VerifyDir with &ADir1 4
call VerifyDir with &ADir2 5
call VerifyDir with &ADir3 6
call VerifyDir with &ADir4 7
call VerifyDir with &ADir5 8
call VerifyDir with &ADir6 9
call VerifyDir with &ADir7 10
call VerifyDir with &ADir8 11
call VerifyDir with &ADir9 12

fatsay 3 8 Normal "DIR0 = %s" ADIR0
fatsay 4 8 Normal "DIR1 = %s" ADIR1
fatsay 5 8 Normal "DIR2 = %s" ADIR2
fatsay 6 8 Normal "DIR3 = %s" ADIR3
fatsay 7 8 Normal "DIR4 = %s" ADIR4
fatsay 8 8 Normal "DIR5 = %s" ADIR5
fatsay 9 8 Normal "DIR6 = %s" ADIR6
fatsay 10 8 Normal "DIR7 = %s" ADIR7
fatsay 11 8 Normal "DIR8 = %s" ADIR8
fatsay 12 8 Normal "DIR9 = %s" ADIR9

fatsay 3 46 Normal "<--> NAM0 = %s" ANAM0
fatsay 4 46 Normal "<--> NAM1 = %s" ANAM1
fatsay 5 46 Normal "<--> NAM2 = %s" ANAM2
fatsay 6 46 Normal "<--> NAM3 = %s" ANAM3
fatsay 7 46 Normal "<--> NAM4 = %s" ANAM4
fatsay 8 46 Normal "<--> NAM5 = %s" ANAM5
fatsay 9 46 Normal "<--> NAM6 = %s" ANAM6
fatsay 10 46 Normal "<--> NAM7 = %s" ANAM7
fatsay 11 46 Normal "<--> NAM8 = %s" ANAM8
fatsay 12 46 Normal "<--> NAM9 = %s" ANAM9

fatsay 14 15 Normal "`"PCPLUS`" DOS Variable = [%s]" DataDir

while 1
atsay 16 17 high "(0-9) to Edit, S)ave & exit, ESC - abort & exit"
keyget choice
atsay 16 17 high " "
switch choice
case 0x30 ; 0
call editdir with &ADir0 &ANam0 3
endcase
case 0x31 ; 1
call editdir with &ADir1 &ANam1 4
endcase
case 0x32 ; 2
call editdir with &ADir2 &ANam2 5
endcase
case 0x33 ; 3
call editdir with &ADir3 &ANam3 6
endcase
case 0x34 ; 4
call editdir with &ADir4 &ANam4 7
endcase
case 0x35 ; 5
call editdir with &ADir5 &ANam5 8
endcase
case 0x36 ; 6
call editdir with &ADir6 &ANam6 9
endcase
case 0x37 ; 7
call editdir with &ADir7 &ANam7 10
endcase
case 0x38 ; 8
call editdir with &ADir8 &ANam8 11
endcase
case 0x39 ; 9
call editdir with &ADir9 &ANam9 12
endcase

case 0x73 ; s
case 0x53 ; S
atsay 16 26 high "Writing Parm File... "
call writeparms
atsay 16 26 high " "
return
endcase

case 0x1B ; ESC
ADir0=ODir0 ;*
ADir1=ODir1 ;**
ADir2=ODir2 ;***
ADir3=ODir3 ;****
ADir4=ODir4 ;***** Restore original directory paths
ADir5=ODir5 ;*****
ADir6=ODir6 ;****
ADir7=ODir7 ;***
ADir8=ODir8 ;**
ADir9=ODir9 ;*

ANam0=ONam0 ;*
ANam1=ONam1 ;**
ANam2=ONam2 ;***
ANam3=ONam3 ;****
ANam4=ONam4 ;*****
ANam5=ONam5 ;****** Restore original Titles & return
ANam6=ONam6 ;*****
ANam7=ONam7 ;****
ANam8=ONam8 ;***
ANam9=ONam9 ;**
return ;*
endcase
default
endcase
endswitch
endwhile
endproc

;**************************************************************************
;* Function: VerifyDir *
;**************************************************************************

proc VerifyDir
strparm DirPath
intparm Row
integer Ok,Bad

SetVAttr &Ok BLACK RED NOBLINK
SetVAttr &Bad WHITE RED BLINK

atsay 16 26 Ok "Verifying Alternate Directories..."

call DExist with &DirPath
if FAILURE
atsay Row 4 Bad " BAD"
else
atsay Row 4 Ok " OK "
endif
endproc

;**************************************************************************
;* Function: EditDir *
;**************************************************************************

proc EditDir
strparm DPath,DName
intparm Row
integer Ok,Bad

setvattr &Ok black red noblink
setvattr &Bad white red blink

atsay Row 4 Ok "EDIT" ;** Clear Bad/OK markers

vidsave 2
Row = Row - 2
box 7 15 12 60 Ok
N1 = Ok + 15
atsay 7 25 N1 "] Directory Info EditBox ["
atsay 12 23 N1 "] Enter to accept, ESC to Abort["
fatsay 9 17 Ok "Dir%i = " Row
fatsay 10 17 Ok "Nam%i = " Row
fatsay 9 24 OK "%-30s" DPath
fatsay 10 24 OK "%-30s" DName
Row = Row + 2

atget 9 24 Inverse 30 DPath default

strupr DPath
call pad with &DPath 30
fatsay 9 24 OK "%s" DPath

if SUCCESS ; If user hits ESC, bypass
atget 10 24 Inverse 19 DName default
call pad with &DName 19
strupr DName
fatsay 9 24 OK "%s" DName
endif

vidrest 2

call dexist with &DPath ;
if failure ;
atsay Row 4 Bad " BAD" ;
else ;
atsay Row 4 Ok " OK " ;
endif ;

fatsay Row 15 Normal "%-30s" DPath
fatsay Row 58 Normal "%-19s" DName

call strip_space with &DPath
call strip_space with &DName
endproc

;**************************************************************************
;* Function: ModifyMisc *
;**************************************************************************

proc ModifyMisc
integer _AnsiOn,_expose,_pager,_blanker,_htimeout,_wtimeout,_blanktimeout
integer _Logit, _ECFlag, choice

_Logit = Logit ; *
_AnsiOn = AnsiOn ; **
_expose = expose ; ***
_pager = pager ; ****
_blanker = blanker ; ***** Set values to restore on A)bort
_htimeout = htimeout ; ****
_wtimeout = wtimeout ; ***
_blanktimeout = blanktimeout ; **
_ECFlag = ECFlag ; *

clear
box 0 1 8 78 Normal
atsay 0 24 Normal "] SCRIPTED HOST MODE PARAMETERS ["

for N9 = 2 upto 5
N8 = N9 -1
fatsay N9 4 high "%1i)" N8
endfor

for N9 = 2 upto 5
N8 = N9 + 3
fatsay N9 34 high "%1i)" N8
endfor

atsay 2 62 high "9)"

if AnsiOn
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 Logit
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 40 Normal "BLANKER timeout = %i (secs)" BLANKTIMEOUT
fatsay 4 37 Normal "Inactivity Warning = %i" WTIMEOUT
fatsay 5 38 Normal "Inactivity Hangup = %i" HTIMEOUT

if ECFlag
s0 = "ON "
else
s0 ="OFF"
endif
fatsay 2 65 Normal "ECFlag = %s" S0

while 1
atsay 7 17 high "(1-9) to Edit, S)ave & exit, ESC - abort & exit"
keyget choice
atsay 7 17 high " "
switch choice

case 0x31 ; 1
call toggle with 2 23 &AnsiOn
endcase

case 0x32 ; 2
call toggle with 3 23 &expose
endcase

case 0x33 ; 3
call toggle with 4 23 &pager
endcase

case 0x34 ; 4
call toggle with 5 23 &Logit
endcase

case 0x35 ; 5
call toggle with 2 58 &blanker
endcase

case 0x36 ; 6
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
endcase

case 0x37 ; 7
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
endcase

case 0x38 ; 8
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 0x39 ; 9
call toggle with 2 74 &ECFlag
endcase

case 0x73 ; s
case 0x53 ; S
atsay 7 26 high "Writing Parm File... "
call writeparms
atsay 5 26 high " "
return
endcase
case 0x1B ; ESC
ECFlag = _ECFlag
AnsiOn = _AnsiOn ;*
expose = _expose ;**
pager = _pager ;***
blanker = _blanker ;**** Restore Values
htimeout = _htimeout ;***
wtimeout = _wtimeout ;**
blanktimeout = _blanktimeout ;*
Logit = _Logit
ECFlag = _ECFlag
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

fstrfmt 0 "DIR0=%s`n" ADir0
fstrfmt 0 "DIR1=%s`n" ADir1
fstrfmt 0 "DIR2=%s`n" ADir2
fstrfmt 0 "DIR3=%s`n" ADir3
fstrfmt 0 "DIR4=%s`n" ADir4
fstrfmt 0 "DIR5=%s`n" ADir5
fstrfmt 0 "DIR6=%s`n" ADir6
fstrfmt 0 "DIR7=%s`n" ADir7
fstrfmt 0 "DIR8=%s`n" ADir8
fstrfmt 0 "DIR9=%s`n" ADir9

fstrfmt 0 "NAM0=%s`n" ANam0
fstrfmt 0 "NAM1=%s`n" ANam1
fstrfmt 0 "NAM2=%s`n" ANam2
fstrfmt 0 "NAM3=%s`n" ANam3
fstrfmt 0 "NAM4=%s`n" ANam4
fstrfmt 0 "NAM5=%s`n" ANam5
fstrfmt 0 "NAM6=%s`n" ANam6
fstrfmt 0 "NAM7=%s`n" ANam7
fstrfmt 0 "NAM8=%s`n" ANam8
fstrfmt 0 "NAM9=%s`n" ANam9

fputs 0 "ANSI="
if AnsiOn
fputs 0 "ON`n"
else
fputs 0 "OFF`n"
endif

fputs 0 "BLANKTIMEOUT="
itoa blanktimeout s0
fputs 0 s0
fputs 0 "`n"

fputs 0 "BLANKER="
if blanker
fputs 0 "ON`n"
else
fputs 0 "OFF`n"
endif

fputs 0 "EXPOSE="
if expose
fputs 0 "ON`n"
else
fputs 0 "OFF`n"
endif

fputs 0 "PAGER="
if pager
fputs 0 "ON`n"
else
fputs 0 "OFF`n"
endif

fputs 0 "LOG_IT="
if Logit
fputs 0 "ON`n"
else
fputs 0 "OFF`n"
endif

fputs 0 "WTIMEOUT="
itoa wtimeout s0
fputs 0 s0
fputs 0 "`n"

fputs 0 "HTIMEOUT="
itoa htimeout s0
fputs 0 s0
fputs 0 "`n"

fputs 0 "EC="
if ECFlag
fputs 0 "ON`n"
else
fputs 0 "OFF`n"
endif
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: DataDir + DataFileString *
;* *
;**************************************************************************

proc BuildDFile
strparm DataFile
string Temp
integer Len
integer Char

Temp = DataDir
strlen Temp Len ; Get length of Temp
dec Len ; Dec by 1 (string index
; starts at 0)
strpeek Temp Len Char ; Check last character
if !(Char == 92) ; If no `\`
strcat Temp "\" ; Add it
endif

strcat Temp DataFile
DataFile = 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

;**************************************************************************
;* *
;* Function: GetColors *
;* Purpose: Extract Colors from PCPLUS.PRM *
;* Input: none *
;* return: Normal Color, Inverse Color, Hilite Color - integers *
;* Notes: These are the colors set for the dialing directory *
;* *
;**************************************************************************

proc GetColors
fopen 5 PCPLUSPARM "R" ; Open Parm file
fseek 5 0x3F6 0 ; Go to offset of Norm color
fgetc 5 High ; Read Norm Color
fseek 5 0x3F4 0 ; Go to offset of reverse
fgetc 5 Normal ; Read Reverse
fclose 5 ; Close Parm File
Inverse = (7 * 16) + 0 ; Black on White
endproc

;**************************************************************************
;* *
;* Function: MoveFile(string,string) *
;* Purpose: Copy contents of one file to another, then delete original *
;* Input: Source File, Target File *
;* return: None *
;* Notes: *
;* *
;**************************************************************************

proc MoveFile
strparm Source,Target
string Record

fopen 1 Source "RT+" ; Try to open file
if !SUCCESS
strfmt S0 "Unable to open (%s) temporary file" Source
errormsg S0
exit
endif

fopen 2 Target "W"
if !SUCCESS
strfmt S0 "Unable to open (%s) temporary file" Target
errormsg S0
exit
endif

while not EOF 1 ; loop until end of file
fgets 1 Record ; Get Record
fputs 2 Record
endwhile

fclose 1
fclose 2
delete Source
endproc

;**************************************************************************
;* *
;* Function: BreakRec(string,string,string,string,string,string) *
;* Purpose: Break user record into it's components *
;* Input: User record *
;* return: Last name, First name, Password, UserLevel, Access *
;* Notes: *
;* *
;**************************************************************************

define SemiColon 0x3B

proc BreakRec
strparm Record
strparm Last
strparm First
strparm Password
strparm UserLevel
strparm Access
integer Index = 0

call CopyField with Record &Last &Index
call CopyField with Record &First &Index
call CopyField with Record &Password &Index
call CopyField with Record &UserLevel &Index
call CopyField with Record &Access &Index

endproc

;**************************************************************************
;* *
;* Function: CopyField(string,string,integer) *
;* Purpose: Extract fields from a string, by using field seperators *
;* Input: User record *
;* return: Field, Index of field seperator *
;* Notes: *
;* *
;**************************************************************************

proc CopyField
strparm Record
strparm Field
intparm Index
integer Len
integer Char
string Temp

Field = ""
strlen Record Len
dec Len

while Index <= Len
strpeek Record Index Char
inc Index
if (Char == 0x20) || (Char == 0x0A) || (Char == 0x0D) ; Space or LF or CR
loopwhile
endif
if Char == SemiColon
exitwhile
endif
key2ascii Char Temp
strcat Field Temp
endwhile
endproc

proc ParseAccess
strparm Access
intparm Literal
string Temp
integer Index
integer Char = 0
integer Len

Literal = 0
Temp = Access
Access = ""
strlen Temp Len
dec Len
find Temp "=" Index
if FOUND
while 1
inc Index
strpeek Temp Index Char
if (Char == 0x5D) || (Index >= Len) ; "]"
exitwhile
endif
key2ascii Char Temp
strcat Access Temp
endwhile
endif

strpeek Access 0 Char
if Char == 0x22 ; "
substr Access Access 1 79
strlen Access Len
dec Len
substr Access Access 0 Len
Literal = 1
endif

strlen Access Len
if Len > 1
dec Len
strpeek Access Len Char
if Char == 0x0A
dec Len
substr Access Access 0 Len
endif
endif
endproc

;**************************************************************************
;* *
;* Function: EditUser *
;* Purpose: Allow Sysop to edit a user's record *
;* Input: none *
;* return: none *
;* Notes: *
;* *
;**************************************************************************

proc EditUser
string Record
string UserRec
string First
string Last
string Password
string UserLevel
string Access
string TFile = "\HOSTTEMP.TMP"
integer Len
integer EntryFound = 0
integer Literal
integer DelEntry

box 5 20 10 63 Normal
atsay 5 30 Normal " ] Enter Search Name [ "
atsay 7 22 Normal "User's First Name:"
atsay 8 22 Normal "User's Last Name:"
atget 7 41 Inverse 20 First

if !SUCCESS
return
endif
atsay 7 41 Normal " "
strupr First
atsay 7 41 High First

atget 8 41 Inverse 20 Last
if !SUCCESS
return
endif
atsay 8 41 Normal " "
strupr Last
atsay 8 41 High Last

strfmt UserRec "%s;%s" Last First
strlen UserRec Len
Dec Len
if Len < 3
return
endif

clear

box 5 20 13 68 Normal
atsay 5 31 Normal " ] Edit User Info [ "

fopen 1 HOSTUSERFILE "RT+"
if !SUCCESS
errormsg "User File (PCPLUS.USR) not found!"
exit
endif

fopen 2 TFile "WT" ; Try to open user file
if !SUCCESS
strfmt S0 "Unable to open (%s) temporary file" TFile
errormsg S0
exit
endif

while not EOF 1 ; loop until end of file
fgets 1 Record ; Get Record
strupr Record ; Convert Record uppercase

strcmp Record UserRec Len
if !SUCCESS || EntryFound
fputs 2 Record
loopwhile
endif

EntryFound = 1
DelEntry = 0
call BreakRec with Record &Last &First &Password &UserLevel &Access
call ParseAccess with &Access &Literal

atsay 7 22 Normal " First Name:"
atsay 8 22 Normal " Last Name:"
atsay 9 22 Normal " Password:"
atsay 10 22 Normal " User level:"
atsay 11 22 Normal "Access Dir(s):"
atsay 7 37 High First
atsay 8 37 High Last
fatsay 9 37 High "%-8s" Password
atsay 10 37 High UserLevel
atsay 11 37 High Access

atget 7 37 Inverse 20 First DEFAULT
if !SUCCESS
return
endif
strupr First
atsay 7 37 Normal " "
atsay 7 37 High First
atget 8 37 Inverse 20 Last DEFAULT
if !SUCCESS
return
endif
strupr Last

atsay 8 37 Normal " "
atsay 8 37 High Last
atget 9 37 Inverse 8 Password DEFAULT
if !SUCCESS
return
endif
strupr Password
atsay 9 37 Normal " "
atsay 9 37 High Password

atget 10 37 Inverse 1 UserLevel DEFAULT
if !SUCCESS
return
endif
atsay 10 37 High UserLevel
atget 11 37 Inverse 30 Access DEFAULT
strupr Access
atsay 11 37 Normal " "

strlen Access Len
if Len > 1
if Literal
strfmt Access "[ACCESS=`"%s`"]" Access
else
strfmt Access "[ACCESS=%s]" Access
endif
else
Access = ""
endif

atsay 11 37 High Access

atsay 12 22 High "Save this record (Y/n/d:elete)?"
while 1
keyget N0
if (N0 == 0x0D) || (N0 == 0x59) || (N0 == 0x79)
strfmt Record "%s;%s;%s;%s;%s`n" Last First Password \
UserLevel Access
exitwhile
endif
if (N0 == 0x4E) || (N0 == 0x6E)
exitwhile
endif
if (N0 == 0x44) || (N0 == 0x64)
DelEntry = 1
exitwhile
endif
endwhile
if !DelEntry
fputs 2 Record
endif
endwhile
fclose 1
fclose 2
call MoveFile with TFile HOSTUSERFILE

if !EntryFound
clear
box 5 20 10 63 Normal
atsay 5 32 Normal " ] Enter Search Name [ "
atsay 7 22 Normal "User's First Name:"
atsay 8 22 Normal "User's Last Name:"
atsay 7 41 High First
atsay 8 41 High Last
N1 = High + Blink
atsay 9 22 N1 "User Not Found!"
atsay 9 47 High "Hit a key..."
alarm 2
keyget N1
endif
endproc


  3 Responses to “Category : Communication (modem) tools and utilities
Archive   : ASPHST.ZIP
Filename : HOSTUTIL.ASP

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/