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