home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD1.iso / Database / HF-ADM23.LHA / ADM / ARexx / IntuiNews-Export.adm < prev    next >
Encoding:
Text File  |  1995-06-04  |  2.8 KB  |  142 lines
  1.  
  2. /* $VER: IntuiNews-Export.adm 1.2 (29.4.95)
  3.  
  4.    von Kai Bolay.
  5.  
  6.    Speichert alle EMail-Adressen in einer Datei im Format des
  7.    UMS-Mail/Newsreaders IntuiNews.
  8.  
  9.    Es wird eine Datei mit dem Dateinamen, der in der
  10.    UMS.Config-Variable "IntuiNews.book" definiert ist, angelegt.
  11.  
  12.    1.0  [kaib]           - erstes Release
  13.    1.2  [jan]  29.4.95   - RexxReqTools-Name - und Passworteingabe
  14.                          - Anpassung an ADM>1.46: CRs aus Bemerkung
  15.                            löschen!
  16. */
  17.  
  18. OPTIONS RESULTS
  19.  
  20. SIGNAL ON BREAK_C
  21. SIGNAL ON BREAK_D
  22. SIGNAL ON BREAK_E
  23. SIGNAL ON BREAK_F
  24. SIGNAL ON ERROR
  25. SIGNAL ON HALT
  26. SIGNAL ON IOERR
  27. SIGNAL ON SYNTAX
  28.  
  29. NL = "0a"x
  30.  
  31. libname = "ums.library"
  32. reqname = "rexxreqtools.library"
  33.  
  34.  
  35. if ~show("L", libname) then do
  36.   if ~addlib(libname, 0, -210, 8) then do
  37.     say libname "not found!"
  38.   end
  39. end
  40.  
  41. if ~show("L", reqname) then do
  42.   if ~addlib(reqname, 0, -30, 0) then do
  43.     say reqname "not found!"
  44.   end
  45. end
  46.  
  47.  
  48. /* Passworteingabe */
  49.  
  50. passname = rtgetstring("sysop",'Bitte UMS-Username eingeben',"IntuiNews-Export")
  51. IF passname = "" THEN EXIT
  52. password = rtgetstring("",'Bitte Passwort eingeben',"IntuiNews-Export")
  53.  
  54.  
  55. /* UMS-Login */
  56.  
  57. account = UMSLogin(passname,password)
  58. if account = 0 then do
  59.   say "unable to login."
  60.   exit 10
  61. end
  62. filename = UMSReadConfig(account, "IntuiNews.Book")
  63. call UMSLogout(account)
  64.  
  65.  
  66. IF ~OPEN(file,filename,"W") THEN DO   /* Ausgabedatei öffnen     */
  67.    SAY "Kann Ausgabedatei nicht öffnen!"
  68.    EXIT
  69. END
  70.  
  71.  
  72. LOCKGUI
  73. ADDRINMEM
  74. numadr = RESULT
  75.  
  76. IF numadr<1 THEN DO
  77.    SAY "Keine Adressen im Speicher"
  78.    EXIT
  79. END
  80.  
  81. ACTIVATEFIRST
  82.  
  83. DO FOR numAdr UNTIL RESULT=-1
  84.  
  85.    GETADDRESS ADR
  86.  
  87.    IF RESULT=0 THEN DO
  88.       IF ADR.EMAIL1 ~= "" then do
  89.  
  90.         /* CRs aus Bemerkung löschen */
  91.  
  92.         parse var ADR.REMARK1 ADR.REMARK1 '0A'x .
  93.  
  94.         ok = WriteLn(file,ADR.FIRSTNAME ADR.LASTNAME)
  95.         ok = WriteLn(file,ADR.REMARK1)
  96.         ok = WriteLn(file,MakeEMail(ADR.EMAIL1))
  97.         IF ADR.EMAIL2 ~= "" then do
  98.           ok = WriteLn(file,MakeEMail(ADR.EMAIL2))
  99.         end
  100.         ok = WriteLn(file,"")
  101.       end
  102.  
  103.       ACTIVATENEXT                   /* Akt. naechsten Eintrag */
  104.    END
  105. END
  106. ok = Close(file)
  107.  
  108. RC = 0
  109.  
  110. BREAK_C:
  111. BREAK_D:
  112. BREAK_E:
  113. BREAK_F:
  114. ERROR:
  115. HALT:
  116. IOERR:
  117. SYNTAX:
  118.  
  119. UNLOCKGUI
  120.  
  121. IF RC ~= 0 THEN DO
  122.   SAY "Error: " rc errortext(rc) "Line" sigl
  123. END
  124.  
  125. exit
  126.  
  127. MakeEMail: procedure
  128.   parse arg admemail
  129.   if left(admemail,5) = "UUCP=" then do
  130.     return right(admemail,length(admemail)-5)
  131.   end; else if left(admemail,5) = "FIDO=" then do
  132.     return right(admemail,length(admemail)-5) || "@fidonet"
  133.   end; else if left(admemail,4) = "ZER=" then do
  134.     return right(admemail,length(admemail)-4) || ".sub.org"
  135.   end; else if left(admemail,5) = "MAUS=" then do
  136.     return right(admemail,length(admemail)-5)
  137.   else
  138.     say admemail
  139.     return
  140.   end
  141. end
  142.