/*
** $VER: MM_Ghost 0.65 (14.04.96)
**
** Written by Paolo Carotenuto
**
*/
DROP MM.
MM.PathCfg='MM:Config/'
MM.PrgName='MM_Ghost v0.65'
MM.Copyright='(C) 1994-96 Paolo Carotenuto'
MM.LogLevel=2
ADDRESS 'MAILMANAGER'
CALL ReadConfig()
CALL WriteLog(MM.PrgName 'Started')
DO i=0 FOR MM.CheckArea.Count
PARSE VAR MM.CheckArea.i MM.FromArea MM.ToArea .
DROP Messages
MM_SearchMsgs MM.FromArea Messages '#?' '"'MM.SearchName'"' '#?' IMP !SENT
CALL WriteLog('.')
CALL WriteLog('*** Found:' Messages.count 'Message(s) in' MM.FromArea)
DO t=0 FOR Messages.Count
CALL WriteLog('.')
CALL WriteLog('Process Message #'Messages.t)
MM_ReadMsg MM.FromArea Messages.t MM.Msg
IF Rc ~=0 THEN ITERATE
CALL WriteLog('From: 'MM.Msg.FromAddr '('MM.Msg.From')')
CALL WriteLog('  To: 'MM.Msg.ToAddr '('MM.Msg.To')')
CALL WriteLog('Subj: 'MM.Msg.Subj)
IF CheckExclude(MM.Msg.From,MM.Msg.FromAddr)='TRUE' THEN ITERATE
MM.FromName=MM.Msg.From
MM.FromFirst=WORD(MM.Msg.From,1)
MM.Subj=MM.Msg.Subj
PARSE VAR MM.Msg.Date Day Month Year Time
MM.MsgDate= Day Month Year
MM.MsgTime=Time
CALL WriteMess()
END
END
CALL WriteLog(MM.PrgName 'Ended')
DO i=0 FOR MM.CheckArea.Count
PARSE VAR MM.CheckArea.i MM.FromArea MM.ToArea MM.Status
IF UPPER(STRIP(MM.Status))='Y' THEN MM_Export MM.ToArea
END
EXIT 0
WriteMess:PROCEDURE EXPOSE MM.
IF MM.ArchiveMsgs ~='' THEN;DO
MM.PathName=MM.ArchiveMsgs||'Ghost_'||MM.FromArea||'.txt'
IF ~OPEN('Out',MM.PathName,'A') THEN IF ~OPEN('Out',MM.PathName,'W') THEN;DO
CALL WriteLog('*** Error: Can not open Archiver 'MM.PathName)
EXIT 10
END
CALL WRITELN('Out','----------------------------- Archived Message --- ['DATE() TIME()'] ---')
CALL WRITELN('Out','* From   : 'MM.Msg.From '('MM.Msg.FromAddr')')
CALL WRITELN('Out','* To     : 'MM.Msg.To '('MM.Msg.ToAddr')')
CALL WRITELN('Out','* Subject: 'MM.Msg.Subj)
CALL WRITELN('Out','* Date   : 'MM.Msg.Date'                      Area: 'MM.FromArea)
CALL WRITELN('Out','- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -')
DO i=0 FOR MM.Msg.Text.Count
CALL WRITELN('Out',TRANSLATE(MM.Msg.Text.i,'^','1'X))
END
CALL WRITELN('Out','')
CLOSE('Out')
END
MM_GetNearestAddr MM.Msg.FromAddr 'MM.Addr'
IF MM.UseText=1 THEN;DO
DO p=0 FOR MM.Text_1.Count
IF INDEX(MM.Text_1.p,'%QUOTING') ~=0 THEN;DO
CALL AddLine(' 'COPIES('~',75))
CALL QuoteMess()
CALL AddLine(' 'COPIES('~',75))
ITERATE
END
CALL Addline(Converte(MM.Text_1.p))
END
END
IF MM.UseText=2 THEN;DO
DO p=0 FOR MM.Text_2.Count
IF INDEX(MM.Text_2.p,'%QUOTING') ~=0 THEN;DO
CALL AddLine(' 'COPIES('~',75))
CALL QuoteMess()
CALL AddLine(' 'COPIES('~',75))
ITERATE
END
CALL Addline(Converte(MM.Text_2.p))
END
END
IF MM.UseText=3 THEN;DO
DO p=0 FOR MM.Text_3.Count
IF INDEX(MM.Text_3.p,'%QUOTING') ~=0 THEN;DO
CALL AddLine(' 'COPIES('~',75))
CALL QuoteMess()
CALL AddLine(' 'COPIES('~',75))
ITERATE
END
CALL Addline(Converte(MM.Text_3.p))
END
END
IF MM.UseText=4 THEN;DO
DO p=0 FOR MM.Text_4.Count
IF INDEX(MM.Text_4.p,'%QUOTING') ~=0 THEN;DO
CALL AddLine(' 'COPIES('~',75))
CALL QuoteMess()
CALL AddLine(' 'COPIES('~',75))
ITERATE
END
CALL Addline(Converte(MM.Text_4.p))
END
END
IF MM.UseText=5 THEN;DO
DO p=0 FOR MM.Text_5.Count
IF INDEX(MM.Text_5.p,'%QUOTING') ~=0 THEN;DO
CALL AddLine(' 'COPIES('~',75))
CALL QuoteMess()
CALL AddLine(' 'COPIES('~',75))
ITERATE
END
CALL Addline(Converte(MM.Text_5.p))
END
END
CALL AddLine('')
CALL AddLine('-+-' MM.PrgName '-' MM.Copyright)
CALL AddLine('')
IF OPEN('Wr','T:MM.Body.Tmp','W') THEN;DO
DO m=0 FOR MM.Body.Count
CALL WRITELN('Wr',Converte(MM.Body.m))
END
CLOSE('Wr')
END
Reply.From=MM.PrgName
Reply.FromAddr=''
Reply.To=MM.Msg.From
Reply.ToAddr=MM.Msg.FromAddr
Reply.Subj=MM.Msg.Subj
Reply.Flags='PVT'
Reply.File='T:MM.Body.Tmp'
MM_WriteMsg MM.ToArea Reply
DROP MM.Body.
MM.Body.Count=0
RETURN
AddLine:PROCEDURE EXPOSE MM.
PARSE ARG Line
Cont=MM.Body.Count
MM.Body.Cont=Line
MM.Body.Count=Cont+1
RETURN
QuoteMess:PROCEDURE EXPOSE MM.
Cont=1
DO t=0 FOR MM.Msg.Text.Count
IF C2D(LEFT(MM.Msg.Text.t,1)) ~=1 THEN;DO
IF Cont>MM.Quoteline THEN ITERATE
CALL AddLine(' ->' MM.Msg.Text.t)
Cont=Cont+1
END
END
RETURN
CheckExclude:PROCEDURE EXPOSE MM.
PARSE ARG Name,Address
MM.Look.0=Name
DO i=0 FOR MM.ExcludeName.Count
MM_SearchInStem MM.Look Resp '"'MM.ExcludeName.i'"' STR
IF Resp.Count>=1 THEN;DO
CALL WriteLog('The sender of the message is found in Exclude List -> Skipped! ')
RETURN 'TRUE'
END
END
MM.Look.0=Address
DO i=0 FOR MM.ExcludeNode.Count
MM_SearchInStem MM.Look Resp '"'MM.ExcludeNode.i'"' STR
IF Resp.Count>=1 THEN;DO
CALL WriteLog('The sender of the message is found in Exclude List -> Skipped! ')
RETURN 'TRUE'
END
END
RETURN 'FALSE'
ReadConfig:PROCEDURE EXPOSE MM.
MM.ArchiveMsgs=''
MM.QuoteLine=''
MM.ExcludeName.Count=0
MM.ExcludeNode.Count=0
MM.CheckArea.Count=0
MM.Text_1.Count=0
MM.Text_2.Count=0
MM.Text_3.Count=0
MM.Text_4.Count=0
MM.Text_5.Count=0
MM.Look.Count=1
MM.Body.Count=0
IF ~OPEN('Cfg',MM.PathCfg'MM_Ghost.cfg','R') THEN;DO
SAY '*** Error: Can not open config "'MM.PAthCfg'MM_Ghost.cfg"'
EXIT
END
DO WHILE ~EOF('Cfg')
Linea=READLN('Cfg')
IF (LEFT(Linea,1) ~=';')&Linea ~='' THEN;DO
PARSE VAR Linea Keyword Dato
SELECT
WHEN UPPER(Keyword)='#EXCLUDENAME' THEN;DO
Dato=STRIP(Dato)
MM_AddToStem MM.ExcludeName 'Dato'
END
WHEN UPPER(Keyword)='#EXCLUDENODE' THEN;DO
Dato=STRIP(Dato)
MM_AddToStem MM.ExcludeNode 'Dato'
END
WHEN UPPER(Keyword)='#CHECKAREA' THEN MM_AddToStem MM.CheckArea 'Dato'
WHEN UPPER(Keyword)='#TEXT_1' THEN MM_AddToStem MM.Text_1 'Dato'
WHEN UPPER(Keyword)='#TEXT_2' THEN MM_AddToStem MM.Text_2 'Dato'
WHEN UPPER(Keyword)='#TEXT_3' THEN MM_AddToStem MM.Text_3 'Dato'
WHEN UPPER(Keyword)='#TEXT_4' THEN MM_AddToStem MM.Text_4 'Dato'
WHEN UPPER(Keyword)='#TEXT_5' THEN MM_AddToStem MM.Text_5 'Dato'
WHEN UPPER(Keyword)='#ARCHIVEMSGS' THEN MM.ArchiveMsgs=STRIP(Dato)
WHEN UPPER(Keyword)='#QUOTELINE' THEN MM.QuoteLine= Dato
WHEN UPPER(Keyword)='#USETEXT' THEN MM.UseText= Dato
WHEN UPPER(Keyword)='#SEARCHNAME' THEN MM.SearchName=STRIP(Dato)
OTHERWISE
END
END
END
CLOSE('Cfg')
MM_GetSysOp 'MM.SysOp'
Data= DATE()
PARSE VAR Data Day Month Year
MM.RecDate= Day Month RIGHT(Year,2)
MM.RecTime=TIME()
RETURN
Converte:PROCEDURE EXPOSE MM.
PARSE ARG Data
IF INDEX(Data,'%')=0 THEN RETURN Data
Data=Replace(Data,MM.FromName,'%FROM_NAME')
Data=Replace(Data,MM.FromFirst,'%FROM_FIRST')
Data=Replace(Data,MM.FromArea,'%FROM_AREA')
Data=Replace(Data,STRIP(MM.ToArea),'%TO_AREA')
Data=Replace(Data,MM.Subj,'%SUBJ')
Data=Replace(Data,MM.MsgDate,'%MSG_DATE')
Data=Replace(Data,STRIP(MM.MsgTime),'%MSG_TIME')
Data=Replace(Data,MM.RecDate,'%REC_DATE')
Data=Replace(Data,MM.RecTime,'%REC_TIME')
Data=Replace(Data,MM.Sysop,'%SYSOP')
Data=Replace(Data,MM.Addr,'%NODO')
RETURN Data
Replace:PROCEDURE
PARSE ARG Data,New,Old
DO WHILE INDEX(Data,Old) ~=0
INTERPRET "PARSE VAR Data l '"Old"' r"
Data=l||New||r
END
RETURN Data
WriteLog:PROCEDURE EXPOSE MM.
PARSE ARG Testo
MM_WriteLog 'Testo' MM.LogLevel
RETURN