home *** CD-ROM | disk | FTP | other *** search
/ Amiga Times / AmigaTimes.iso / programme / ADM36 / TerminTool / TerminTool.lha / adm / ADMGebList.adm < prev   
Encoding:
Text File  |  1997-03-30  |  9.4 KB  |  313 lines
  1. /* $VER: ADMGeblist V 1.3 (22.03.97) © Bernd Stange
  2.  
  3. Erstellt ein Geburtstagsliste im ASCII Format,aus der man sich
  4. mit ADMGebStart an fällige Geurtstage erinnern lassen kann
  5.  
  6. Aenderungen:
  7.  
  8. 1.3 [jan]   Waitforport ersetzt, da es bei manchen Installationen
  9.             nicht in sys:rexxc zu liegen scheint
  10.  
  11. */
  12. /**************************************************************************/
  13. /************************************************************************/
  14.  
  15. ver = 'V 1.3'
  16.  
  17. IF EXISTS('ENV:ADMscPrefs') THEN PfadVariable = 'ENV:'
  18. ELSE
  19. PfadVariable = 'S:'
  20.  
  21. IF ~EXISTS(PfadVariable'ADMscPrefs') THEN CALL Fehler1
  22. IF ~EXISTS(PfadVariable'ADMscPrefs/PfadADM') THEN CALL Fehler2
  23. IF ~EXISTS(PfadVariable'ADMscPrefs/PfadADMDaten') THEN CALL Fehler3
  24. IF ~EXISTS(PfadVariable'ADMscPrefs/PfadADMGebliste') THEN CALL Fehler4
  25. IF ~EXISTS(PfadVariable'ADMscPrefs/CheckAktuell') THEN CALL Fehler5 /* Neu */
  26. CALL OPEN(ADM,PfadVariable'ADMscPrefs/PfadADM',R)
  27. CALL OPEN(ADMDaten,PfadVariable'ADMscPrefs/PfadADMDaten',R)
  28. CALL OPEN(ADMGebliste,PfadVariable'ADMscPrefs/PfadADMGebliste',R)
  29. CALL OPEN(CheckAktuell,PfadVariable'ADMscPrefs/CheckAktuell',R)  /* Neu */
  30. Adressmaster = ReadLn(ADM)
  31. ADMGebliste = ReadLn(ADMGebliste)
  32. ADMDaten = ReadLn(ADMDaten)
  33. CheckAktuell = ReadLn(CheckAktuell)
  34. IF Adressmaster = 'nicht gesetzt' THEN CALL Fehler2
  35. IF ADMDaten = 'nicht gesetzt' THEN CALL Fehler3
  36. IF ADMGebliste = 'nicht gesetzt' THEN CALL Fehler4
  37. IF CheckAktuell = 'nicht gesetzt' THEN CALL Fehler5 /* neu */
  38. CALL CLOSE(ADM)
  39. CALL CLOSE(ADMDaten)
  40. CALL CLOSE(ADMGebliste)
  41. CALL CLOSE(CheckAktuell) /* neu */
  42. /*trace(ri)*/
  43. IF ~SHOW(LIBRARIES,'rexxsupport.library') THEN
  44.    IF ~ADDLIB('rexxsupport.library',0,-30,0) THEN
  45.       EXIT 10
  46. IF ~SHOW(LIBRARIES,'rexxreqtools.library') THEN
  47.    IF ~ADDLIB('rexxreqtools.library',0,-30,0) THEN
  48.       EXIT 10
  49. IF EXISTS(ADMGebliste) THEN DO
  50.        Call OPEN(sort,ADMGebliste,R)
  51.         CALL OPEN(Termin,'T:.Termin',W)
  52.       DO IT = 1 WHILE ~EOF(sort)
  53.        linie = Readln(sort)
  54.          check = WORD(linie,4)
  55.        IF check = 'Termin:' THEN DO
  56.           CALL WRITELN(Termin,linie)
  57.        END
  58.      END
  59.        Call CLOSE(sort)
  60.         Call CLOSE(Termin)
  61. END
  62.  
  63.  
  64. IF ~SHOW(PORTS,'ADM.1') THEN DO
  65.   IF ~EXISTS('c:wbrun') THEN DO
  66.     ADDRESS COMMAND
  67.     'run >NIL:' AddressMaster
  68.     END
  69.    ELSE DO
  70.    ADDRESS COMMAND
  71.    'C:WBRun >NIL:' AddressMaster
  72.    END
  73.  
  74.    i = 0
  75.    DO WHILE ~SHOW(PORTS,'ADM.1') & i<8
  76.        CALL delay(50)
  77.        i = i + 1
  78.    END
  79.    IF ~SHOW(PORTS,'ADM.1') THEN DO
  80.        SAY 'Kann AddressMaster nicht starten!'
  81.        EXIT
  82.    END
  83. END
  84.  
  85.  
  86. ADDRESS 'ADM.1'
  87. OPEN ADMDaten
  88.  
  89. OPTIONS RESULTS                               /* Rückgabewerte zulassen   */
  90.  
  91. ADDRINMEM                                     /* Anzahl Adressen holen    */
  92. numadr = RESULT
  93.  
  94. IF ~OPEN(datei,"T:.tmp1","W") THEN DO       /* Ausgabedatei öffnen      */
  95.    SAY "Kann Ausgabedatei nicht öffnen!"
  96.    EXIT
  97. END
  98.  
  99. ACTIVATEFIRST                                 /* Ersten Eintr. aktivieren */
  100.  
  101. /* ----------------------------------------------------------------------
  102.    AUSGABE
  103.    ---------------------------------------------------------------------- */
  104.  
  105. DO FOR numAdr
  106.  
  107.    GETADDRESS ADM                             /* Adresse -> Stemvar ADM   */
  108.  
  109.    geb = ADM.BIRTHDAY                         /* Geburtstag holen         */
  110.  
  111. SIGNAL ON SYNTAX   /* Formatcheck */
  112.  
  113.    IF geb ~= "" THEN DO
  114.  
  115.       p   = POS(".",geb)                      /* Ersten Punkt suchen      */
  116.       day = STRIP( SUBSTR( geb, 1, p-1))      /* -> Tag                   */
  117.  
  118.       geb = DELSTR( geb, 1, p)
  119.  
  120.       p   = POS(".",geb)                      /* Zweiten Punkt suchen     */
  121.       mon = STRIP( SUBSTR( geb, 1, p-1))      /* -> Monat                 */
  122.  
  123.       yea = DELSTR( geb, 1, p)                /* Rest ist Jahr            */
  124.  
  125.  
  126.       IF ADM.SALUTATION = "Herrn" THEN Gesch = "H"
  127.       IF ADM.SALUTATION = "Frau"  THEN Gesch = "F"
  128.       IF ADM.SALUTATION = "Fräulein"  THEN Gesch = "F"
  129.       IF ADM.TELEPHONE = "" THEN ADM.TELEPHONE = '?'
  130.       IF ADM.firstname = "" THEN name = ADM.lastName'- '  COMPRESS(ADM.TELEPHONE)
  131.       ELSE name = ADM.firstname ADM.lastName     COMPRESS(ADM.TELEPHONE)
  132.  
  133. IF ADM.SORT = "COMPANY" THEN DO
  134.             NAME = 'Firma' COMPRESS(ADM.COMPANY) COMPRESS(ADM.TELEPHONE)
  135.             Gesch = "X"
  136.      END
  137.  
  138.       /* Falls Zahlen nur einstellig angegeben, werden sie hier erweitert */
  139.  
  140.       IF LENGTH(yea) = 2 THEN yea = "19" || yea
  141.       IF yea = '?' THEN yea = '????'
  142.       IF yea = ' ' THEN yea = '????'
  143.       IF LENGTH(mon) = 1 THEN mon = "0" || mon
  144.       IF LENGTH(day) = 1 THEN day = "0" || day
  145.  
  146.  
  147.  
  148.       ok = WriteLn(datei, mon || "-" || day || "-" || yea || "-" || Gesch'    '||  name)
  149. END
  150.  
  151.    ACTIVATENEXT                                 /* Akt. naechsten Eintrag */
  152.  
  153. END
  154.  
  155. ok = WriteLn(datei,"99.99.99")                  /* Dateiende = 99.99.99   */
  156. ok = CLOSE(datei)
  157.  
  158. ADDRESS COMMAND "SORT T:.tmp1 TO T:.tmp2"             /* Sort-Kommando aufrufen */
  159.  
  160. IF ~OPEN(datei,"T:.tmp2","R") THEN DO         /* Sortierte Datei öffnen */
  161.    SAY "Kann Eingabedatei nicht öffnen!"
  162.    EXIT
  163. END
  164.  
  165. IF ~OPEN(out,ADMGebliste,"W") THEN DO
  166.    SAY 'Kann' ADMGebliste 'nicht öffnen !'
  167.    EXIT
  168. END
  169.  
  170.  
  171. DO i = 1 UNTIL geb = "99.99.99"
  172.  
  173.    geb = ReadLn(datei)                          /* Zeile einlesen   */
  174.  
  175.       IF geb ~= "99.99.99" THEN DO
  176.  
  177.           p   = POS("-",geb)                    /* Monat abtrennen  */
  178.           mon = STRIP( SUBSTR( geb, 1, p-1))
  179.  
  180.           geb = DELSTR( geb, 1, p)
  181.           p   = POS("-",geb)                    /* Tag abtrennen    */
  182.           day = STRIP( SUBSTR( geb, 1, p-1))
  183.  
  184.           geb = DELSTR( geb, 1, p)
  185.           p   = POS("-",geb)
  186.           yea = STRIP( SUBSTR( geb, 1, p-1))    /* Jahr abtrennen   */
  187.  
  188.           dat = SUBSTR( DATE(s), 1, 4)          /* Akt. Jahr holen  */
  189.  
  190.           IF yea = '????' THEN OLD = '?'
  191.           ELSE
  192.           old = dat - yea                       /* Ergibt Alter der */
  193.                                                 /*           Person */
  194.  
  195.  
  196.           /* Monat durch ausgeschriebenen Monatsnamen ersetzen */
  197.  
  198.           nam = DELSTR( geb, 1, p)
  199.           IF mon = 1  THEN month = "01"
  200.           IF mon = 2  THEN month = "02"
  201.           IF mon = 3  THEN month = "03"
  202.           IF mon = 4  THEN month = "04"
  203.           IF mon = 5  THEN month = "05"
  204.           IF mon = 6  THEN month = "06"
  205.           IF mon = 7  THEN month = "07"
  206.           IF mon = 8  THEN month = "08"
  207.           IF mon = 9  THEN month = "09"
  208.           IF mon = 10 THEN month = "10"
  209.           IF mon = 11 THEN month = "11"
  210.           IF mon = 12 THEN month = "12"
  211.  
  212.  
  213.           /* Zeile erstellen & schreiben */
  214.  
  215.           line = day month yea
  216.           line = INSERT(old,line,11)
  217.           line = INSERT(nam, line,14)
  218.  
  219.           ok = WriteLn(out,line)
  220.  
  221. IF RC = 5 THEN DO
  222.  
  223.       Titel = 'Erstelle Geburtstagsliste:'
  224.       Flags = 'rtez_flags = ezreqf_centertext'
  225.       ReqText = 'Fehler' ||'0A'x|| 'Geburtstagsdatei konnte nicht erstellt werden !'
  226.       Auswahl = rtezrequest(Reqtext,,Titel,Flags)
  227. SYNTAX:
  228.       Titel = 'Erstelle Geburtstagsliste:'
  229.       Flags = 'rtez_flags = ezreqf_centertext'
  230.       ReqText = 'F E H L E R :' (RC) || '0A'x || 'Falsches Geburtstagsformat im ADM entdeckt !' || '0A'x || '0A'x 'Notwendiges Format: TT.MM.JJJJ oder TT.MM.'
  231.       Auswahl = rtezrequest(Reqtext,,Titel,Flags)
  232.  
  233. CALL CLOSE(datei)
  234. CALL CLOSE(out)
  235.  
  236. ADDRESS COMMAND
  237. "DELETE >NIL: T:.tmp1 T:.tmp2 T:.Termin "
  238.  
  239. EXIT                             /* Programmende */
  240. END
  241.  
  242.     END
  243. END
  244.  
  245. CALL CLOSE(datei)
  246. CALL CLOSE(out)
  247.  
  248.    Titel = Ver  'Erstelle Geburtstagsliste:'
  249.      Gebanzahl = i-1
  250.       IF EXISTS('T:.Termin') THEN DO
  251.       IT = IT-2
  252.       Terminanzahl = IT-Gebanzahl
  253.        IF Terminanzahl <= '0' THEN DO
  254.         Termintext = 'Termineintrag'
  255.         Terminanzahl = 'keine'
  256.        END
  257.       END
  258.      ELSE
  259.      Terminanzahl = 'keine'
  260.  
  261. IF Terminanzahl = 1 THEN Termintext = 'Termineintrag'
  262. ELSE Termintext = 'Termineinträge'
  263.       Flags = 'rtez_flags = ezreqf_centertext'
  264.       ReqText = 'Die Geburtstagsdatei wurde erstellt !' ||'0A'x|| 'In der Liste stehen jetzt' Gebanzahl 'Geburtstagseinträge' ||'0A'x|| 'und' Terminanzahl Termintext '!'
  265.       Auswahl = rtezrequest(Reqtext,,Titel,Flags)
  266.  
  267.  
  268. IF EXISTS('T:.Termin') THEN DO
  269. ADDRESS COMMAND
  270. 'Type' 'T:.Termin' '>>' ADMGebliste
  271. END
  272.  
  273. ADDRESS COMMAND
  274. "DELETE >NIL: T:.tmp1 T:.tmp2 T:.Termin"
  275.  
  276. IF CheckAktuell ~= 'NEIN' & CheckAktuell ~= 'nicht gesetzt' THEN DO
  277.    ADDRESS COMMAND
  278.    'list' ADMDaten 'LFormat="%d %t" >t:dat'
  279.    CALL OPEN(datum,'t:dat',R)
  280.    Dat = READLN(datum)
  281.    CALL CLOSE(datum)
  282.    ADDRESS COMMAND
  283.    'DELETE t:dat >NIL:'
  284.    'c:setdate' ADMGebliste Dat
  285. END
  286.  
  287. EXIT                             /* Programmende */
  288.  
  289.  
  290.  
  291. Fehler1:
  292.          Reqtext = 'Achtung Fehler1:'||'0A'x|| '' ||'0A'x|| 'Bitte erst mit ADMscPrefs alle notwendigen Variablen einstellen !'
  293.          CALL Requester
  294. Fehler2:
  295.          Reqtext = 'Achtung Fehler2:'||'0A'x|| '' ||'0A'x|| 'Bitte erst mit ADMscPrefs den Pfad vom AdressMaster einstellen !'
  296.          CALL Requester
  297. Fehler3:
  298.          Reqtext = 'Achtung Fehler3:'||'0A'x|| '' ||'0A'x|| 'Bitte erst mit ADMscPrefs den Pfad des ADMDatensatzes' ||'0A'x|| 'von ADM anwählen !'
  299.          CALL Requester
  300. Fehler4:
  301.          Reqtext = 'Achtung Fehler4:'||'0A'x|| '' ||'0A'x|| 'Bitte erst mit ADMscPrefs den Pfad für die Gebdatei anwählen ! '
  302.          CALL Requester
  303. Fehler5:
  304.          Reqtext = 'Achtung Fehler5:'||'0A'x|| '' ||'0A'x|| 'Bitte erst mit ADMscPrefs die Variable Checkaktuell setzen !'
  305.          CALL Requester
  306.  
  307. Requester:
  308. Flags  = 'rtez_flags = ezreqf_centertext'
  309. Titel  = Ver 'Fehlermeldung:'
  310. Gadget  = '_OK'
  311. Auswahl = rtezrequest(Reqtext,Gadget,Titel,Flags)
  312. EXIT
  313.