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

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

#define MRUN200E
#include "mrun200.h"

string DXFileTabs, OldUDX, OldUBF
string LastChoice
integer InULDir, ULSortField

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

MAIN()

Calls checkchild(), checkudx(), updateudx(), openerror(),
getfilenames(), getbbsi(), getitemi(), getulfiles(),
getbbscoord(), getitemcoord(), gettaskstring(),
makebbslist(), ulfilebox(), insertulfile(), delulfile(),
menudim(), makefullname(), sortidx(), checkfile(),
clearfiledesc()

Adds a SendFile item to the mailrun. An feditbox is
used to display the file description in order to take
advantage of wordwrap. The flistbox displays the
contents of MAILRUN.UDX, which contains information on
any file downloaded by MailRun, plus additional files
found in the upload directory. A file description must
be at least 30 characters, but may be as long as needed.

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

proc main
string LastUDX, LastUBF
integer dialogstatus
integer i, j
menudim()
checkchild()
getfilenames()
findfirst MailRun
MailRunTrunc = $FILENAME
assign DXFileTabs "58,92,130,305,315,319,322,325,328"
profilerd MailRun "MailRun" "UploadDir" UploadDir
profilerd MailRun "MailRun" "DownloadDir" DownloadDir
profilerd MailRun "MailRun" "ULSortField" ULSortField
profilerd MailRun "MailRun" "Archiver" Archiver
profilerd MailRun "MailRun" "QWKReader" QWKReader
profilerd MailRun "MailRun" "LogViewer" LogViewer
i = getbbsi()
j = getitemi()
OldUDX = makefullname(TempDir, "OLDUDX.TMP")
OldUBF = makefullname(TempDir, "OLDUBF.TMP")
LastUDX = makefullname(MailRunDir, "MAILRUN.UDX")
LastUBF = makefullname(MailRunDir, "MAILRUN.UBF")
MRunUDX = makefullname(TempDir, "MAILRUN.UDX")
MRunUBF = makefullname(TempDir, "MAILRUN.UBF")
if isfile FileDesc
delfile FileDesc
endif
if isfile MRunUDX
delfile MRunUDX
endif
if isfile MRunUBF
delfile MRunUBF
endif
copyfile LastUDX MRunUDX
copyfile LastUBF MRunUBF
if not (checkfile(MRunUDX) && checkfile(MRUNUBF))
getulfiles()
endif
LastChoice = ""
FLAGS &= UNCHANGED
interfaceon()
makebbslist()
ulfilebox()
dialogstatus = $DIALOG
while dialogstatus != 1
switch dialogstatus
case 10
;User selected "Add"
insertulfile(&j)
endcase
case 11
;User selected "Save"
if FLAGS & CHANGED
updateudx()
FLAGS &= UNCHANGED
updatedlg -1
endif
endcase
case 12
;User selected "Delete"
delulfile()
endcase
case 13
;User selected "Refresh"
statmsg "Refreshing Uploads List from Upload Directory..."
getulfiles()
updatedlg -1
statmsg ""
endcase
case 50
;User selected a sort radiobutton
profilewr MailRun "MailRun" "ULSortField" ULSortField
sortidx(MRunUDX, ULSortField)
updatedlg 16
endcase
case 130
;User selected a file from the listbox
if checkchanged()
getnewdesc()
updatedlg 137
else
FileChoice = LastChoice
updatedlg 16
endif
endcase
case 170
;User changed BBSs with the combobox
i = getbbscoord()
j = getitemcoord()
TaskItem = gettaskstring(i, 0)
endcase
case 230
;User entered a name in the File Name box
if !(FLAGS & CHANGED)
clearfiledesc()
FLAGS |= CHANGED
updatedlg 8
endif
endcase
case 250
;User entered a file description
if !(FLAGS & CHANGED)
FLAGS |= CHANGED
endif
endcase
endswitch
dialogstatus = $DIALOG
endwhile
delfile LastUDX
delfile LastUBF
copyfile MRunUDX LastUDX
copyfile MRunUBF LastUBF
endproc


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

INSERTULFILE()

Called by main()

Calls checkperm(), openerror(), updateudx(), insertitem(),
interfaceon(), interfaceoff(), makefullname(), checkudx(),
clearfiledesc(), wildcatdl()

Adds a SendFile item to the *.MRN file and the task list.

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

proc insertulfile
intparm j
string ULDescString, ULFileString, FullFileName
string ULFileSpec, Perm
string StatString, CopyboxMsg
integer ULDescLength
integer Response, InUDX
interfaceoff()
if NULLSTR FileName
;User hasn't selected a file
usermsg "You must select a file first."
return
endif
if InUlDir == 0
strupr FileName
strfmt CopyBoxMsg \
"%s is not in the Upload Directory.`r`nCopy it now?" \
FileName
strlwr FileName
sdlgmsgbox "MailRun Message" CopyBoxMsg QUESTION \
OKCANCEL Response 1
switch Response
case 1
;User selected "OK"
ULFileSpec = makefullname(DownloadDir, FileName)
dir ULFileSpec FullFileName
if NULLSTR FullFileName
return
endif
if not isfile FullFileName
sdlgmsgbox "MailRun Message" "No such file!" \
EXCLAMATION OK Response 1
return
endif
copyfile FullFileName UploadDir
if not strcmpi ULFileSpec FullFileName
;if the user chose a file other than the one specified
;get the name of the file
findfirst FullFileName
FileName = $FILENAME
strlwr FileName
;determine whether it is already in the uploads database
fopen MRunUDXFile MRunUDX READWRITE TEXT
openerror(MRunUDX)
InUDX = checkudx(FileName)
fclose MRunUDXFile
if InUDX == 0
;if it isn't in the uploads database, put it there
clearfiledesc()
FLAGS |= CHANGED
updateudx()
endif
endif
InULDir = 1
updatedlg -1
endcase
case 2
;User selected "Cancel"
return
endcase
endswitch
endif
;No description may be less than 30 characters
fopen FileDescFile FileDesc READ
openerror(FileDesc)
fread FileDescFile ULDescString 65 ULDescLength
fclose FileDescFile
if ULDescLength < 6
usermsg "Please enter a longer description."
elseif wildcatdl(ULDescString, ULDescLength)
;If everything is OK...
if FLAGS & CHANGED
;Add the new description to the database
updateudx()
FLAGS &= UNCHANGED
updatedlg 16
endif
Perm = checkperm()
strupr FileName
strfmt ULFileString \
"1,%s,SendFile,%s,%s" Perm FileName Conf
strfmt StatString \
"Added to %s: `"Upload %s to Conference %s`"" \
BBS FileName Conf
j++
insertitem(j, ULFileString)
strlwr FileName
statmsg StatString
endif
interfaceon()
endproc


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

WILDCATDL()

Called by insertulfile()

Calls findstring()

If the current BBS type is WildCat!, limits the upload
description length to 60 characters. Gives user an
opportunity to enter a new description if the current
one is too lone.

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

func wildcatdl : integer
strparm ULDescString
intparm ULDescLength
string ULMsg
integer Response
profilerd MailRun BBS "BBSType" BBSType
if !(findstring(BBSType, "WildCat") && (ULDescLength > 60))
return 1
else
substr ULDescString ULDescString 0 60
strfmt ULMsg "A WildCat! file description has a maximum length \
of 60 characters. The description for %s will be truncated to read:\
`r`n`r`n%s`r`n`r`nDo you wish to continue?" FileName ULDescString
sdlgmsgbox "MailRun Message" ULMsg QUESTION YESNO Response 2
switch Response
case 6
return 1
endcase
case 7
return 0
endcase
endswitch
endif
endfunc



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

DELULFILE()

Called by main()

Calls updateudx(), makefullname()

Deletes a file from the upload database index.

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

proc delulfile
string DelBoxMsg, FullFileName
integer Response
if not NULLSTR FileName
if InULDir == 1
;If the selected file is in the upload directory
strfmt DelBoxMsg "Delete file %s as well?" FileName
sdlgmsgbox "MailRun Message" DelBoxMsg QUESTION \
YESNOCANCEL Response 1
switch Response
case 2
;User selected "Cancel"
return
endcase
case 6
;User selected "Yes"
FullFileName = makefullname(UploadDir, FileName)
delfile FullFileName
case 7
;User selected "No"
killfile()
endcase
endswitch
else
killfile()
endif
FLAGS &= UNCHANGED
updatedlg -1
endif
endproc

proc killfile
string UDXString, UDXFile, temp
;Copy all but the new description to the new UDX file
copyfile MRunUDX OldUDX
fopen OldUDXFile OldUDX READ TEXT
openerror(OldUDX)
fopen MRunUDXFile MRunUDX CREATE TEXT
openerror(MRunUDX)
fgets OldUDXFile UDXString
while not feof OldUDXFile
;Read lines until the end of file or the current file
strextract UDXFile UDXString "`t" 0
if strcmpi UDXFile FileName
exitwhile
endif
fputs MRunUDXFile UDXString
fgets OldUDXFile UDXString
endwhile
fgets OldUDXFile UDXString
;get the new listbox selection
FileChoice = UDXString
while not feof OldUDXFile
fputs MRunUDXFile UDXString
fgets OldUDXFile UDXString
endwhile
if NULLSTR FileChoice
;if the deleted line was the last in the file
;back up one line and read it
fseek MRunUDXFile -100 2
fgets MRunUDXFile temp
while not NULLSTR temp
FileChoice = temp
fgets MRunUDXFile temp
endwhile
endif
if not NULLSTR FileChoice
getnewdesc()
else
FileName = ""
clearfiledesc()
endif
fclose OldUDXFile
fclose MRunUDXFile
delfile OldUDX
endproc

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

GETNEWDESC()

Called by main(), updateudx()

Calls makedesc(), makefullname()

Gets the file name and description from the index entry
and determines whether the file is in the upload directory.

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

proc getnewdesc
string FullFileName
LastChoice = FileChoice
strextract FileName FileChoice "`t" 0
FullFileName = makefullname(UploadDir, FileName)
if isfile FullFileName
InULDir = 1
else
InULDir = 0
endif
makedesc(MRunUBF)
endproc


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

GETULFILES()

Called by main()

Calls openerror(), checkudx(), checkfile(), padline()
interfaceon(), interfaceoff()

Updates the Upload directory file description database.

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

proc getulfiles
string FileSize, FileDate, FDesc, DescBegin, DescLength, UDXString
string ULFileFull, ULFileTrunc, FullFileName
long FS, DB, DL, NDB, counter
integer char
integer InUDX
interfaceoff()
if checkfile(MRunUDX) && checkfile(MRunUBF)
copyfile MRunUDX OldUDX
copyfile MRunUBF OldUBF
fopen OldUDXFile OldUDX READ TEXT
openerror(OLDUDX)
fopen OldUBFFile OldUBF READ
openerror(OldUBF)
else
fopen OldUDXFile OldUDX CREATE TEXT
openerror(OLDUDX)
fopen OldUBFFile OldUBF CREATE
openerror(OldUBF)
endif
fopen MRunUDXFile MRunUDX CREATE TEXT
openerror(MRunUDX)
fopen MRunUBFFile MRunUBF CREATE
openerror(MRunUBF)
fgets OldUDXFile UDXString
while not feof OldUDXFile
;loop through the old .UDX file
;extract all fields
strextract ULFileTrunc UDXString "`t" 0
strextract FileSize UDXString "`t" 1
strextract FileDate UDXString "`t" 2
strextract FDesc UDXString "`t" 3
strextract DescBegin UDXString "`t" 4
strextract DescLength UDXString "`t" 5
atol DescBegin DB
atol DescLength DL
ftell MRunUBFFile NDB
;go to the beginning of the file description
fseek OldUBFFile DB 0
;copy the description to the new .UBF file
for counter = 1 upto DL
fgetc OldUBFFile char
fputc MRunUBFFile char
endfor
;add the index line to the new .UDX file
fstrfmt MRunUDXFile "%s`t%s`t%s`t%s`t%ld`t%ld`r`n" \
ULFileTrunc FileSize FileDate FDesc NDB DL
;Pad the line to 100 characters for the sort routine
; padline()
fgets OldUDXFile UDXString
endwhile
;Add any new files found in the uploads directory
FullFileName = makefullname(UploadDir, "*.*")
findfirst FullFileName
while FOUND
;Loop through all files in the upload directory
assign ULFileTrunc $FILENAME
InUDX = checkudx(ULFileTrunc)
if InUDX == 0
ULFileFull = makefullname(UploadDir, ULFileTrunc)
getfsize ULFileFull FS
getfdate ULFileFull FileDate
strlwr ULFileTrunc
fstrfmt MRunUDXFile "%s`t%ld`t%s`t`t0`t0`r`n" \
ULFileTrunc FS FileDate
; padline()
endif
findnext
endwhile
fclose MRunUDXFile
fclose MRunUBFFile
fclose OldUDXFile
fclose OldUBFFile
delfile OldUDX
delfile OldUBF
interfaceon()
sortidx(MRunUDX, ULSortField)
endproc


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

PADLINE()

Called by getulfiles(), updateudx

Pads a line of an open file to 100 characters.

********************************************************

proc padline
long LineEnd
ftell MRunUDXFile LineEnd
while ((LineEnd + 3) % 100) - 1
fputc MRunUDXFile ' '
ftell MRunUDXFile LineEnd
endwhile
fputs MRunUDXFile "`r`n"
endproc
#endcomment


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

CHECKUDX()

Called by insertulfile(), getulfiles()

Checks whether a given file is already in the UDX List.
If it is, a value of 1 is returned, if not, the file
is added to the list and a value of 0 is returned.

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

func checkudx : integer
strparm CkFileName
string UDXFile, UDXFileString
integer InUDX
rewind MRunUDXFile
InUDX = 0
fgets MRunUDXFile UDXFileString
while not feof MRunUDXFile
strextract UDXFile UDXFileString "`t" 0
if strcmpi CkFileName UDXFile
InUDX = 1
exitwhile
endif
fgets MRunUDXFile UDXFileString
endwhile
fseek MRunUDXFile 0 2
return InUDX
endfunc


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

UPDATEUDX()

Called by main(), insertulfile(), delulfile()

Calls openerror(), getnewdesc(), padline(), interfaceon(),
interfaceoff(), makefullname(), clearfiledesc(),
bubblesort()

Updates the Upload directory file description database
and index files.

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

proc updateudx
string FileDate, FileSize, FullFileName
string ULDescString, UDXString, UDXFile
long DescBegin, DescLength, l
integer ULDescLength
integer char
interfaceoff()
;Copy all but the new description to the new UDX file
copyfile MRunUDX OldUDX
fopen OldUDXFile OldUDX READ TEXT
openerror(OldUDX)
fopen MRunUDXFile MRunUDX CREATE TEXT
openerror(MRunUDX)
fgets OldUDXFile UDXString
while not feof OldUDXFile
;Read lines until the end of file or the current file
strextract UDXFile UDXString "`t" 0
if strcmpi UDXFile FileName
exitwhile
endif
fputs MRunUDXFile UDXString
fgets OldUDXFile UDXString
endwhile
;Get the size and date
if NULLSTR UDXString
FullFileName = makefullname(UploadDir, FileName)
if isfile FullFileName
getfsize FullFileName l
ltoa l FileSize
getfdate FullFileName FileDate
InULDir = 1
else
FileSize = "???"
FileDate = "??/??/??"
InULDir = 0
endif
else
strextract FileSize UDXString "`t" 1
strextract FileDate UDXString "`t" 2
endif
;Discard the old description line
fgets OldUDXFile UDXString
FileChoice = UDXString
while not feof OldUDXFile
fputs MRunUDXFile UDXString
fgets OldUDXFile UDXString
endwhile
fopen MRunUBFFile MRunUBF READWRITE
openerror(MRunUBF)
;go to the end of the description database
fseek MRunUBFFile 0 2
ftell MRunUBFFile DescBegin
DescLength = 0
ULDescLength = 0
ULDescString = ""

;read characters from the description box into the database
fopen FileDescFile FileDesc READWRITE
openerror(FileDesc)
fgetc FileDescFile char
while not feof FileDescFile
;read characters until all have been read
if ((char >= 0x20) && (char <= 0x7E)) || \
((char >= 0xA0) && (char <= 0xFE))
;Ignore non-printing characters
fputc MRunUBFFile char
if ULDescLength < 46
;No special characters in the index file either
strfmt ULDescString "%s%c" ULDescString char
ULDescLength++
endif
DescLength++
endif
fgetc FileDescFile char
endwhile
fclose MRunUBFFile
fclose FileDescFile

;Strip partial words from end of description
if ULDescLength == 46
ULDescLength--
strpeek ULDescString ULDescLength char
while char > 32
strdelete ULDescString ULDescLength 1
ULDescLength--
strpeek ULDescString ULDescLength char
endwhile
endif

strfmt FileChoice "%s`t%s`t%s`t%s`t%ld`t%ld" \
FileName FileSize FileDate ULDescString DescBegin DescLength
fputs MRunUDXFile FileChoice
; padline()
; bubblesort()
fclose OldUDXFile
fclose MRunUDXFile
delfile OldUDX
sortidx(MRunUDX, ULSortField)
interfaceon()
endproc


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

ULFILEBOX()

Called by main()

Draws the Upload Files Dialog Box.

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

proc ulfilebox
PermRadio = 2
assign Conf "0"
assign FileName ""
destroydlg
HelpPage = 10
dialogbox 19 38 324 201 15 "Upload 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 MRunUDX DXFileTabs single FileChoice
groupbox 12 89 300 17
radiobutton 26 94 60 11 "Unsorted" ULSortField
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:"
feditbox 129 122 182 50 FileDesc
text 14 158 78 8 right "U/L to Conference:"
editbox 96 156 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 "&Save" normal
pushbutton 206 179 30 14 "De&lete" normal
pushbutton 244 179 30 14 "&Refresh" normal
pushbutton 282 179 30 14 "&Done" cancel
text 76 9 80 8 right "Upload File to:"
combobox 160 7 70 42 BBSList BBS sort
checkbox 13 140 100 10 "File in uploads directory?" InULDir
enddialog
disable CTRL 70
endproc





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