PROGRAM Email
PROGRAM Email
C----------------------------------------------------------------------
C! -
C!
C! Author :- Julian J. Bunn 25-APR-1997
C!
C! The purpose of this program is to extract all messages in each
C! folder in MAIL.MAI into individual Eudora .mbx file
C?
C!======================================================================
implicit integer (a-z)
include '($ssdef)'
c
mfcontext = 0
mcontext = 0
c
c Begin mail file and open
c
call begin_mail_file(mfcontext)
c
c Read all folders
c
call read_folders(mfcontext)
c
c Close the mail file
c
call close_mail_file(mfcontext)
c
c
c
end
subroutine read_folders
subroutine read_folders(mfcontext)
implicit integer (a-z)
parameter (lmailfile=255,lfoldername=15,maxfolder=200)
include '($ssdef)'
include '($maildef)'
common /folders/ nfolder,folder,nmess
character*(lmailfile) mailfile
character*(lfoldername) foldername,folder(maxfolder)
character*255 crecord,cfrom,cto,ccc,cdate,csend,csubject
integer nmess(maxfolder)
external handle_folder
c
structure /itemlist/
integer*2 bufflen
integer*2 itemcode
integer*4 buffadd
integer*4 retladd
end structure
record /itemlist/ in_item(4),out_item(20)
c
c get the folder names
c
nfolder = 0
userword = 77
in_item(1).bufflen = 4
in_item(1).itemcode = mail$_mailfile_folder_routine
in_item(1).buffadd = %loc(handle_folder)
in_item(1).retladd = %loc(dummy)
in_item(2).bufflen = 4
in_item(2).itemcode = mail$_mailfile_user_data
in_item(2).buffadd = %loc(userword)
in_item(2).retladd = %loc(dummy)
in_item(3).bufflen = 0
in_item(3).itemcode = 0
out_item(1).bufflen = 0
out_item(1).itemcode = 0
status = mail$mailfile_info_file(mfcontext,in_item,out_item)
if(.not.status) status=lib$signal(%val(status))
c
c Get number of messages in each folder
c
do 1 ifold=1,nfolder
c
c set up the message context
c
mcontext = 0
in_item(1).bufflen = 4
in_item(1).itemcode = mail$_message_file_ctx
in_item(1).buffadd = %loc(mfcontext)
in_item(1).retladd = %loc(dummy)
in_item(2).bufflen = 0
in_item(2).itemcode = 0
out_item(1).bufflen = 0
out_item(1).itemcode = 0
status = mail$message_begin(mcontext,in_item,out_item)
if(.not.status) status=lib$signal(%val(status))
foldername = folder(ifold)
lfold = index(foldername,' ')-1
if(lfold.eq.-1) lfold = lfoldername
in_item(1).bufflen = lfold
in_item(1).itemcode = mail$_message_folder
in_item(1).buffadd = %loc(foldername)
in_item(1).retladd = %loc(dummy)
in_item(2).bufflen = 0
in_item(2).itemcode = 0
out_item(1).bufflen = 4
out_item(1).itemcode = mail$_message_selected
out_item(1).buffadd = %loc(num_mess)
out_item(1).retladd = %loc(dummy)
out_item(2).bufflen = 0
out_item(2).itemcode = 0
status = mail$message_select(mcontext,in_item,out_item)
if(.not.status) status=lib$signal(%val(status))
nmess(ifold) = num_mess
write(6,*) num_mess,' Messages in ',foldername
write(6,*) 'Creating file '//foldername(:lfold)//'.mbx'
if(foldername(:3).eq.'c++') foldername='cpp'
open(1,file=foldername(:lfold)//'.mbx',status='new',
& carriagecontrol='list',err=999)
do imess = 1,num_mess
in_item(1).bufflen = 0
in_item(1).itemcode = mail$_message_next
in_item(1).buffadd = 0
in_item(1).retladd = %loc(dummy)
in_item(2).bufflen = 0
in_item(2).itemcode = 0
out_item(1).bufflen = 255
out_item(1).itemcode = mail$_message_from
out_item(1).buffadd = %loc(cfrom)
out_item(1).retladd = %loc(lcfrom)
out_item(2).bufflen = 255
out_item(2).itemcode = mail$_message_to
out_item(2).buffadd = %loc(cto)
out_item(2).retladd = %loc(lcto)
out_item(3).bufflen = 255
out_item(3).itemcode = mail$_message_cc
out_item(3).buffadd = %loc(ccc)
out_item(3).retladd = %loc(lccc)
out_item(4).bufflen = 255
out_item(4).itemcode = mail$_message_subject
out_item(4).buffadd = %loc(csubject)
out_item(4).retladd = %loc(lcsubject)
out_item(5).bufflen = 255
out_item(5).itemcode = mail$_message_date
out_item(5).buffadd = %loc(cdate)
out_item(5).retladd = %loc(lcdate)
out_item(6).bufflen = 255
out_item(6).itemcode = mail$_message_sender
out_item(6).buffadd = %loc(csend)
out_item(6).retladd = %loc(lcsend)
out_item(7).bufflen = 0
out_item(7).itemcode = 0
status = mail$message_get(mcontext,in_item,out_item)
if(.not.status) status=lib$signal(%val(status))
c
c Insert the Eudora delimiter. The date doesn't matter
c
write(1,'(a)') 'From ???@??? Tue Jan 23 18:04:27 1996'
c
c Massage the date to a form like Tue, 29 Oct 1996 14:16:20 +0100
c (call all days monday: it doesn't matter!)
c
cdate = 'Mon, '//cdate(1:2)//' '//cdate(4:6)//' '//
& cdate(8:20)//' +0100'
lcdate = 31
write(1,'(a)') 'Received: ; '//cdate(:lcdate)
write(1,'(a)') 'To: '//cto(:min(127,lcto))
write(1,'(a)') 'Cc: '//ccc(:min(127,lccc))
c
c Massage the sender name from various VMS specific formats
c Don't bother massaging the other addresses
c
if(csend(:6).eq.'SMTP%"') then
csend = csend(7:)
lcsend = index(csend,'"')-1
else if(csend(:9).eq.'DXMINT::"') then
csend = csend(10:)
lcsend = index(csend,'"')-1
else if(index(csend,'::').ne.0) then
idp = index(csend,'::')
csend = csend(idp+2:lcsend)//'@'//csend(:idp-1)//
& '.cern.ch '
lcsend = index(csend,' ')-1
else if(index(csend,'@').eq.0) then
csend = csend(:lcsend)//'@vxcern.cern.ch '
lcsend = index(csend,' ')-1
endif
write(1,'(a)') 'From: '//csend(:min(125,lcsend))
write(1,'(a)') 'Subject: '//csubject(:min(122,lcsubject))
c
c Get the records
c
in_item(1).bufflen = 0
in_item(1).itemcode = mail$_message_continue
in_item(1).buffadd = 0
in_item(1).retladd = %loc(dummy)
in_item(2).bufflen = 0
in_item(2).itemcode = 0
out_item(1).bufflen = 255
out_item(1).itemcode = mail$_message_record
out_item(1).buffadd = %loc(crecord)
out_item(1).retladd = %loc(lcrecord)
out_item(2).bufflen = 0
out_item(2).itemcode = 0
nrec = 0
2 status = mail$message_get(mcontext,in_item,out_item)
if(status) then
if(index(crecord(:lcrecord),':'//char(9)).ne.0) goto 2
nrec = nrec + 1
write(1,'(a)') crecord(:min(131,lcrecord))
goto 2
endif
write(6,*) 'Mail message containing ',nrec,' records'
end do
c
c End the message context
c
in_item(1).bufflen = 0
in_item(1).itemcode = 0
out_item(1).bufflen = 0
out_item(1).itemcode = 0
status = mail$message_end(mcontext,in_item,out_item)
if(.not.status) status=lib$signal(%val(status))
close(1)
1 continue
1000 write(6,100)
write(6,101) (nmess(i),folder(i),i=1,nfolder)
write(6,102)
100 format(///,26x,'Mails in Folders',26x,/,75('='))
101 format(1x,i4,' in ',a,
& i4,' in ',a,
& i4,' in ',a)
102 format(75('='),//)
stop
999 write(6,*) 'Error creating folder file'
end
integer function lenocc
integer function lenocc(char)
character*(*) char
do lenocc=len(char),1,-1
if(char(lenocc:lenocc).ne.' ') return
end do
lenocc = 0
end
integer function handle_folder
integer function handle_folder(userword,struct)
parameter (lfoldername=15,maxfolder=200)
include '($ssdef)'
common /folders/ nfolder,folder,nmess
character*(lfoldername) folder(maxfolder)
character*1024 fname
integer nmess(maxfolder)
structure /descriptor/
integer*2 length
byte dtype
byte dclass
integer*4 p_data
end structure
record /descriptor/ struct
c
handle_folder = ss$_normal
len = struct.length
if(len.le.0) return
if(nfolder.ge.maxfolder) then
status = lib$put_output('Maximum number of Folders exceeded')
handle_folder = ss$_accvio
return
endif
call add2val(%val(struct.p_data),fname,len)
nfolder = nfolder + 1
folder(nfolder) = fname(:len)
nmess(nfolder) = 0
end
subroutine add2val
subroutine add2val(input,output,len)
character*(*) output
byte input(1024)
do 1 i=1,len
output(i:i) = char(input(i))
1 continue
end
subroutine begin_mail_file
subroutine begin_mail_file(mfcontext)
C----------------------------------------------------------------------
C! -
C!
C! Author :- Julian J. Bunn 10-APR-1991
C!
C?
C!======================================================================
implicit integer (a-z)
parameter (lmailfile=255)
include '($ssdef)'
include '($maildef)'
character*(lmailfile) mailfile
c
structure /itemlist/
integer*2 bufflen
integer*2 itemcode
integer*4 buffadd
integer*4 retladd
end structure
record /itemlist/ in_item(4),out_item(4)
c
in_item(1).bufflen = 0
in_item(1).itemcode = 0
out_item(1).bufflen = lmailfile
out_item(1).itemcode = mail$_mailfile_mail_directory
out_item(1).buffadd = %loc(mailfile)
out_item(1).retladd = %loc(lm)
out_item(2).bufflen = 0
out_item(2).itemcode = 0
status = mail$mailfile_begin(mfcontext,in_item,out_item)
if(.not.status) status=lib$signal(%val(status))
write(6,*) ' Mail directory ',mailfile(:lm)
c
c Open the mail file
c
mailfile = mailfile(:lm)//'MAIL.MAI'
lm = lm + 8
in_item(1).bufflen = lm
in_item(1).itemcode = mail$_mailfile_name
in_item(1).buffadd = %loc(mailfile)
in_item(1).retladd = %loc(dummy)
in_item(2).bufflen = 0
in_item(2).itemcode = 0
out_item(1).bufflen = 0
out_item(1).itemcode = 0
status = mail$mailfile_open(mfcontext,in_item,out_item)
if(.not.status) status=lib$signal(%val(status))
write(6,*) ' Mail file '//mailfile(:lm)//' opened'
c
end
subroutine close_mail_file
subroutine close_mail_file(mfcontext)
C----------------------------------------------------------------------
C! -
C!
C! Author :- Julian J. Bunn 10-APR-1991
C!
C?
C!======================================================================
implicit integer (a-z)
include '($ssdef)'
include '($maildef)'
c
structure /itemlist/
integer*2 bufflen
integer*2 itemcode
integer*4 buffadd
integer*4 retladd
end structure
record /itemlist/ in_item(4),out_item(4)
c
in_item(1).bufflen = 0
in_item(1).itemcode = 0
out_item(1).bufflen = 0
out_item(1).itemcode = 0
status = mail$mailfile_close(mfcontext,in_item,out_item)
if(.not.status) status=lib$signal(%val(status))
end