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