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

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

#define MRUN200D
#include "mrun200.h"

string DXFileTabs, BBSidx, BBSdbf
integer DLSortField

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

MAIN()

Calls checkchild(), checkperm(), makebbslist(), makedesc(),
maketasklist(), getfilenames(), getbbsi(), getitemi(),
getbbscoord(), getitemcoord(), getnewfiles(), gettaskstring(),
openerror(), dlfilebox(), deldlfile(), insertitem(),
menudim(), makefullname(), interfaceon(), clearfiledesc(),
import(), importwarning(), sortidx()

Adds a GetFile item to the mailrun.

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

proc main
string dlfileString, statstring, ImportFile
string Perm
integer dialogstatus
integer i, j
menudim()
checkchild()
getfilenames()
findfirst MailRun
MailRunTrunc = $FILENAME

;Set up variables for the dlfilebox
assign DXFileTabs "58,92,130,305,315,319,322,325,328"
i = getbbsi()
j = getitemi()
profilerd MailRun "MailRun" "MailDir" MailDir
profilerd MailRun "MailRun" "DLSortField" DLSortField
profilerd MailRun BBS "QWKArchiver" QWKArchiver
profilerd MailRun "MailRun" "Archiver" Archiver
profilerd MailRun "MailRun" "QWKReader" QWKReader
profilerd MailRun "MailRun" "LogViewer" LogViewer
makebbslist()
BBSdbf = makefullname(MailRunDir, BBS)
strcat BBSdbf ".DBF"
BBSidx = makefullname(MailRunDir, BBS)
strcat BBSidx ".IDX"

;Update the available files database
clearfiledesc()
FileName = ""
dlfilebox()
getnewfiles()
updatedlg 16
dialogstatus = $DIALOG
while dialogstatus != 1
switch dialogstatus
case 10
;User selected "Add"
if not NULLSTR FileName
;only add request if a filename has been entered
strupr FileName
Perm = checkperm()
strfmt dlfileString "1,%s,GetFile,%s,%s" Perm FileName Conf
strfmt statstring \
"Added to %s: `"Download %s from Conference %s`"" \
BBS FileName Conf
;Update MAILRUN.INI, task list
j++
insertitem(j, dlfileString)
gettaskstring(i, j)
statmsg statstring
endif
endcase
case 11
;User selected "Delete"
deldlfile()
FLAGS &= UNCHANGED
updatedlg 148
endcase
case 12
;User selected "Import"
;allow the user to abort operation if it will take too long
if importwarning()
sdlgfopen "Import File List" "*.LST" ImportFile
if SUCCESS
;if the user has selected a file to import...
interfaceoff()
statmsg "Updating database... 0 files added..."
import(ImportFile, 0)
sortidx(BBSidx, DLSortField)
statmsg ""
interfaceon()
updatedlg 16
endif
endif
endcase
case 13
;User selected "Purge"

;Set index and database files to zero length. Set display file
;to a space character. The latter is necessary becuase of an
;ASPECT bug that won't allow update of an ftext box if the
;displayed file is nonexistent or zero length.

fopen BBSidxFile BBSidx CREATE
openerror(BBSidx)
fopen BBSdbfFile BBSdbf CREATE
openerror(BBSdbf)
fclose BBSidxFile
fclose BBSdbfFile
clearfiledesc()
FileName = ""
FLAGS &= UNCHANGED
updatedlg 148
endcase
case 50
;User selected a new sort method
profilewr MailRun "MailRun" "DLSortField" DLSortField
sortidx(BBSidx, DLSortField)
updatedlg 16
endcase
case 130
;User selected a file from the index window
strextract FileName FileChoice "`t" 0
makedesc(BBSdbf)
FLAGS &= UNCHANGED
updatedlg 132
endcase
case 170
;User changed BBS with the combobox
i = getbbscoord()
j = getitemcoord()
TaskItem = gettaskstring(i, 0)
;Update the available files database
BBSdbf = makefullname(MailRunDir, BBS)
strcat BBSdbf ".DBF"
BBSidx = makefullname(MailRunDir, BBS)
strcat BBSidx ".IDX"
getnewfiles()
clearfiledesc()
FileName = ""
FLAGS &= UNCHANGED
updatedlg -1
endcase
case 230
;User entered a new file name
if !(FLAGS & CHANGED)
clearfiledesc()
FLAGS |= CHANGED
updatedlg 4
endif
endcase
endswitch
dialogstatus = $DIALOG
endwhile
statmsg ""
endproc


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

IMPORTWARNING()

Called by main()

If sorting or duplicate filter is set, warns that an
import operation may take a long time.

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

func importwarning : integer
string WarningMsg
integer Response
if (DLSortField != 1) && NewfileFilter
WarningMsg = "You have chosen to import a list of files with \
the duplicate file filter and sorting enabled. With large file \
lists, this may result in very slow performance.`r`n`r`nDo you \
wish to continue?"
elseif DLSortField != 1
WarningMsg = "You have chosen to import a list of files with \
sorting enabled. With large file \
lists, this may result in very slow performance.`r`n`r`nDo you \
wish to continue?"
elseif NewfileFilter
WarningMsg = "You have chosen to import a list of files with \
the duplicate file filter enabled. With large file \
lists, this may result in very slow performance.`r`n`r`nDo you \
wish to continue?"
else
return 1
endif
sdlgmsgbox "MailRun Message" WarningMsg QUESTION YESNO Response 2
switch Response
case 6
return 1
endcase
case 7
return 0
endcase
endswitch
endfunc


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

GETNEWFILES()

Called by main()

Calls openerror(), interfaceon(), interfaceoff(), checkfile()
makefullname(), import(), sortidx()

Extracts NEWFILES.DAT from a BBS .QWK packet. This is
used to update an index file, BBS.IDX, and a database of
descriptions, BBS.DBF, where "BBS" is the BBS ID. The
first line of each file description in NEWFILES.DAT is
converted to a tab delimited string containing the file's
name, size, date and partial description. The starting
point of the full description in the database and the
length of the description are appended and the entire
string is appended to the index file. Tabstops in the
index flistbox in dlfilebox() allow push the index and
length beyond the right edge of the box. The full
description of each file is appended to the database file.

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

proc getnewfiles
string QWKFile, NewFiles
string MRUnarcBat, Drive
integer ArcId, FirstPass, NumFiles
integer i, n
long QWKTime, IDXTime
interfaceoff()
QWKFile = makefullname(MailDir, BBS)
strcat QWKFile ".QWK"

;Only update the database if there is a more recent
;QWK file for the BBS

if isfile QWKFile
getfltime QWKFile QWKTime
else
QWKTime = 0
endif

;If the database files don't exist, create them.
if checkfile(BBSidx) && checkfile(BBSdbf)
;If both the index and database files exist, open them
getfltime BBSidx IDXTime
fopen BBSidxFile BBSidx READWRITE
openerror(BBSidx)
fopen BBSdbfFile BBSdbf READWRITE
openerror(BBSdbf)
else
;If either the index or database file is missing, start from scratch
IDXTime = 0
fopen BBSidxFile BBSidx CREATE
openerror(BBSidx)
fopen BBSdbfFile BBSdbf CREATE
openerror(BBSdbf)
endif
profilerd MailRun "MailRun" "SavePackets" n
profilerd MailRun "MailRun" "NewfileFilter" NewfileFilter
FirstPass = 1
NumFiles = 0
i = 0
while (QWKTime > IDXTime) && (i <= n)
if FirstPass
statmsg "Updating database... 0 files added..."
FirstPass = 0
endif

;Set up the unarchive command string and run it.

NewFiles = makefullname(TempDir, "NEWFILES.DAT")
if isfile NewFiles
delfile NewFiles
endif
MRUnarcBat = makefullname(TempDir, "MRUnarc.BAT")
fopen MRUnarcFile MRUnarcBat CREATE
openerror(MRUnarcBat)
substr Drive TempDir 0 2
fstrfmt MRunarcFile "%s`r`ncd %s`r`n" Drive TempDir
switch QWKArchiver
case "ARJ.EXE"
case "LHA.EXE"
case "LHARC.EXE"
fstrfmt MRUnarcFile "%s e %s NEWFILES.DAT`r`n" \
QWKArchiver QWKFile
endcase
case "PKUNZIP.EXE"
case "PKXARC.EXE"
fstrfmt MRUnarcFile "%s %s NEWFILES.DAT`r`n" \
QWKArchiver QWKFile
endcase
case "ZOO.EXE"
fstrfmt MRUnarcFile "%s -extract NEWFILES.DAT" \
QWKArchiver QWKFile
endcase
endswitch
fclose MRUnarcFile
run MRUnarcBat MINIMIZED ArcId
;Stall the script until unzipping is complete
while istask ArcId
endwhile
import(NewFiles, &NumFiles)
QWKFile = makefullname(MailDir, BBS)
strfmt QWKFile "%s.QW%d" QWKFile i
if isfile QWKFile
getfltime QWKFile QWKTime
else
QWKTime = 0
endif
i++
endwhile
if NumFiles
sortidx(BBSidx, DLSortField)
endif
interfaceon()
statmsg ""
endproc


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

IMPORT()

Called by main(), getnewfiles()

Calls openerror(), checknfstring()

Imports a file list into the download files database.

Assumes the format is that appropriate for the BBS type
for the current BBS.

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

proc import
strparm NewFiles
intparm NumFiles
string UpdateMsg
string NewFileString, NewFileName
string FileDate, FileSize, NewFileDate, NewFileSize
string idxFile, idxString
string Month, Day, Year, ThisYear
string dbfString
integer MM, DD, YY, TY
integer inidx
integer NewFileLength
long dbfIndex, dbfLength, LineEnd
;make sure the file exists before opening it
if isfile NewFiles
fopen NewFilesFile NewFiles READ TEXT
openerror(NewFiles)
if checkfile(BBSidx) && checkfile(BBSdbf)
;If both the index and database files exist, open them
fopen BBSidxFile BBSidx READWRITE
openerror(BBSidx)
fopen BBSdbfFile BBSdbf READWRITE
openerror(BBSdbf)
else
;If either the index or database file is missing, start from scratch
fopen BBSidxFile BBSidx CREATE
openerror(BBSidx)
fopen BBSdbfFile BBSdbf CREATE
openerror(BBSdbf)
endif
;Go to the end of the description database
fseek BBSdbfFile 0 2

;Loop through each line of the file list checking for a valid date
;in the position appropriate for the current BBS type. If one is
;found, it can be assumed this is the first line of a file
;description. Files older than 1980 and post-dated files are
;ignored.

fgets NewFilesFile NewFileString
while not feof NewFilesFile
;loop through the file
profilerd MailRun BBS "BBSType" BBSType
if strfind BBSType "PCBoard"
substr Month NewFileString 23 2
substr Day NewFileString 26 2
substr Year NewFileString 29 2
elseif strfind BBSType "WildCat"
substr Month NewFileString 24 2
substr Day NewFileString 27 2
substr Year NewFileString 30 2
elseif strfind BBSType "Auntie"
substr Month NewFileString 21 2
substr Day NewFileString 24 2
substr Year NewFileString 27 2
endif
atoi Month MM
atoi Day DD
atoi Year YY
ThisYear = $DATE
strdelete ThisYear 0 6
atoi ThisYear TY
if (MM >= 1 && MM <= 12) && (DD >= 1 && DD <= 31) && \
(YY >= 80 && YY <= TY)
;If there is a valid date in the correct position...
;Put in tab separators
strupdt NewFileString "`t" 12 1
if strfind BBSType "PCBoard"
strupdt NewFileString "`t" 21 1
strupdt NewFileString "`t" 31 1
elseif strfind BBSType "WildCat"
strupdt NewFileString "`t" 21 1
strupdt NewFileString "`t" 32 1
strdelete NewFileString 33 1
elseif strfind BBSType "Auntie"
strupdt NewFileString "`t" 20 1
strupdt NewFileString "`t" 29 1
endif

;Strip extra spaces
strfind NewFileString "`t "
while FOUND
strreplace NewFileString "`t " "`t"
strfind NewFileString "`t "
endwhile
strfind NewFileString " `t"
while FOUND
strreplace NewFileString " `t" "`t"
strfind NewFileString " `t"
endwhile

if strfind BBSType "WildCat"
;remove commas from file size
strextract FileSize NewFileString "`t" 1
NewFileSize = FileSize
strreplace NewFileSize "," ""
strreplace NewFileString FileSize NewFileSize 1
elseif findstring(BBSType, "PCBoard") || \
findstring(BBSType, "Auntie")
;change date format from MM-DD-YY to MM/DD/YY
strextract FileDate NewFileSTring "`t" 2
NewFileDate = FileDate
strreplace NewFileDate "-" "/"
strreplace NewFileString FileDate NewFileDate 1
if strfind BBSType, "Auntie"
strextract FileDate NewFileString "`t" 0
NewFileDate = FileDate
strreplace NewFileDate " " "." 1
strfind NewFileDate ". "
while FOUND
strreplace NewFileDate ". " "."
strfind NewFileDate ". "
endwhile
strreplace NewFileString FileDate NewFileDate 1
endif
endif
strextract NewFileName NewFileString "`t" 0
if NewfileFilter
;If the newfile filter is turned on...
inidx = 0
rewind BBSidxFile
fgets BBSidxFile idxString
while not feof BBSidxFile
;Check the filename against each file in the index
strextract idxFile idxString "`t" 0
if strcmpi idxFile NewFileName
inidx = 1
exitwhile
endif
fgets BBSidxFile idxString
endwhile
if inidx
;If the file is in the index, drop it
fgets NewFilesFile NewFileString
loopwhile
endif
endif
fseek BBSidxFile 0 2
NumFiles++
strfmt UpdateMsg \
"Updating database... %d files added... %s" \
NumFiles NewFileName
statmsg UpdateMsg
strlwr NewFileName
strlen NewFileName NewFileLength
strupdt NewFileString NewFileName 0 NewFileLength
;Append the index
ftell BBSdbfFile dbfIndex
strfmt NewFileString "%s`t%ld" NewFileString dbfIndex
fputs BBSidxFile NewFileString
;Get the first line of the description and put it in
;the database
strextract dbfString NewFileString "`t" 3
fstrfmt BBSdbfFile "%s`r`n" dbfString
;Auntie lists have a blank line before the description
if strfind BBSType "Auntie"
fgets NewFilesFile NewFileString
endif
fgets NewFilesFile NewFileString
;Get remaining lines of description
while checknfstring(&NewFileString)
fstrfmt BBSdbfFile "%s`r`n" NewFileString
fgets NewFilesFile NewFileString
endwhile

;Find the length of the description and append to the index file

ftell BBSdbfFile dbfLength
dbfLength -= dbfIndex
fstrfmt BBSidxFile "`t%ld" dbfLength
#comment
;Pad the line to 100 characters for the sort routine
ftell BBSidxFile LineEnd
while ((LineEnd + 3) % 100) - 1
fputc BBSidxFile ' '
ftell BBSidxFile LineEnd
endwhile
#endcomment
fputs BBSidxFile "`r`n"
else
;If this isn't a file description, get the next line
fgets NewFilesFile NewFileString
endif
endwhile
fclose NewFilesFile
fclose BBSidxFile
fclose BBSdbfFile
endif
endproc


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

CHECKNFSTRING()

Called by import()

Checks a string for the format appropriate for a
description line. If it is a proper description line
the line is formatted and a value of 1 is returned.
If it is not proper, a value of 0 is returned.

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

func checknfstring : integer
strparm NewFileString
string Blanks
integer i
if strfind BBSType "PCBoard"
strset blanks ' ' 33
if rstrcmp blanks NewFileString 33
strdelete NewFileString 0 33
return 1
endif
elseif strfind BBSType "WildCat"
strpeek NewFileString 33 i
if i == '|'
strdelete NewFileString 0 35
return 1
endif
elseif strfind BBSType "Auntie"
strset blanks ' ' 9
if rstrcmp blanks NewFileString 9
strdelete NewFileString 0 9
return 1
endif
endif
return 0
endfunc


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

DELDLFILE()

Called by main()

Calls openerror(), interfaceon(), interfaceoff(),
makedesc(), clearfiledesc()

Deletes a file from the BBS's download index and selects
the next file in the list.

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

proc deldlfile
string OldBBSidx, idxFile, idxString
interfaceoff()
OldBBSidx = makefullname(TempDir, "OLIDX.TMP")
copyfile BBSidx OldBBSidx
fopen OldidxFile OldBBSidx READ TEXT
openerror(OldBBSidx)
fopen BBSidxFile BBSidx CREATE TEXT
openerror(BBSidx)
fgets OldidxFile idxString
while not feof OldidxFile
strextract idxFile idxString "`t" 0
if strcmpi idxFile FileName
exitwhile
endif
fputs BBSidxFile idxString
fgets OldidxFile idxString
endwhile
fgets OldidxFile idxString
FileChoice = idxString
while not feof OldidxFile
fputs BBSidxFile idxString
fgets OldidxFile idxString
endwhile
if NULLSTR FileChoice
fseek BBSidxFile -100 2
fgets BBSidxFile FileChoice
endif
fclose BBSidxFile
fclose OldidxFile
if not NULLSTR FileChoice
strextract FileName FileChoice "`t" 0
makedesc(BBSdbf)
else
clearfiledesc()
FileName = ""
endif
interfaceon()
endproc


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

DLFILEBOX()

Called by main()

Displays the Download Files dialog box.

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

proc dlfilebox
PermRadio = 2
assign Conf "0"
destroydlg
HelpPage = 9
dialogbox 19 38 324 201 15 "Download Files" HELPID HelpPage
text 12 27 56 8 left "Filename"
text 70 27 40 8 left "Size"
text 104 27 34 8 left "Date"
text 142 27 117 8 left "Description"
flistbox 12 38 300 50 BBSidx DXFileTabs single FileChoice
groupbox 12 89 300 17
radiobutton 26 94 60 11 "Unsorted" DLSortField
radiobutton 91 94 67 11 "Sort by Name"
radiobutton 172 94 61 11 "Sort by Size"
radiobutton 241 94 62 11 "Sort by Date" endgroup
text 13 112 49 8 left "Filename:"
editbox 12 122 101 12 FileName
text 129 112 67 8 left "Description:"
ftext 129 122 182 50 FileDesc
text 14 149 78 8 right "D/L from Conference:"
editbox 96 147 16 12 Conf
radiobutton 12 178 53 13 "Permanent" PermRadio
radiobutton 70 178 54 13 "Temporary" endgroup
pushbutton 130 179 30 14 "&Add" normal default
pushbutton 168 179 30 14 "De&lete" normal
pushbutton 206 179 30 14 "&Import" normal
pushbutton 244 179 30 14 "&Purge" normal
pushbutton 282 179 30 14 "&Done" cancel
text 76 9 80 8 right "Download File from:"
combobox 160 7 70 42 BBSList BBS sort
enddialog
endproc





  3 Responses to “Category : Communication (modem) tools and utilities
Archive   : MRUN200.ZIP
Filename : MRUN200D.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/