Amiga Format CD 2/amigaformatcd02.iso/comms/firstnet/part06.lha/rexx/GetEMail.thor

Text File | 1996-01-01 | 5.0 KB | 184 lines

/*
 $VER: GetEmail.Thor 1.4 by Remco van Hooff

 Rips email addresses out of the current message, and
 optionaly saves them to the userlist of your Email system.

------------------------- HISTORY -------------------------
1.0 - First release
1.1 - Some little cosmetic fixes
1.2 - Fixed a parsing bug, now addresses at the beginning
      of a line are parsed ok.
1.3 - Added checking if there is more than one address on
      one a line, so all addresses should be found now.
1.4 - Ajusted the script with the new Thor 2.1 arexx
      commands. No more RexxReqTools.library needed.
------------------------- CREDITS -------------------------
Jon Ward, for the idea.
-----------------------------------------------------------
*/

bbs       = 'Email'        /* your Email system */

if ~show('l','rexxsuppport.library') then call addlib('rexxsupport.library',0,-30,0)

drop USER.
tempfile  = 't:email.tmp'

options failat 31
p = address() || ' ' || show('P',,)
thorport = pos('THOR.',p)
if thorport > 0 then thorport = word(substr(p,thorport),1)
else do
  say 'THOR port not found!'
  exit 10
end

if ~show('p', 'BBSREAD') then do
  address command
    "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
    "WaitForPort BBSREAD"
end

address(thorport)
options results

saved = 0
SAVEMESSAGE CURRENT FILENAME tempfile NOHEADER NOANSI OVERWRITE
if(rc ~= 0) then do
  'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  exit
end

else do
  call open(tmp,tempfile,'r')
  msg = readch(tmp,102400)
  check = pos('@', msg)
    if check = 0 then do
      'requestnotify text "No Email address found." bt "_OK"'
      signal abort
    end
  call close(tmp)
  if check ~= 0 then do
    call open(tmp, tempfile, 'r')
      do while ~eof(tmp)
        msg = readln(tmp)
        parse var msg part1 '@' part2 '.' part3 rest
        do forever
          if part2 ~= '' then do
            spc = lastpos(' ', part1)
            if spc ~= 0 then part1 = delstr(part1, 1, spc)
            lengte = length(part3)
            call filter(part3, lengte)
            vraag = 'Add this Email address to\nthe' bbs 'userdatabase?'
            ttl = 'the' bbs 'userdatabase?'
            if ((lengte2 > length(bbs)+18) & (lengte2 > 26)) then vraag = center('Add this Email address to',lengte2,' ')||'\n'||center(ttl,lengte2,' ')
            /* remember that filling up with spaces only works correct if you use a non proportional font */
            REQUESTSTRING title '"GetEmail"' body '"'vraag'"' BT '"_Add|_Quit|S_kip"' ID '"'email'"'
            email = result
            if thorrc = 1 then do
              call ask
            end
            if thorrc = 2 then do
              signal abort
            end
          end
          if pos('@', rest) ~= 0 then do
            parse var rest part1 '@' part2 '.' part3 rest
            empty = 0
          end
          else empty = 1
          if empty = 1 then leave
        end
      end
    call close(tmp)
  end
  call delete(tempfile)
  'requestnotify text "No more Email addresses found." bt "_OK"'
end
exit

ask:
  address(thorport)
  do forever
    REQUESTSTRING title '"GetEmail"' BT '"_Ok|_Cancel"' body '"Enter owner of the address\n'email'."' ID '"'part1'"'
    if rc=30 then do
    REQUESTNOTIFY '"'THOR.LASTERROR'"' '"_Ok"'
    call abort
    end
    username = result
    if rc = 0  then leave
  end

  'REQUESTSTRING title "GetEmail" body "Enter an alias for\n'username':" BT "_Ok|_Cancel" MAXCHARS=100'
   if rc = 0 then useralias = result
   if rc = 5 then useralias = ''
  'REQUESTSTRING title "GetEmail" body "Enter a comment:" BT "_Ok|_Cancel" MAXCHARS=100'
  if rc = 0 then usercomment = result
  if rc = 5 then usercomment = ''
  'REQUESTNOTIFY "Name : 'username'\nAddr : 'email'\nAlias: 'useralias'\nComnt: 'usercomment'\n\nAdd this user to system' bbs'?"' '"_Yes|_No"'
  if rc~=0 then do
    REQUESTNOTIFY '"THOR.LASTERROR"' '"_Ok"'
    call abort
  end
  if result ~= 0 then do
    address BBSREAD
    USER.NAME      = username
    USER.ADDRESS   = email
    USER.ALIAS     = useralias
    USER.COMMENT.1 = usercomment
    if USER.COMMENT.1 = '' then USER.COMMENT.COUNT = 0; else USER.COMMENT.COUNT = 1

    WRITEBRUSER bbsname '"'bbs'"' stem USER ONLYIFEXIST
    if rc~=0 then do
      address(thorport)
      REQUESTNOTIFY '"'BBSREAD.LASTERROR'"' '"_Ok"'
      call abort
    end
end
return

filter:
  adres = arg(1)
  lngth = arg(2)
  lf    = '0a'x

  lnfd = pos(lf, adres)
  if lnfd ~=0 then do
    adres = delstr(adres, lnfd)
  end

  haak = lastpos(')', adres)
  if haak ~=0 then do
    adres =  delstr(adres, haak)
  end

  hook = lastpos('>', adres)
  if hook ~=0 then do
    adres =  delstr(adres, hook)
  end

  komma = pos(',', adres)
  if komma ~= 0 then do
    adres = delstr(adres, komma)
  end

  quote = pos("'", adres)
  if quote ~= 0 then do
    adres = delstr(adres, quote)
  end

  dquote = pos('"', adres)
  if dquote ~= 0 then do
    adres = delstr(adres, dquote)
  end

  email = part1'@'part2'.'adres
  lengte2 = length(email)
return

abort:
  call close(tmp)
  call delete(tempfile)
exit