Category : Communication (modem) tools and utilities
Archive   : MRUN200.ZIP
Filename : MRUN200G.WAS

 
Output of file : MRUN200G.WAS contained in archive : MRUN200.ZIP
;MailRun v2.00: Part G, domailrun
;1992 Gerald P. Sully, all rights reserved.

#COMMENT
*************************************************************
*************************************************************

The following procedures form the engine of the script. The
mother routine is domailrun(), which calls makedir() to create
a dialing directory for BBSs listed in the *.MRN file that have
pending items. Each BBS is called, and on connection, each
pending item listed for that BBS is executed. These tasks are
performed by sendmail(), getmail(), ulfile(), dlfile(), and
sendcommand(). As each task is completed, the task list
window is updated.

*************************************************************
*************************************************************
#ENDCOMMENT

#define MRUN200G
#define MRUN200AG
#define GOTOFILE 1
#define GOTOMAIN 0

string CurrentConf, MainBoxTabs, MailRunDir, MailRunTrunc
string BBSidx, BBSdbf, BBSName, BBSType, prompt
integer promptstatus, xferstatus, holdstatus, foundstatus

#include "mrun200.h"


#comment
********************************************************

MAIN()

Calls menudim(), checkchild(), maketasklist(), dobbs()
getfirstitem(), mailrunbox(), parsedialog(), makequeue(),
readbbs()

Main first calls the initialization routines, then puts
up the main dialog box and dispatches each requested
action.

********************************************************
#endcomment

proc main
string DialString, PhoneNum, ComString, ComMsg
string CnctFail1, CnctFail2, CnctFail3, CnctFail4, CnctFail5
string char
integer ComStringLength
integer Attempts, MaxAttempts
integer DialOutTime
integer i, j, n
integer FirstCall
menudim()
checkchild()
profilerd MailRunIni "MailRun" "MailRunDir" MailRunDir
TaskList = makefullname(TempDir, "TASKLIST.TMP")
cleanupfile = makefullname(TempDir, "CLEANUP.TMP")
findfirst MailRun
MailRunTrunc = $FILENAME
assign MailRunList MailRunTrunc
maketasklist()
mailrunbox()
makequeue()
;interface is turned on by makequeue
when dialog call parsedialog
profilerd MailRun "MailRun" "LogRun" LogRun
if LogRun
profilerd MailRun "MailRun" "AnsiInLog" AnsiInLog
if AnsiInLog
set capture mode append RAW
else
set capture mode append VISUAL
endif
capture ON
endif
profilerd MailRun "MailRun" "DialAttempts" MaxAttempts
fetch modem nocnct1 CnctFail1
fetch modem nocnct2 CnctFail2
fetch modem nocnct3 CnctFail3
fetch modem nocnct4 CnctFail4
fetch modem nocnct5 CnctFail5
Attempts = 1
FirstCall = 1
while Attempts <= MaxAttempts
itoa Attempts AttemptNum
updatedlg 64
;Keep dialing until the maximum number of attempts has been made
;reread MaxAttempts on each loop in case the user changes settings
profilerd MailRun "MailRun" "DialAttempts" MaxAttempts
n = 1
DialString = getdialstring(&n)
if n == 0
exitwhile
endif
while not NULLSTR DialString
;Loop until all numbers have been called
strextract PhoneNum DialString "`t" 0
strextract char DialString "`t" 1
atoi char i
BBS = readbbs(i)
READNAME
if FirstCall != 1
;Don't pause if this is the first call in the loop
profilerd MailRun "MailRun" "DialPause" j
while j > 0
statmsg "Last Message: %s Pausing %d" ComMsg j
pause 1
j--
endwhile
else
FirstCall = 0
endif
;Dial the BBS
strfmt ComString "ATDT%s`r" PhoneNum
strlen ComString ComStringLength
computs ComString ComStringLength
;rxdata must be on in order to get characters from the modem
set aspect rxdata ON
rxflush
ComString = ""
ComMsg = ""
profilerd MailRun "MailRun" "DialTimeOut" DialOutTime
while (!$CARRIER) && (DialOutTime > 0)
;Loop until a connection is made, timeout is reached, or a
;negative connect message is received
ComStringLength = $RXCOUNT
comgets ComString ComStringLength
if strfind ComString CnctFail1
ComMsg = CnctFail1
exitwhile
elseif strfind ComString CnctFail2
ComMsg = CnctFail2
exitwhile
elseif strfind ComString CnctFail3
ComMsg = CnctFail3
exitwhile
elseif strfind ComString CnctFail4
ComMsg = CnctFail4
exitwhile
elseif strfind ComString CnctFail5
ComMsg = CnctFail5
exitwhile
endif
rxflush
statmsg "Dialing %s %s Waiting %d" \
PhoneNum BBSName DialOutTime
pause 1
DialOutTime--
endwhile
set aspect rxdata OFF
if DialOutTime == 0
;If dial timed out...
hangup
ComMsg = "TIMEOUT"
endif
if $CARRIER
;if connected to a BBS...
statmsg "Connected to %s" BBSName
dobbs(i)
makequeue()
statmsg ""
FirstCall = 1
n--
endif
n++
DialString = getdialstring(&n)
endwhile
Attempts++
endwhile
capture OFF
statmsg ""
endproc


#comment
********************************************************

DOBBS()

Called by domailrun()

Calls readitem(), writeitem(), sendscript(), logoff(), cleanup()
maketasklist(), gettaskstring(), getcommandprompt(),
getmail(), sendmail(), dlfile(), ulfile(), sendcommand(),

Dispatches pending tasks for the BBS to which MailRun
is connected.

********************************************************
#endcomment

proc dobbs
intparm i
string Pending, TaskType
integer FailCode
integer j
;Return to this point with a FailCode of 1 if carrier
;is lost or the BBS times out
Failcode = 0
setjmp ErrorFail FailCode
if FailCode == 0
profilerd MailRun BBS "BBSType" BBSType
profilerd MailRun "MailRun" "IdleTimeout" IdleTimeout
;Assume login to Conference 0
CurrentConf = "0"
Conf = "0"
strfmt TaskItem "%s`t`t`t%d`t%d" BBSName i 0
;Highlight the current BBS in the task list
updatedlg 16

;The first item must be read before the first holding()
;(which occurs in getcommandprompt()) in case an error occurs.
j = 1
Item = readitem(j)
getcommandprompt()
while not NULLSTR Item
;Loop through each Item for this BBS
TaskItem = gettaskstring(i, j)
updatedlg 16
strextract Pending Item "," 0
if strcmpi Pending "1"
;If the item is pending, execute it
strextract TaskType Item "," 2
switch TaskType
case "GetMail"
statmsg "Getting Mail Packet"
getmail()
endcase
case "SendMail"
statmsg "Sending Reply Packet"
sendmail()
endcase
case "GetFile"
statmsg "Downloading File"
dlfile()
endcase
case "SendFile"
statmsg "Uploading File"
ulfile()
endcase
case "SendCommand"
statmsg "Sending Command"
sendcommand()
endcase
case "SendScript"
statmsg "Executing Script"
sendscript()
endcase
endswitch
;Update the task list
writeitem(j, Item)
maketasklist()
TaskItem = gettaskstring(i, j)
;Highlight the last completed item
updatedlg 80
endif
j++
Item = readitem(j)
endwhile
getcommandprompt()
else
;If timeout or loss of carrier
;Change unfinished items to errors
while not NULLSTR Item
strextract Pending Item "," 0
if strcmpi Pending "1"
strupdt Item "2" 0 1
writeitem(j, Item)
endif
j++
Item = readitem(j)
endwhile
maketasklist()
j--
Item = readitem(j)
TaskItem = gettaskstring(i, j)
updatedlg 80
endif
statmsg "Logging off"
logoff()
if $CARRIER
;If still connected after logoff...
errormsg "Unable to drop carrier; aborting..."
;abort the mailrun
cleanup()
endif
endproc


#comment
********************************************************

MAKEQUEUE()

Called by main(), parsedialog()

Calls openerror(), readbbs(), checkpending(),
interfaceon(), interfaceoff(), makefullname()

Creates a file of phone numbers for BBSs that have
pending items in the current mailrun.

********************************************************
#endcomment

proc makequeue
string Pending
string PhoneNum, Number_X
string QueueList
integer i, j
interfaceoff()
QueueList = makefullname(TempDir, "QUEUE.TMP")
fopen QueueListFile QueueList CREATE
openerror(QueueList)
i = 1
BBS = readbbs(i)
;Loop through each BBS
while not NULLSTR BBS
pending = checkpending()
if strcmpi Pending "1"
;If the BBS has pending items...
j = 1
strfmt Number_X "Number_%d" j
profilerd MailRun BBS Number_X PhoneNum
;Loop through each phone number
while not NULLSTR PhoneNum
fstrfmt QueueListFile "%s`t%d`r`n" PhoneNum i
j++
strfmt Number_X "Number_%d" j
profilerd MailRun BBS Number_X PhoneNum
endwhile
endif
i++
BBS = readbbs(i)
endwhile
fclose QueueListFile
interfaceon()
endproc


#comment
********************************************************

GETDIALSTRING()

Called by main()

Calls makefullname(), interfaceon(), interfaceoff(),

Gets a DialString from the queue. The string contains
a phone number and a bbs coordinate.

********************************************************
#endcomment

func getdialstring : string
intparm n
integer i
string DialString, QueueList
interfaceoff()
DialString = ""
QueueList = makefullname(TempDir, "QUEUE.TMP")
fopen QueueListFile QueueList READ TEXT
i = 1
while i <= n
fgets QueueListFile DialString
if NULLSTR DialString
n = 0
exitwhile
endif
i++
endwhile
fclose QueueListFile
interfaceon()
return DialString
endfunc


#comment
********************************************************

GETCOMMANDPROMPT()

Called by dobbs(), getconfprompt(), getotherprompt(),
ulfile(), dlfile()

Calls holding(), checkcommandprompt()

Responds to prompts until the "Command" prompt is received.

********************************************************
#endcomment

proc getcommandprompt
when quiet 1 call checkcommandprompt
holding()
clearwhen quiet
endproc


#comment
********************************************************

CHECKCOMMANDPROMPT()

Called by getcommandprompt()

Calls endhold()

Checks the prompt and sends the appropriate response.

********************************************************
#endcomment

proc checkcommandprompt
string LangPrompt, LangNumber, GraphicsPrompt, NamePrompt, UserName
string PWordPrompt, PWord, ScanPrompt, MorePrompt, ViewPrompt, FilePrompt
string ContinuePrompt, Confirm1, Confirm2, Confirm1Prompt, Confirm2Prompt
string MailPrompt, CommandPrompt
profilerd MailRun BBS "LangPrompt" LangPrompt
profilerd MailRun BBS "GraphicsPrompt" GraphicsPrompt
profilerd MailRun BBS "NamePrompt" NamePrompt
profilerd MailRun BBS "PWordPrompt" PWordPrompt
profilerd MailRun BBS "ScanPrompt" ScanPrompt
profilerd MailRun BBS "MorePrompt" MorePrompt
profilerd MailRun BBS "ViewPrompt" ViewPrompt
profilerd MailRun BBS "FilePrompt" FilePrompt
profilerd MailRun BBS "ContinuePrompt" ContinuePrompt
profilerd MailRun BBS "Confirm1" Confirm1
profilerd MailRun BBS "Confirm2" Confirm2
profilerd MailRun BBS "Confirm1Prompt" Confirm1Prompt
profilerd MailRun BBS "Confirm2Prompt" Confirm2Prompt
profilerd MailRun BBS "MailPrompt" MailPrompt
profilerd MailRun BBS "CommandPrompt" CommandPrompt
if findstring(prompt, MailPrompt) || \
(findstring(BBSType, "WildCat") && \
(findstring(prompt, "MESSAGE MENU") || findstring(prompt, "MSG")))
transmit "q^M"
elseif findstring(prompt, MorePrompt) && \
findstring(BBSType, "WildCat")
transmit "s^M"
elseif (findstring(prompt, ContinuePrompt) && \
!(findstring(BBSType, "Auntie"))) || \
findstring(prompt, Confirm1) || findstring(prompt, Confirm2)
transmit "y^M"
elseif findstring(prompt, ContinuePrompt) && findstring(BBSType, "Auntie")
transmit "^M"
elseif findstring(BBSType, "WildCat") && \
findstring(prompt, "Join conference")
transmit Conf
transmit "^M"
elseif findstring(prompt, ScanPrompt) || \
(findstring(prompt, MorePrompt) && findstring(BBSType, "PCBoard"))
transmit "n^M"
elseif findstring(prompt, ViewPrompt)
if !findstring(BBSType, "Auntie")
transmit "n"
endif
transmit "^M"
elseif findstring(prompt, Confirm1Prompt)
transmit Confirm1
transmit "^M"
elseif findstring(prompt, Confirm2Prompt)
transmit Confirm2
transmit "^M"
elseif findstring(prompt, NamePrompt)
profilerd MailRun BBS "UserName" UserName
transmit UserName
transmit "^M"
elseif findstring(prompt, PWordPrompt)
profilerd MailRun BBS "PWord" PWord
transmit PWord
transmit "^M"
elseif findstring(prompt, LangPrompt)
profilerd MailRun BBS "LangNumber" LangNumber
transmit LangNumber
transmit "^M"
elseif findstring(prompt, GraphicsPrompt)
profilerd MailRun BBS "GraphicsOn" GraphicsOn
If GraphicsOn == 0
transmit "n^M"
else
transmit "y^M"
endif
elseif findstring(prompt, "Escape") || findstring(prompt, " ESC ")
;send escape character
computc 0x1B
elseif findstring(prompt, CommandPrompt) || findstring(prompt, FilePrompt)
endhold()
endif
endproc


#comment
********************************************************

GETCONFPROMPT()

Called by ulfile(), dlfile()

Calls getcommandprompt()

Changes conferences if necessary.

********************************************************
#endcomment

proc getconfprompt
if not strcmpi CurrentConf Conf
;If we have to change conferences...
if findstring(BBSType, "WildCat")
transmit "j^M"
elseif findstring(BBSType, "PCBoard")
transmit "j;"
transmit Conf
transmit "^M"
endif
getcommandprompt()
assign CurrentConf Conf
endif
endproc


#comment
********************************************************

GETMAILPROMPT()

Called by ulfile(), dlfile()

Calls checkdescprompt()

Checks for upload or download prompt.

********************************************************
#endcomment

proc getmailprompt
when quiet 1 call checkmailprompt
holding()
clearwhen quiet
endproc


#comment
********************************************************

CHECKMAILPROMPT()

Called by getmail(), sendmail()

Calls holding()

Opens the mail door and gets the mail prompt.

********************************************************
#endcomment

proc checkmailprompt
string MailPrompt, ContinuePrompt, MorePrompt, CommandPrompt, MailDoor
string Confirm1, Confirm2, FilePrompt, Confirm1Prompt, Confirm2Prompt
profilerd MailRun BBS "MailPrompt" MailPrompt
profilerd MailRun BBS "ContinuePrompt" ContinuePrompt
profilerd MailRun BBS "MorePrompt" MorePrompt
profilerd MailRun BBS "CommandPrompt" CommandPrompt
profilerd MailRun BBS "FilePrompt" FilePrompt
profilerd MailRun BBS "Confirm1Prompt" Confirm1Prompt
profilerd MailRun BBS "Confirm2Prompt" Confirm2Prompt
if findstring(prompt, MorePrompt)
transmit "n^M"
elseif findstring(prompt, ContinuePrompt)
transmit "^M"
elseif findstring(BBSType, "WildCat") && \
(findstring(prompt, CommandPrompt) || findstring(prompt, FilePrompt))
transmit "M^M"
elseif findstring(prompt, Confirm1Prompt)
profilerd MailRun BBS "Confirm1" Confirm1
transmit Confirm1
transmit "^M"
elseif findstring(prompt, Confirm2Prompt)
profilerd MailRun BBS "Confirm2" Confirm2
transmit Confirm2
transmit "^M"
elseif findstring(prompt, MailPrompt)
endhold()
elseif (findstring(prompt, CommandPrompt) && \
findstring(BBSType, "PCBoard")) || (findstring(BBSType, "WildCat") && \
(findstring(prompt, "MESSAGE MENU") || findstring(prompt, "MSG")))
profilerd MailRun BBS "MailDoor" MailDoor
transmit MailDoor
transmit "^M"
endif
endproc


#comment
********************************************************

GETDESCPROMPT()

Called by ulfile(), dlfile()

Calls checkdescprompt()

Checks for upload or download prompt.

********************************************************
#endcomment

proc getdescprompt
when quiet 1 call checkdescprompt
holding()
clearwhen quiet
endproc


#comment
********************************************************

CHECKDESCPROMPT()

Called by ulfile()

Calls endhold()

Checks for presense of the upload description prompt.
Sets promptstatus to 0 if the file already on the board.

********************************************************
#endcomment

proc checkdescprompt
string ULDescPrompt, DLUnavPrompt, CommandPrompt
string Confirm1Prompt, Confirm2Prompt, Confirm1, Confirm2
profilerd MailRun BBS "ULDescPrompt" ULDescPrompt
profilerd MailRun BBS "DLUnavPrompt" DLUnavPrompt
profilerd MailRun BBS "CommandPrompt" CommandPrompt
profilerd MailRun BBS "Confirm1Prompt" Confirm1Prompt
profilerd MailRun BBS "Confirm2Prompt" Confirm2Prompt
if findstring(prompt, ULDescPrompt)
foundstatus = 1
endhold()
elseif findstring(prompt, DLUnavPrompt) || \
findstring(prompt, "file # 1") || findstring(prompt, "file #1") || \
findstring(prompt, CommandPrompt)
foundstatus = 0
endhold()
elseif findstring(prompt, Confirm1Prompt)
profilerd MailRun BBS "Confirm1" Confirm1
transmit Confirm1
transmit "^M"
elseif findstring(prompt, Confirm2Prompt)
profilerd MailRun BBS "Confirm2" Confirm2
transmit Confirm2
transmit "^M"
elseif findstring(prompt, "file # 2") || findstring(prompt, "file #2") || \
findstring(prompt, "Keywords? [")
transmit "^M"
elseif findstring(prompt, "password protect") || \
findstring(prompt, "detailed") || findstring(prompt, "last download")
transmit "n^M"
elseif findstring(prompt, "after upload")
transmit "c^M"
elseif findstring(BBSType, "Auntie") && findstring(prompt, "private")
transmit "n^M"
endif
endproc


#comment
********************************************************

GOTULDLPROMPT()

Called by ulfile()

Releases the hold when the upload prompt is received.

********************************************************
#endcomment

proc gotuldlprompt
foundstatus = 1
endhold()
endproc


proc getotherprompt
intparm gotoplace
string FilePrompt
profilerd MailRun BBS "FilePrompt" FilePrompt
if !(findstring(prompt, FilePrompt)) && (gotoplace == GOTOFILE)
transmit "f^M"
elseif findstring(prompt, "FilePrompt") && (gotoplace == GOTOMAIN)
transmit "q^M"
endif
getcommandprompt()
endproc


#comment
********************************************************

HOLDING()

Called by various.

Stalls script while waiting for the result of a when
command. Sends script to next BBS if there is a
timeout, or if carrier is lost.

********************************************************
#endcomment

proc holding
string LastPrompt
IdleTimer = 1
holdstatus = 1
prompt = ""
xferstatus = $FILEXFER
while (IdleTimer < IdleTimeout) && (holdstatus == 1) && \
(xferstatus == 0) && $CARRIER
pause 1
termgets $ROW 0 prompt $COL
if not strcmp prompt LastPrompt
;if anything has been received, reset the timer
IdleTimer = 1
endif
LastPrompt = prompt
if !(IdleTimer % 15)
;Send a carriage return every 15 seconds
transmit "^M"
endif
IdleTimer++
xferstatus = $FILEXFER
endwhile
if (IdleTimer == IdleTimeout) || ($CARRIER == 0)
;If there has been a timeout, lost carrier or user escape...
clearwhen quiet
;set FailCode and get out
if IdleTimer == IdleTimeout
capturestr "`r`n`r`n***** Timed out waiting for prompt *****`r`n`r`n"
else
capturestr "`r`n`r`n************* Lost carrier *************`r`n`r`n"
endif
longjmp ErrorFail 1
endif
endproc


#comment
********************************************************

ENDHOLD()

Called by various.

Releases hold established by holding() and clears when
statements on target 0 and quiet.

********************************************************
#endcomment

proc endhold
holdstatus = 0
endproc


#comment
********************************************************

WAITXFER()

Called by sendmail(), getmail(), ulfile(), dlfile()

Stalls script until a file transfer has been completed.

********************************************************
#endcomment

proc waitxfer
xferstatus = $FILEXFER
while xferstatus == 1
xferstatus = $FILEXFER
endwhile
endproc


#comment
********************************************************

SENDMAIL()

Called by dobbs()

Calls getmailprompt(), holding(), waitxfer()

Uploads a *.REP packet for the current BBS.

********************************************************
#endcomment

proc sendmail
string MailULPrompt, MailXFerProt
string ReplyFile, ReplyDir
string Pending, temp
integer j
profilerd MailRun "MailRun" "ReplyDir" ReplyDir
ReplyFile = makefullname(ReplyDir, BBS)
strcat ReplyFile ".REP"
if isfile ReplyFile
;If there is a REP packet waiting...
if findstring(BBSType, "Auntie")
getcommandprompt()
getotherprompt(GOTOMAIN)
transmit "QMU^M"
elseif findstring(BBSType, "PCBoard") || findstring(BBSType, "Wildcat")
getmailprompt()
transmit "u^M"
endif
profilerd MailRun BBS "MailULPrompt" MailULPrompt
when target 0 MailULPrompt call endhold
holding()
clearwhen target 0
set upldpath ReplyDir
profilerd MailRun BBS "MailXFerProt" MailXFerProt
sendfile MailXFerProt ReplyFile
;Hold until the transfer starts
holding()
;Hold until the transfer finishes
waitxfer()
if xferstatus == 2
;If upload was successful...
;Rename the .REP packet as *.OLD
assign temp ReplyFile
strlen temp j
j -= 3
strupdt temp "OLD" j 3
delfile temp
rename ReplyFile temp
;Mark the Item as completed
Pending = "0"
else
;Otherwise, mark it as an error
Pending = "2"
capturestr "`r`n`r`n******* Error in File Transfer *******`r`n`r`n"
endif
else
Pending = "0"
endif
;Update the *.MRN file
strupdt Item Pending 0 1
endproc


#comment
********************************************************

GETMAIL()

Called by dobbs()

Calls getmailprompt(), holding(), waitxfer, cleardir(),
renameqwk(), checkmail()

Downloads a *.QWK packet for the current BBS.

********************************************************
#endcomment

proc getmail
string MailFile, MailDLDir, MailDLPrompt, MailXFerProt
string Pending, temp
if findstring(BBSType, "Auntie")
getcommandprompt()
getotherprompt(GOTOMAIN)
transmit "QMD^M"
elseif findstring(BBSType, "PCBoard") || findstring(BBSType, "Wildcat")
getmailprompt()
transmit "d^M"
;Wait for a prompt indicated presense of mail
when quiet 1 call checkmail
holding()
clearwhen quiet
if foundstatus == 0
Pending = "0"
strupdt Item Pending 0 1
return
endif
;If there is mail...
transmit "y^M"
endif
;Wait until asked to start the download
profilerd MailRun BBS "MailDLPrompt" MailDLPrompt
when target 0 MailDLPrompt call endhold
holding()
clearwhen target 0
;Download to the mail download directory
MailDLDir = makefullname(MailRunDir, "MAILDL")
mkdir MailDLDir
cleardir(MailDLDir)
set dnldpath MailDLDir
strfmt temp "%s.QWK" BBS
profilerd MailRun BBS "MailXFerProt" MailXFerProt
getfile MailXFerProt temp
;Hold until the transfer starts
holding()
;Hold until the transfer finishes
waitxfer()
if xferstatus == 2
;If the download was successful...
;Make sure the mail file has the ".QWK" extension.
;This complicated workaround is the only way I could
;figure out how to get the filename of a file that has
;just been downloaded.
temp = makefullname(MailDLDir, "*.*")
findfirst temp
temp = makefullname(MailDLDir, $FILENAME)
MailFile = makefullname(MailDLDir, BBS)
strcat MailFile ".QWK"
rename temp MailFile
;Renumber the QWK packets
renameqwk(MailFile)
;and mark it as completed
Pending = "0"
else
;Otherwise, mark the item as an error
Pending = "2"
capturestr "`r`n`r`n******* Error in File Transfer *******`r`n`r`n"
endif
;Delete the mail download directory
cleardir(MailDLDir)
chdir MailRunDir
rmdir MailDLDir
strupdt Item Pending 0 1
endproc


#comment
********************************************************

CHECKMAIL()

Called by getmail()

Calls endhold()

Checks prompt for presense of a mail packet.

********************************************************
#endcomment

proc checkmail
string ReceiveQWKPrompt, MailPrompt
profilerd MailRun BBS "ReceiveQWKPrompt" ReceiveQWKPrompt
profilerd MailRun BBS "MailPrompt" MailPrompt
if findstring(prompt, ReceiveQWKPrompt)
foundstatus = 1
endhold()
elseif findstring(prompt, MailPrompt)
foundstatus = 0
endhold()
endif
endproc


#comment
********************************************************

RENAMEQWK()

Called by getmail()

Renames QWK packets after a successful mail download.

********************************************************
#endcomment

proc renameqwk
strparm MailFile
string OldMail1, OldMail2, MailDir
string char
integer i, j
profilerd MailRun "MailRun" "MailDir" MailDir
OldMail2 = makefullname(MailDir, BBS)
profilerd MailRun "MailRun" "SavePackets" i
;max of 10 packets
if i > 10
i = 10
endif
i -= 1
if i > 0
strfmt OldMail2 "%s.QW%d" OldMail2 i
elseif i == 0
strfmt OldMail2 "%s.QW0" OldMail2
else
strfmt OldMail2 "%s.QWK" OldMail2
endif
;Delete oldest file
delfile OldMail2
assign OldMail1 OldMail2
strlen OldMail1 j
j -= 1
while i > 0
i--
itoa i char
strupdt OldMail1 char j 1
;Rename the second oldest as the oldest
rename OldMail1 OldMail2
;Rotate filenames
assign OldMail2 OldMail1
endwhile
if i == 0
;if the oldest is QW0...
strupdt OldMail1 "K" j 1
rename OldMail1 OldMail2
assign OldMail2 OldMail1
endif
delfile OldMail2
copyfile MailFile OldMail1
delfile MailFile
endproc


#comment
********************************************************

ULFILE()

Called by dobbs()

Calls getconfprompt(), getcommandprompt(), openerror(),
holding(), waitxfer(), checkdescprompt(), gotulprompt()

Uploads a file to the current BBS.

********************************************************
#endcomment

proc ulfile
string UDXString, UDXFile, MRunUDX, MRunUBF
string Pending, CapMsg, ULPrompt, UploadDir, XFerProt
string DB, DL
integer char
long DescBegin, DescLength
long counter
Pending = "2"
strextract FileName Item "," 3
strextract Conf item "," 4
MRunUDX = makefullname(MailRunDir, "MAILRUN.UDX")
MRunUBF = makefullname(MailRunDir, "MAILRUN.UBF")
if checkfile(MRunUDX) && checkfile(MRunUBF)
;Change conferences if necessary
getcommandprompt()
if !(findstring(BBSType, "Auntie"))
getconfprompt()
endif
if !(findstring(BBSType, "PCBoard"))
getotherprompt(GOTOFILE)
endif
if findstring(BBSType, "WildCat")
transmit "u^M"
getdescprompt()
elseif findstring(BBSType, "PCBoard") || findstring(BBSType, "Auntie")
transmit "u;"
endif
transmit FileName
transmit "^M"
;Check whether file is already on the board
getdescprompt()
if foundstatus == 1
;If the file is not on the board, send a description
interfaceoff()
fopen MRunUBFFile MRunUBF READ
openerror(MRunUBF)
fopen MRunUDXFile MRunUDX READ TEXT
openerror(MRunUDX)
fgets MRunUDXFile UDXString
strextract UDXFile UDXString "`t" 0
while not strcmpi UDXFile FileName
fgets MRunUDXFile UDXString
strextract UDXFile UDXString "`t" 0
endwhile
strextract DB UDXString "`t" 4
strextract DL UDXString "`t" 5
atol DB DescBegin
atol DL DescLength
if findstring(BBSType, "WildCat")
if DescLength > 60
DescLength = 60
endif
endif
fseek MRunUBFFile DescBegin 0
for counter = 1 upto DescLength
fgetc MRunUBFFile char
computc char
endfor
fclose MRunUBFFile
fclose MRunUDXFile
interfaceon()
transmit "^M"
if !findstring(BBSType, "WildCat")
transmit "^M"
endif
if findstring(BBSType, "Auntie")
getverifyprompt()
endif
profilerd MailRun BBS "ULPrompt" ULPrompt
when target 0 ULPrompt call gotuldlprompt
getdescprompt()
clearwhen target 0
xferstatus = 1
profilerd MailRun "MailRun" "UploadDir" UploadDir
set upldpath UploadDir
profilerd MailRun BBS "XFerProt" XFerProt
sendfile XFerProt FileName
;Wait until the transfer starts
holding()
;Wait until the transfer finishes
waitxfer()
if xferstatus == 2
;If the download was successful...
;Mark as completed
Pending = "0"
else
;Otherwise, mark as an error
capturestr "`r`n`r`n******* Error in File Transfer *******`r`n`r`n"
endif
else
;If the file was already on the board
;Send a carriage return to get the prompt back
transmit "^M"
endif
else
strfmt capmsg "`r`n`r`n*** Unable to upload %s. Missing .UBF \
or .UDX file. ***`r`n`r`n" FileName
capturestr capmsg
endif
strupdt Item Pending 0 1
endproc


proc getverifyprompt
when quiet 1 call checkverifyprompt
holding()
clearwhen quiet
endproc


proc checkverifyprompt
if findstring(prompt, "editor function")
transmit "s^M"
elseif findstring(prompt, "category")
transmit Conf
transmit ";y;n^M"
endhold()
endif
endproc


#comment
********************************************************

DLFILE()

Called by dobbs()

Calls getconfprompt(), getcommandprompt(), holding(),
putdesc(), dlfileyes(), dlfileno()

Downloads a file from the current BBS.

********************************************************
#endcomment

proc dlfile
string Pending, DLPrompt, DownloadDir, XFerProt
strextract FileName Item "," 3
strextract Conf Item "," 4
;Change conferences if necessary
getcommandprompt()
if !(findstring(BBSType, "Auntie"))
getconfprompt()
endif
if !(findstring(BBSType, "PCBoard"))
getotherprompt(GOTOFILE)
endif
if findstring(BBSType, "WildCat")
transmit "d^M"
getdescprompt()
elseif findstring(BBSType, "PCBoard") || findstring(BBSType, "Auntie")
transmit "d;"
endif
transmit FileName
transmit "^M"
;Check whether file is available for d/l
profilerd MailRun BBS "DLPrompt" DLPrompt
when target 0 DLPrompt call gotuldlprompt
getdescprompt()
clearwhen target 0
if foundstatus == 1
;If it is available...
profilerd MailRun "MailRun" "DownloadDir" DownloadDir
set dnldpath DownloadDir
profilerd MailRun BBS "XFerProt" XFerProt
getfile XFerProt FileName
;Wait until the transfer starts
holding()
;Wait until the transfer finishes
waitxfer()
if xferstatus == 2
;If the download was successful...
putdesc()
;Mark as completed
Pending = "0"
else
;Otherwise, mark as an error
Pending = "2"
capturestr "`r`n`r`n******* Error in File Transfer *******`r`n`r`n"
endif
else
;If file was unavailable, mark as error.
Pending = "2"
;Send a return to get the prompt back.
transmit "^M"
endif
strupdt Item Pending 0 1
endproc


#comment
********************************************************

PUTDESC()

Called by dlfile()

Calls openerror()

Searches the BBSs .IDX file for a file description and
copies the description from the .DBF file to the uplaod
files database. If no description is found, a line
including the file name, size and date is put in the
upload files index.

********************************************************
#endcomment

proc putdesc
string DB, DL, idxString, MRunUDX, MRunUBF, DownloadDir
string idxFile, idxDesc, FileDate, FullFileName
integer inidx, char
long DescBegin, DescLength, counter, FileSize
interfaceoff()
;Determine whether the BBS index and database files exist
BBSidx = makefullname(MailRunDir, BBS)
strcat BBSidx ".IDX"
BBSdbf = makefullname(MailRunDir, BBS)
strcat BBSdbf ".DBF"
inidx = 0
if checkfile(BBSidx) && checkfile(BBSdbf)
;If both files exist...
fopen BBSidxFile BBSidx READ TEXT
openerror(BBSidx)
fgets BBSidxFile idxString
while not feof BBSidxFile
;Loop through the index file and stop if the file is found
strextract idxFile idxString "`t" 0
if strcmpi FileName idxFile
inidx = 1
exitwhile
endif

fgets BBSidxFile idxString
endwhile
fclose BBSidxFile
endif
strlwr FileName
;Get the file size and date
profilerd MailRun "MailRun" "DownloadDir" DownloadDir
FullFileName = makefullname(DownloadDir, FileName)
getfsize FullFileName FileSize
getfdate FullFileName FileDate
;Determine whether the upload index and database files exist
MRunUDX = makefullname(MailRunDir, "MAILRUN.UDX")
MRunUBF = makefullname(MailRunDir, "MAILRUN.UBF")
if checkfile(MRunUBF) && checkfile(MRunUDX)
;If both files exist, open them
fopen MRunUBFFile MRunUBF READWRITE
openerror(MRunUBF)
fopen MRunUDXFile MRunUDX READWRITE
openerror(MRunUDX)
else
;Otherwise, create them
fopen MRunUBFFile MRunUBF CREATE
openerror(MRunUBF)
fopen MRunUDXFile MRunUDX CREATE
openerror(MRUNUDX)
endif
fseek MRunUDXFile 0 2
if inidx == 1
;If the file was found in the BBS index...
strextract idxDesc idxString "`t" 3
;Get the descriptions starting point and length...
strextract DB idxString "`t" 4
strextract DL idxString "`t" 5
atol DB DescBegin
atol DL DescLength
fopen BBSdbfFile BBSdbf READ
fseek BBSdbfFile DescBegin 0
fseek MRunUBFFile 0 2
ftell MRunUBFFile DescBegin
;And copy each character of the description to the upload database
for counter = 1 upto DescLength
fgetc BBSdbfFile char
;Substitute a space for nonprinting characters
if ((char >= 0x20) && (char <= 0x7E)) || \
((char >= 0xA0) && (char <= 0xFE))
fputc MRunUBFFile char
else
fputc MrunUBFFile ' '
endif
endfor
fclose BBSdbfFile
;Format the upload index entry
fstrfmt MRunUDXFile "%s`t%ld`t%s`t%s`t%ld`t%ld`r`n" \
FileName FileSize FileDate idxDesc DescBegin DescLength
else
;If there was no entry in the BBS index...
;Format the upload index entry
fstrfmt MRunUDXFile "%s`t%ld`t%s`t`t0`t0`r`n" FileName FileSize FileDate
endif
fclose MRunUBFFile
fclose MRunUDXFile
interfaceon()
endproc


#comment
********************************************************

SENDCOMMAND()

Called by dobbs()

Calls getconfprompt(), holding()

Sends commands to the current BBS. A command item may
contain multiple command lines separated by a vertical
bar. The script will send these one at a time, waiting
until the terminal has been quiet for 15 seconds before
sending the next one. The command must return the user
to the Main Command Prompt, or be the last item for the
BBS.

********************************************************
#endcomment

proc sendcommand
string CommandLine
integer j
getcommandprompt()
if !(findstring(BBSType, "PCBoard"))
getotherprompt(GOTOMAIN)
endif
strextract Command Item "," 3
j = 0
strextract CommandLine Command "|" j
while not NULLSTR CommandLine
if j != 0
when quiet 10 call endhold
holding()
clearwhen quiet
endif
transmit CommandLine
transmit "^M"
j++
strextract CommandLine Command "|" j
endwhile
strupdt Item "0" 0 1
endproc


#comment
********************************************************

SENDSCRIPT()

Called by dobbs()

Calls getconfprompt(), mailrunbox()

Executes a script file. The script must return to the
Main Command Prompt, or be the last item for that BBS.

********************************************************
#endcomment

proc sendscript
getcommandprompt()
if !(findstring(BBSType, "PCBoard"))
getotherprompt(GOTOMAIN)
endif
strextract ScriptName Item "," 3
execute ScriptName
strupdt Item "0" 0 1
mailrunbox()
endproc


#comment
********************************************************

LOGOFF()

Called by dobbs()

Logs off the current BBS.

********************************************************
#endcomment

proc logoff
integer i = 1
if $CARRIER
transmit "g^M"
endif
pause 5
while $CARRIER && (i < 3)
hangup
pause 5
i++
endwhile
endproc


#comment
********************************************************

PARSEDIALOG()

Called by main()

Calls cleanup(), mailrunbox(), executor(), newmailrun(),
resetmailrun(), maketasklist(), makebbslist(), addbbs(),
getfirstitem(), checkmrunstatus(), loadsettings(),
callscript(), changestatus(), changemailrun()

Checks for dialog box selection and dispatches the
appropriate task.

********************************************************
#endcomment

proc parsedialog
integer dialogstatus
dialogstatus = $DIALOG
if dialogstatus == 10
;User double clicked on an item
changestatus()
makequeue()
updatedlg 16
endif
endproc


#comment
********************************************************

MAILRUNBOX()

Called by main(), parsedialog(), callscript(), executor(),
sendscript()

Draws the main MailRun dialog box.

********************************************************
#endcomment

proc mailrunbox
destroydlg
assign MainBoxTabs "20,30,220,230,233,236,239,242"
HelpPage = 2
dialogbox 8 36 346 181 15 "MailRun" HELPID HelpPage
groupbox 10 33 228 135 "Task List" shadow
flistbox 15 52 218 102 TaskList MainBoxTabs single TaskItem
text 15 153 49 8 left "# = permanent"
text 76 153 49 8 left "¤ = temporary"
text 140 153 33 8 left "! = error"
text 182 153 53 8 left "@ = completed"
groupbox 244 33 90 135 "Statistics" shadow
text 248 55 62 8 right "BBSs in mailrun:"
text 248 69 62 8 right "BBSs completed:"
text 248 83 62 8 right "BBSs left to call:"
text 248 97 62 8 right "Items in mailrun:"
text 248 111 62 8 right "Items completed:"
text 248 125 62 8 right "Item errors:"
text 248 139 62 8 right "Items remaining:"
text 248 153 62 8 right "Dialing Attempt:"
vtext 314 55 16 9 left BBSTotal
vtext 314 69 16 9 left BBSComplete
vtext 314 83 16 9 left BBSRemaining
vtext 314 97 16 9 left ItemTotal
vtext 314 111 16 9 left ItemComplete
vtext 314 125 16 9 left ItemError
vtext 314 139 16 9 left ItemRemaining
vtext 314 153 16 9 left AttemptNum
text 102 14 74 8 right "The current mailrun is:"
combobox 180 12 76 41 MailRunList MailRunTrunc sort
pushbutton 0 0 0 0 " &t" normal default
enddialog
disable CTRL 170
endproc



  3 Responses to “Category : Communication (modem) tools and utilities
Archive   : MRUN200.ZIP
Filename : MRUN200G.WAS

  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/