home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
batch
/
mxmnu233.zip
/
MAIL.MNU
< prev
next >
Wrap
Text File
|
1991-09-27
|
23KB
|
1,069 lines
Comment
==========================================================
Copyright 1991 by Marc Perkel * All right reserved.
This is a simple EMAIL program designed for novell networks. It's still
rather new so don't expect perfection. It is a demo menu and you will
need to modify it to suit. It is not designed to compete with major mail
software.
This program does not offer high security. In fact, you will have to
grant full access rights to the MAIL directories to everyone. If
security is an issue then this isn't for you. It is designed to elimate
stacks of notes that get lost in small offices where security is not a
problem.
To control custom screen features, edit CUSTOM.INC and other INCLUDE
Files.
=========================================================
EndComment
;------ Create Variables
Var
MyServer
NetAddress
Station
UserName
ShortName
BMess
TitleBackColor
TitleInsideColor
Var
AllUsers
LoggedUsers
Groups
SendTo
FileToSend
DefFileToSend
HomeDirPrefix
MyEditor
Mail
InLines
MailStat
StatWin
LastMsgWaiting = -1
InBox
NotesFile
ReplyName
ReceiptName
RecName
DelayName
FutureName
ReadyToReceive
ThisDir
SkipTest
TrashFile
OutFile
OutFileOpen
Msg
Bar
Qualifier
Text
From
SendTo
CarbonCopy
MsgTime
Receipt
Urgent
Delay
Subject
if NovConnection = 0
ClearScreenOnExit Off
Writeln 'This program requires a Novell connection to run!'
ExitMenu
endif
MyServer = NovDefaultServer
Station = Str(NovConnection)
UserName = NovMyLoginName
ShortName = Left(UserName,8)
;------ Read network address
NetAddress = NovStationAddress (NovConnection)
;------ Personalize Your Screen Messages
StatusLineText = 'User: ' + UserName + ' * Server: ' + MyServer
StatusLineText = StatusLineText + ' * Address: ' + NetAddress
if length(StatusLineText) < 64
StatusLineText = StatusLineText + ' * Dos: ' + DosVersionString
endif
MenuTitle = 'Computer Tyme Message System'
;------ Load menu look and feel include files
Include 'CUSTOM.INC'
MyEditor = 'ME.EXE'
HomeDirPrefix = 'F:\HOME'
DefFileToSend = HomeDirPrefix + '\' + ShortName + '\' + 'OUT.MSG'
FileToSend = DefFileToSend
InBox = HomeDirPrefix + '\' + ShortName + '\' + 'INBOX.TXT'
TrashFile = HomeDirPrefix + '\' + ShortName + '\' + 'TRASH.TXT'
NotesFile = HomeDirPrefix + '\' + ShortName + '\' + 'NOTES'
ReplyName = HomeDirPrefix + '\' + ShortName + '\' + 'REPLY.MSG'
ReceiptName = HomeDirPrefix + '\' + ShortName + '\' + 'RECEIPT.MSG'
RecName = ForceExtension(MailFile(UserName),'REC')
DelayName = ForceExtension(RecName,'DLY')
FutureName = ForceExtension(RecName,'FTR')
Bar = '===================================='
RemoveDelayMessages
ReceiveMail
IdleProgram = Loc BackTask
ReadyToReceive
;----- Main Menu
AddChoice('Read Messages',1)
AddChoice('Compose a Message',2)
AddChoice('Send Composed Message',3)
AddChoice('Send Form Message',4)
AddChoice('Mail Utilities',5)
AddChoice('Novell Utilities',6)
if NovInGroup('MAILMANAGER')
AddChoice('Diagnostics',7)
endif
CornerStretchBox ('Marx Mail',11,6)
OnKey Task(1)
|ReceiveMail
|if NumberOfElements(Mail) > 0 then ReadMessage
|ReceiveMail
OnKey Task(2)
|FileToSend = DefFileToSend
|InputFileToSend
|EditFile(FileToSend)
|LoadFileToSend
OnKey Task(3)
|SendMessages
OnKey Task(4)
|FileToSend = SelectFile('*.MSG')
|if LastKey = Esc then Return
|SendMessages
OnKey Task(5)
^Util
OnKey Task(6)
^Novell
OnKey Task(7)
^Diag
OnKey ESC
|LeaveMenu
;----- Utility Menu
:Util
AddChoice("Who's Logged In?",1)
AddChoice("View InBox",2)
AddChoice("Edit InBox",3)
AddChoice("Edit Form Message",4)
if ExistFile(TrashFile)
AddChoice("Dig Through Trash",5)
AddChoice("Empty Trash",6)
endif
CornerStretchBox ('Utility Menu',43,6)
OnKey Task(1)
|SendTo = PickLoggedUser('Logged Users')
|Dispose(SendTo)
OnKey Task(2)
|ViewAFile(InBox)
OnKey Task(3)
|EditFile(InBox)
OnKey Task(4)
|FileToSend = SelectFile('*.MSG')
|if LastKey = Esc then Return
|EditFile(FileToSend)
OnKey Task(5)
|ViewAFile(TrashFile)
OnKey Task(6)
|EmptyTrash
|LastKey = Esc
;----- Novell Message Menu
:Novell
AddChoice('Send Novell Message',1)
AddChoice("Block Novell Message",2)
AddChoice("Allow Novell Message",3)
if NovInGroup('MAILMANAGER')
AddChoice("Novell Syscon",4)
endif
CornerStretchBox ('Novell Menu',43,6)
OnKey Task(1)
|PickWhoTo
|if WhoPicked then SendNovellMessages
OnKey Task(2)
CASTOFF
OnKey Task(3)
CASTON
OnKey Task(4)
Syscon
;----- Diagnostics Menu
:Diag
AddChoice('Edit This Menu',1)
if ExistFile(RecName)
AddChoice('View REC File',2)
endif
if ExistFile(FutureName)
AddChoice('View FUT File',3)
endif
CornerStretchBox ('Diagnostics Menu',43,6)
OnKey Task(1)
|EditFile(%MenuFileName)
MarxComp %MenuFileName
OnKey Task(2)
|ViewAFile(RecName)
OnKey Task(3)
|ViewAFile(FutureName)
;=========================================================
Procedure EmptyTrash
var BackFile
ShowMessage('Emptying Trash',43,20)
BackFile = ForceExtension(TrashFile,'BAK')
DelFile(BackFile)
FileRename(TrashFile,Backfile)
Wait 100
EraseTopWindow
EndProc
;----- Process OutGoing File
Procedure LoadFileToSend
var St Tmp Tmp2 KeyWord X Y SameLine BlindCC
if Msg.From > '' then return
Msg.From = UserName
ReadTextFile(FileToSend,Msg.Text)
Y = NumberOfElements Msg.Text
X = 1
While X <= Y
St = Msg.Text[X]
Tmp = UpperCase(St)
KeyWord = NextWord(Tmp)
;Specify you to send to
if KeyWord = 'SENDTO:'
while Tmp > ''
Tmp2 = NextWord(Tmp)
if Tmp2 <> ','
AppendArray(Msg.SendTo,Tmp2)
endif
endwhile
Delete(Msg.Text,X,1)
Y = Y - 1
SameLine
;Mail to be delivered in future
elseif KeyWord = 'DELAY:'
Trim(Tmp)
Msg.Delay = TimeOf(Tmp) >= Tomorrow
Msg.Text[X] = 'DELAY: ' + Tmp
;Mail Subject
elseif KeyWord = 'SUBJECT:'
Tmp = St
Msg.Subject = NextWord(Tmp)
Trim(Tmp)
Msg.Subject = Tmp
Msg.Text[X] = 'SUBJECT: ' + Tmp
;Blind Carbon Copy
elseif KeyWord = 'BCC:'
KeyWord = 'CC:'
BlindCC
endif
;Carbon Copy
if KeyWord = 'CC:'
St = 'CC:'
while Tmp > ''
Tmp2 = NextWord(Tmp)
if Tmp2 <> ','
St = St + ' ' + Tmp2
AppendArray(Msg.CarbonCopy,Tmp2)
endif
endwhile
if BlindCC
Delete(Msg.Text,X,1)
Y = Y - 1
SameLine
else
Msg.Text[X] = St
Endif
endif
if Tmp = ''
;Urgent Mail triggers novell message send
if KeyWord = 'URGENT'
Msg.Urgent = True
Msg.Text[X] = KeyWord
endif
;Return receipt requested
if KeyWord = 'RECEIPT'
Msg.Text[X] = KeyWord
endif
endif
if not SameLine then X = X + 1
SameLine = False
EndWhile
if Msg.Delay then Msg.Urgent = False
TrimText(Loc Msg.Text)
if NumberOfElements(Msg.SendTo) > 0 then SendTo = Msg.SendTo
ExpandAndTestSendTo (Loc SendTo)
ExpandAndTestSendTo (Loc Msg.CarbonCopy)
EndProc
Procedure ExpandAndTestSendTo (List)
var X Y Users Group
X = 1
Y = NumberOfElements(List)
while X <= Y
if not UserExists(List[X])
Group = List[X]
delete(List,X,1)
X = X - 1
Y = Y - 1
if GroupExists(Group)
NovGroupMembers(Group,Users)
Loop Users
AppendArray(List,Users[LoopIndex])
Y = Y + 1
EndLoop
endif
endif
X = X + 1
endwhile
RemoveDuplicates (Loc List)
EndProc
Procedure RemoveDuplicates (List)
var X Y
SortArray(List)
X = 1
Y = NumberOfElements (List) - 1
while X <= Y
if List[X] = List[X + 1]
Delete(List,X,1)
X = X - 1
Y = Y - 1
endif
X = X + 1
endwhile
EndProc
Procedure TrimText (Text)
var X
while (NumberOfElements (Text) > 0) and (Text[1] = '')
delete(Text,1,1)
endwhile
X = NumberOfElements Text
while (X > 1) and (Text[X] = '')
X = X - 1
endwhile
delete(Text,X + 1,10000)
EndProc
Comment
==========================================================
This section of code deals with sending novell messages by shelling the
novell send command. The send is executed if the receiving user is in
the NOTIFY group of the word URGENT is used in the message by the
sender.
==========================================================
EndComment
Procedure SendNovellMessage (Message,User)
var St
if UserIsLoggedIn(User)
St = 'Notifying: ' + User
ShowMessage (St,45,20)
ClearScreenFirst Off
Execute 'Send "' + Message + '" to ' + User + '>nul'
EraseTopWindow
endif
EndProc
Procedure SendNovellMessages
var Message
if NumberOfElements (SendTo) = 0 then Return
Message = ReadTextLine('Message:','',0,21)
if LastKey = Esc then Return
Loop SendTo
SendNovellMessage(Message,SendTo[LoopIndex])
EndLoop
Dispose SendTo
Dispose Msg
EndProc
;=========================================================
Procedure DrawPickBox (Title,A)
DrawTheBox(30,10,23,Min(14,NumberOfElements(A) + 4),Title)
EndProc
;----- Reads a list of logged users on the system
Procedure ReadLoggedUsers
if NumberOfElements(LoggedUsers) > 0 then Return
NovUsersLoggedIn(LoggedUsers)
SortArray(LoggedUsers)
EndProc
Procedure PickLoggedUser (Message)
ReadLoggedUsers
DrawPickBox(Message,LoggedUsers)
Return PickOne(LoggedUsers)
EndProc
;----- Reads a list of all users on the system
Procedure ReadUsers
if NumberOfElements(AllUsers) > 0 then Return
NovUsers(AllUsers)
SortArray(AllUsers)
EndProc
Procedure PickUser (Message)
ReadUsers
DrawPickBox(Message,AllUsers)
Return PickOne(AllUsers)
EndProc
;----- Reads a list of all groups on the system
Procedure ReadGroups
if NumberOfElements(Groups) > 0 then Return
NovGroups(Groups)
SortArray(Groups)
EndProc
Procedure PickGroup (Message)
ReadGroups
DrawPickBox(Message,Groups)
Return PickOne(Groups)
EndProc
Procedure PickUsersFromGroup
var Group Members
Group = PickGroup('Groups')
EraseTopWindow
NovGroupMembers(Group,Members)
DrawPickBox('Members',Members)
PickMany(Members,SendTo)
EndProc
Procedure WhoPicked
Return NumberOfElements(SendTo) > 0
EndProc
Procedure PickWhoTo
if WhoPicked then Return
AddChoice("Pick Logged In User",1)
AddChoice("Pick from all Users",2)
AddChoice("Pick a Group",3)
AddChoice("Pick users from Group",4)
CornerStretchBox ('Who To Menu',43,6)
OnKey Task(1)
|SendTo[1] = PickLoggedUser('Logged Users')
|LastKey = Esc
OnKey Task(2)
|SendTo[1] = PickUser('All Users')
|LastKey = Esc
OnKey Task(3)
|SendTo = PickGroup('Groups')
|NovGroupMembers(SendTo,SendTo)
|LastKey = Esc
OnKey Task(4)
|PickUsersFromGroup
|LastKey = Esc
EndProc
;=========================================================
;----- Mail Directories
Procedure MailDir (User)
Return 'F:\MAIL\' + NovObjectID(User)
EndProc
Procedure MyMailDir
Return MailDir(UserName)
EndProc
Procedure MyHomeDir
Return 'F:\HOME\' + ShortName
EndProc
Procedure MailFile (User)
Return MailDir(User) + '\' + NovObjectID(User) + '.IN'
EndProc
;----- Input file to send
Procedure InputFileToSend
InputString = FileToSend
Cursor On
FileToSend = ReadTextLine('File:','',0,21)
EndProc
;----- Check Lists
Procedure StringIsInList (St,List)
Loop List
if St = List[LoopIndex]
Return True
endif
EndLoop
Return False
EndProc
Procedure UserIsLoggedIn (User)
ReadLoggedUsers
Return StringIsInList (User,LoggedUsers)
EndProc
Procedure UserExists (User)
ReadUsers
Return StringIsInList (User,AllUsers)
EndProc
Procedure GroupExists (Group)
ReadGroups
Return StringIsInList (Group,Groups)
EndProc
;----- Send Messages
Procedure GetTimeString
var StHour StMinute St Moment
Moment = Now
StHour = Str(HourOf(Moment))
StMinute = Str(MinuteOf(Moment))
if StHour = '0' then StHour = '12'
if HourOf(Moment) > 11
if HourOf(Moment) > 12 then StHour = Str(HourOf(Moment) - 12)
St = 'p'
else
St = 'a'
endif
if length(StMinute) = 1 then StMinute = '0' + StMinute
if length(StHour) = 1 then StHour = '0' + StHour
St = StHour + ':' + StMinute + St
Return St
EndProc
Procedure MessageHeader
var Head
Head = 'From: ' + UserName
Head = Head + ' -<*>- Time: ' + DateString + ' ' + GetTimeString
WriteOutFile('')
WriteOutFile(Head)
WriteOutFile('')
EndProc
Procedure MessageFooter
WriteOutFile('')
WriteOutFile(Bar)
EndProc
;=========================================================
;----- Send Messages
Procedure SendMessageCC (User,Carbon)
var Name
ShowMessage('Sending ' + FileToSend + ' to ' + User,11,20)
Name = MailFile(User)
if Msg.Delay then Name = ForceExtension(Name,'DLY')
OpenOutFile(Name)
MessageHeader
if Carbon > ''
WriteOutFile(' * * Carbon Copy of Message Sent To: ' + Carbon + ' * *')
WriteOutFile('')
endif
Loop Msg.Text
WriteOutFile(Msg.Text[LoopIndex])
EndLoop
MessageFooter
CloseOutFile
EraseTopWindow
if NovUserInGroup(User,'NOTIFY') or Msg.Urgent
if Msg.Subject > ''
SendNovellMessage(Msg.Subject,User)
else
if Msg.Urgent
SendNovellMessage('* Urgent Incomming Mail *',User)
else
SendNovellMessage('* Incomming Mail *',User)
endif
endif
endif
EndProc
Procedure SendMessage (User)
SendMessageCC(User,'')
Loop Msg.CarbonCopy
SendMessageCC(Msg.CarbonCopy[LoopIndex],User)
EndLoop
EndProc
Procedure SendMessages
LoadFileToSend
PickWhoTo
Loop SendTo
SendMessage(SendTo[LoopIndex])
EndLoop
Dispose SendTo
Dispose Msg
FileToSend = DefFileToSend
EndProc
;=========================================================
;----- Process Incomming Mail
Procedure ReceiveMail
var InFile
Dispose(Mail)
InFile = MailFile(UserName)
AppendFiles(InFile,RecName)
if ExistFile(RecName)
BreakMessagesDown
endif
UpdateStatus
EndProc
Procedure BreakMessagesDown
var St Tmp KeyWord ThisMsg
ReadTextFile(RecName,InLines)
TrimText (Loc InLines)
ThisMsg = Loc Mail[1]
Loop InLines
St = InLines[LoopIndex]
Tmp = UpperCase(St)
KeyWord = NextWord(Tmp)
if left(St,3) = '==='
TrimText(Loc ThisMsg.Text)
if LoopIndex < NumberOfElements InLines
Actual ThisMsg = Loc Mail[NumberOfElements(Mail) + 1]
endif
else
if ThisMsg.From = ''
if KeyWord = 'FROM:'
ThisMsg.From = NextWord(Tmp)
delete(Tmp,1,pos('TIME: ',Tmp))
ThisMsg.MsgTime = NextWord(Tmp)
ThisMsg.MsgTime = Tmp
endif
endif
if KeyWord = 'RECEIPT'
ThisMsg.Receipt = True
St = ' ';
endif
if St <> ' ' then AppendArray(ThisMsg.Text,St)
endif
EndLoop
EndProc
Procedure RemoveDelayMessages
var MsgStart MsgEnd St Tmp KeyWord Delay Process DelExist FutExist
DelExist = ExistFile(DelayName)
FutExist = ExistFile(FutureName)
if not (DelExist or FutExist) then Return
if FutExist
Process = FileTime(FutureName) <> Today
endif
if DelExist
Process = True
AppendFiles(DelayName,FutureName)
endif
if not Process then Return
MsgStart = 1
ReadTextFile(FutureName,InLines)
DelFile(FutureName)
Loop InLines
St = InLines[LoopIndex]
Tmp = UpperCase(St)
KeyWord = NextWord(Tmp)
if left(St,3) = '==='
MsgEnd = LoopIndex
if Delay
OpenOutFile(FutureName)
else
OpenOutFile(RecName)
endif
while MsgStart <= MsgEnd
WriteOutFile(InLines[MsgStart])
MsgStart = MsgStart + 1
endwhile
CloseOutFile
Delay = False
endif
if KeyWord = 'DELAY:'
Delay = TimeOf(Tmp) > Today
endif
EndLoop
EndProc
Procedure UpdateStatus
var St
if NumberOfElements(Mail) = LastMsgWaiting then Return
LastMsgWaiting = NumberOfElements(Mail)
St = 'No'
if NumberOfElements(Mail) > 0 then St = Str(NumberOfElements(Mail))
if NumberOfElements(Mail) = 1
MailStat = ' 1 Message Waiting'
else
MailStat = ' ' + St + ' Messages Waiting'
endif
if StatWin = 0
NoBoxBorder
if ColorScreen
BoxInsideColor White Cyan
else
BoxInsideColor Black Grey
endif
DrawBox 14 21 length(MailStat) + 4 1
Cursor Off
Write MailStat
StatWin = CurrentWindow
else
SetTopWindow StatWin
ClearScreen
Write MailStat
SetWindowUnder(StatWin,StatWin + 1)
endif
EndProc
;=========================================================
;----- Respond to Mail
Procedure SendReceipt
var St
if Mail[1].Receipt
DelFile(ReceiptName)
OpenOutFile(ReceiptName)
WriteOutFile('* Message Received *')
Loop Mail[1].Text
St = Mail[1].Text[LoopIndex]
if St > '' then St = '>> ' + St
WriteOutFile(St)
EndLoop
CloseOutFile
FileToSend = ReceiptName
SendTo[1] = Mail[1].From
SendMessages
endif
EndProc
Procedure SaveMessageToFile (Name,WithBar)
OpenOutFile(Name)
if WithBar then WriteOutFile('')
Loop Mail[1].Text
WriteOutFile(Mail[1].Text[LoopIndex])
EndLoop
if WithBar
WriteOutFile('')
WriteOutFile(Bar)
endif
CloseOutFile
EndProc
Procedure WasteMessage (Num)
var X
X = 1
while Left(InLines[X],3) <> '==='
X = X + 1
EndWhile
Delete(InLines,1,X)
WriteTextFile (RecName,InLines)
Delete(Mail,1,1)
UpDateStatus
EndProc
Procedure ReplyToMessage
SendTo[1] = Mail[1].From
DelFile(ReplyName)
SaveMessageToFile(ReplyName,No)
EditFile(ReplyName)
DelFile(ForceExtension(ReplyName,'BAK'))
FileToSend = ReplyName
EndProc
Procedure ProcessMessage
SendReceipt
AddChoice('Dispose Message',1)
AddChoice('Reply to Message',2)
AddChoice('Forward Message',3)
AddChoice('Save in InBox File',4)
AddChoice('Print Message',5)
AddChoice('Put Back in MailBox',6)
CornerStretchBox('Message Menu',43,6)
OnKey Task(1)
|SaveMessageToFile(TrashFile,Yes)
|WasteMessage
|LastKey = Esc
OnKey Task(2)
|ReplyToMessage
|SendMessages
OnKey Task(3)
|ReplyToMessage
|Dispose SendTo
|SendMessages
OnKey Task(4)
|SaveMessageToFile(InBox,Yes)
|WasteMessage
|LastKey = Esc
OnKey Task(5)
|FileToSend = 'PRN'
|InputFileToSend
|SaveMessageToFile(FileToSend,Yes)
OnKey Task(6)
|SaveMessageToFile(MailFile(UserName),Yes)
|WasteMessage
|LastKey = Esc
OnKey Esc
|LastKey = ' '
EndProc
Procedure ReadMessage
ReadyToReceive Off
while NumberOfElements(Mail) > 0
if Mail[1].Receipt
BoxHeader = ' * Receipt Pending * '
endif
if ColorScreen
BoxHeaderColor White Green
BoxInsideColor LCyan MenuBG
else
BoxHeaderColor Black Grey
endif
DrawBox 1 4 80 21
ViewArray(Mail[1].Text)
ProcessMessage
EraseTopWindow
EndWhile
DelFile(RecName)
Dispose(Mail)
ReadyToReceive
EndProc
;=========================================================
;----- BackGroundTask
Procedure BackTask
if ReadyToReceive and ((Second mod 30) = (NovConnection mod 30))
if not SkipTest
ReceiveMail
endif
SkipTest
else
SkipTest Off
endif
EndProc
;----- Edit File
Procedure EditFile (Name)
ClearScreenFirst
Execute(MyEditor + ' ' + Name)
EndProc
;----- Select a File
Procedure SelectFile (Mask)
var St
if Mask = '' then Return ''
ThisDir = Path
ChDir(HomeDirPrefix + '\' + ShortName)
AllowEsc
St = PickFile Mask 48 9 14
ChDir(ThisDir)
Return (HomeDirPrefix + '\' + ShortName + '\' + St)
EndProc
;----- Message Output File Routines
Procedure OpenOutFile (Name)
if not OutFileOpen
FileAssign(OutFile,Name)
FileAppend(OutFile)
OutFileOpen = True
endif
EndProc
Procedure CloseOutFile
if OutFileOpen
FileClose(OutFile)
OutFileOpen = False
endif
EndProc
Procedure WriteOutFile (St)
FileWriteln(OutFile,St)
EndProc
Procedure AppendFiles (Source,Dest)
var Lines Tmp
if not ExistFile(Source) then Return
if ExistFile(Dest)
Tmp = ForceExtension(Source,'$$$')
FileRename(Source,Tmp)
ReadTextFile(Tmp,Lines)
DelFile(Tmp)
OpenOutFile(Dest)
Loop Lines
WriteOutFile(Lines[LoopIndex])
EndLoop
CloseOutFile
else
FileRename(Source,Dest)
endif
EndProc
Procedure ViewAFile (Name)
DrawBox 1 4 80 21
if ColorScreen then TextColor LCyan MenuBG
ViewTextFile(Name)
EndProc
Procedure ShowMessage (Message,X,Y)
DrawBox X Y length(Message) + 4 3
TextColor LCyan Blue
Cursor Off
Write ' ' Message
Wait 25
EndProc
;----- Show Item for Debugging
Procedure ShowMe (Item)
DrawBox 1 23 80 3
Write ' '
TextColor Yellow Cyan
Write Item
Wait 300
EraseTopWindow
EndProc ;ShowItem