home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / birth10.zip / BIRTHDAY.CMD < prev    next >
OS/2 REXX Batch file  |  1994-03-07  |  32KB  |  967 lines
  1. /*
  2.  
  3. Birthday Reminder 1.0
  4.  
  5. (C) 1994 by Wolfram Koerner
  6.  
  7. FREEWARE but: Please do not spread it after you changed it. If you have bugs or
  8. improvements tell them to me. So we can implement them together and no version-
  9. confusion will raise:
  10.  
  11.           Internet : koerner@cip.informatik.uni-wuerzburg.de
  12.  
  13.           Fido     : Wolfram Koerner@2:2490/5100.8
  14.  
  15.           Snailmail: Wolfram Koerner
  16.                      Friedenstrasse 5a
  17.                      97072 Wuerzburg
  18.                      GERMANY
  19.  
  20. */
  21.  
  22.  
  23. /* ********Load RexxUtil.DLL functions ********** */
  24. call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  25. call SysLoadFuncs
  26.  
  27. /* ******************Init variables************** */
  28. DBFile="C:\BIRTHDAY.DAT"
  29. DBFirstLine = "Birthday Database 1.0"
  30. Sortindex = 3
  31. modeCheckDB = 0
  32. modeQuiet=0
  33. RecCount = 0
  34. global_again = 1
  35.  
  36. daysOfMonth.1  = 31
  37. daysOfMonth.2  = 28
  38. daysOfMonth.3  = 31
  39. daysOfMonth.4  = 30
  40. daysOfMonth.5  = 31
  41. daysOfMonth.6  = 30
  42. daysOfMonth.7  = 31
  43. daysOfMonth.8  = 31
  44. daysOfMonth.9  = 30
  45. daysOfMonth.10 = 31
  46. daysOfMonth.11 = 30
  47. daysOfMonth.12 = 31
  48.  
  49. CurDate =Date("USA")
  50. CurMM   = GetMM(CurDate)
  51. CurDD   = GetDD(CurDate)
  52. CurMMDD = GetMMDD(CurDate)   /* Month and Day mm/dd */
  53. CurYY   = GetYY(CurDate)
  54.  
  55. /* ******************Init program**************** */
  56. call InitColors    /* Init ANSI colors */
  57. parse arg cmdline  /* Store all given Command parameters in CMDLINE */
  58. if cmdline \= "" then
  59.      call AnalyzeCmdLine
  60.  
  61.  
  62. /*  -----------------------------MAIN-------------------------------- */
  63. call LoadDB
  64.  
  65. if modeCheckDB = 0 then do
  66.     do while global_again=1
  67.        Men = MainMenu()
  68.        if Men="L" then
  69.       call ListDB
  70.        if Men="P" then
  71.           call PrintDB
  72.        if Men="R" then
  73.           call ResetDB
  74.        if Men="S" then do
  75.           if Sortindex=1 then Sortindex=3
  76.                          else Sortindex=1
  77.           call SysCls
  78.           call SortDB
  79.        end
  80.        if Men="A" then
  81.       call AddRecord
  82.        if Men="E" then
  83.           call EditRecord
  84.        if Men="D" & RecCount>0 then
  85.       call DeleteRecord
  86.        if Men="C" then
  87.       call CheckDB
  88.        if Men="Q" then do
  89.       if RecCount>0 then
  90.          call SaveDB
  91.       global_again=0
  92.        end
  93.     end
  94. end
  95. else do
  96.     call CheckDB
  97.     if RecCount>0 then
  98.        call SaveDB
  99. end  /* else */
  100. exit 0
  101.  
  102.  
  103. /*  ----------------------Procedures and Subroutines------------------- */
  104.  
  105. /* ****************************************
  106.    * PlaySong
  107.    * Plays "Happy Birthday to you."
  108.    **************************************** */
  109. PlaySong:
  110.   if ModeQuiet=1 then return
  111.   call beep 262,100
  112.   call beep 262,100
  113.   call beep 294,200
  114.   call beep 262,200
  115.   call beep 349,200
  116.   call beep 330,300
  117. return
  118.  
  119.  
  120. /* ********************************************
  121.    * WarningSound
  122.    ******************************************** */
  123. WarningSound:
  124.   if ModeQuiet=1 then return
  125.   call beep 349,100
  126.   call beep 294,100
  127. return
  128.  
  129.  
  130. /* **********************************************
  131.    * MainMenu
  132.    * returns Letter pressed
  133.    ********************************************** */
  134. MainMenu:
  135.     call SysCls
  136.     if Sortindex=1 then Sortname="NAME"
  137.                    else Sortname="DATE"
  138.     if Sortindex=1 then OtherSortname="DATE"
  139.                    else OtherSortname="NAME"
  140.     a = charout(,byellow||"┌──────────────────────────────────────────────────────────────────────────────┐")
  141.     a = charout(,"│                            Birthday Reminder V1.0                            │")
  142.     a = charout(,"│                                                                              │")
  143.     a = charout(,"│                                Today:"||CurDate||"                                │")
  144.     a = charout(,"│                       Database:"||Format(RecCount,3)||" Recs - "||SortName||" sorted                        │")
  145.     a = charout(,"├──────────────────────────────────────────────────────────────────────────────┤")
  146.     a = charout(,"│                                                                              │")
  147.     a = charout(,"│                                                                              │")
  148.     a = charout(,"│                                                                              │")
  149.     a = charout(,"│"||bcyan||"                       L ..... List complete database                         "||byellow||"│")
  150.     a = charout(,"│"||bcyan||"                       P ..... Print database                                 "||byellow||"│")
  151.     a = charout(,"│"||bcyan||"                       R ..... Reactivate passive events                      "||byellow||"│")
  152.     a = charout(,"│"||bcyan||"                       S ..... Sort database by: "||OtherSortname||"                         "||byellow||"│")
  153.     a = charout(,"│"||bcyan||"                       C ..... Check for birthdays                            "||byellow||"│")
  154.     a = charout(,"│                                                                              │")
  155.     a = charout(,"│"||bcyan||"                       A ..... Add a record                                   "||byellow||"│")
  156.     a = charout(,"│"||bcyan||"                       E ..... Edit a record                                  "||byellow||"│")
  157.     a = charout(,"│"||bcyan||"                       D ..... Delete a record                                "||byellow||"│")
  158.     a = charout(,"│                                                                              │")
  159.     a = charout(,"│"||bcyan||"                       Q ..... Quit program (and save data)                   "||byellow||"│")
  160.     a = charout(,"│                                                                              │")
  161.     a = charout(,"│                                                                              │")
  162.     a = charout(,"│                                                                              │")
  163.     a = charout(,"└────────────────────────────────────────────────────────────────────(C)'94 WOK┘")
  164.     call GotoXY 26,21
  165.     a = charout(,byellow||"----> YOUR CHOICE")
  166.     call GotoXY 24,21
  167.     again=1
  168.     do while again=1
  169.        MM_key=Translate(SysGetKey('NOECHO'))
  170.        if MM_key="L"|,
  171.       MM_key="A"|,
  172.       MM_key="D"|,
  173.           MM_key="E"|,
  174.           MM_key="R"|,
  175.           MM_key="S"|,
  176.       MM_key="C"|,
  177.           MM_key="P"|,
  178.           MM_key="Q" then do
  179.              again=0
  180.              say MM_key
  181.        end
  182.     end
  183.     say normal
  184. return MM_key
  185.  
  186.  
  187. /* **********************************************
  188.    * AddRecord
  189.    ********************************************** */
  190. AddRecord:
  191.    call SysCls
  192.    say bcyan||"Add a record to database:"
  193.    say "-------------------------"||normal
  194.    say
  195.    say "Enter Name (max 25 chars, <enter> to abort):"
  196.    say "........................."
  197.    call GotoXY 0,WhereY()-1
  198.    parse pull aString
  199.    if aString = "" then return
  200.    dbdummy.1 = substr(aString,1,min(25,length(aString)))
  201.  
  202.    say "Enter Memo (max 20 chars):"
  203.    say "...................."
  204.    call GotoXY 0,WhereY()-1
  205.    parse pull aString
  206.    dbdummy.2 = substr(aString,1,min(20,length(aString)))
  207.  
  208.    again = 1
  209.    do while again = 1
  210.        say "Enter Birthday (mm/dd/yy):"
  211.        parse pull aString
  212.        say
  213.        if substr(aString,3,1)='/',           /* Test Input */
  214.     & substr(aString,6,1)='/',
  215.     & length(aString)=8 then
  216.          again = 0
  217.     else
  218.          say bred||"ERROR: Please enter Birthday again."||normal
  219.        dbdummy.3 = aString
  220.    end
  221.  
  222.    say "Enter prewarning-days (0 <= days <= 28):"
  223.    loopready = 0
  224.    do until loopready=1
  225.        pull dbdummy.4
  226.        if   dbdummy.4 = "" then dbdummy.4=0
  227.        if datatype(dbdummy.4) = "NUM",
  228.           & dbdummy.4>=0 ,
  229.           & dbdummy.4<=28 then
  230.          loopready=1
  231.       else
  232.              say bred||"ERROR: Enter a number from 0 to 28 !"||normal
  233.    end
  234.    dbdummy.5 = 0
  235.  
  236.    InsertPos = 1              /* search correct insert-position*/
  237.    if RecCount > 0 then do    /* At least one record already in database ? */
  238.       do while dbdummy.Sortindex > db.Sortindex.InsertPos
  239.          InsertPos = InsertPos +1
  240.       end
  241.       do MoveFrom = RecCount to InsertPos by -1
  242.          MoveTo = MoveFrom +1
  243.          db.1.MoveTo = db.1.MoveFrom
  244.          db.2.MoveTo = db.2.MoveFrom
  245.          db.3.MoveTo = db.3.MoveFrom
  246.          db.4.MoveTo = db.4.MoveFrom
  247.          db.5.MoveTo = db.5.MoveFrom
  248.          db.6.MoveTo = db.6.MoveFrom
  249.       end
  250.    end /* if */
  251.    db.1.InsertPos = dbdummy.1
  252.    db.2.InsertPos = dbdummy.2
  253.    db.3.InsertPos = dbdummy.3
  254.    db.4.InsertPos = dbdummy.4
  255.    db.5.InsertPos = dbdummy.5
  256.  
  257.    RecCount = RecCount +1
  258.    call UpdateRecord InsertPos
  259. return
  260.  
  261.  
  262. /* **********************************************
  263.    * EditRecord
  264.    ********************************************** */
  265. EditRecord:
  266.   if RecCount>0 then do
  267.     call SysCls
  268.     say bcyan||"Edit Record in database:"
  269.     say "------------------------"||normal
  270.     say
  271.     say "Please enter number of record you wish to EDIT (from 1 to "||RecCount||")"
  272.     say "Hit <enter> to abort."
  273.     ER_i=0
  274.     do while ER_i<1 | ER_i>RecCount
  275.       pull ER_i
  276.       if ER_i="" then return
  277.     end
  278.     ER_again=1
  279.     do while ER_again=1
  280.         call SysCls
  281.         say bcyan"EDIT Record No."ER_i
  282.         say
  283.         say
  284.         say "N ..... Name            : "db.1.ER_i
  285.         say
  286.         say "M ..... Memo            : "db.2.ER_i
  287.         say
  288.         say "B ..... Birthday        : "db.3.ER_i
  289.         say
  290.         say "P ..... Pre-Warningdays : "db.4.ER_i
  291.         say
  292.         say "E ..... EXIT TO MAINMENU"
  293.         say
  294.         say byellow||"  ----> Your choice"
  295.         call GotoXY 0, WhereY()-1
  296.         ER_key=Translate(SysGetKey('NOECHO'))
  297.         ER_again2=1
  298.         do while ER_again2=1
  299.             if ER_key="N"|,
  300.                ER_key="M"|,
  301.                ER_key="B"|,
  302.                ER_key="P"|,
  303.                ER_key="E" then do
  304.                   ER_again2=0
  305.                   say MM_key
  306.                   say
  307.             end /* if */
  308.         end /* do */
  309.  
  310.         if ER_key="E" then ER_again=0                               /* EXIT */
  311.  
  312.         if ER_key="N" then do                                       /* NAME */
  313.             say "Enter Name (max 25 chars, <enter> to abort):"
  314.             say "........................."
  315.             call GotoXY 0,WhereY()-1
  316.             parse pull aString
  317.             if aString <> "" then
  318.                db.1.ER_i = substr(aString,1,min(25,length(aString)))
  319.         end /* if NAME-Edit */
  320.  
  321.         if ER_key = "M" then do                                      /* MEMO */
  322.             say "Enter Memo (max 20 chars):"
  323.             say "...................."
  324.             call GotoXY 0,WhereY()-1
  325.             parse pull aString
  326.             if aString <> "" then
  327.                db.2.ER_i = substr(aString,1,min(20,length(aString)))
  328.         end /* if MEMO-Edit */
  329.  
  330.         if ER_key = "B" then do                                  /* BIRTHDAY */
  331.             ER_again3 = 1
  332.             do while ER_again3 = 1
  333.                 say "Enter Birthday (mm/dd/yy):"
  334.                 parse pull aString
  335.                 say
  336.                 if aString <> "" then do
  337.                     if substr(aString,3,1)='/',
  338.                      & substr(aString,6,1)='/',
  339.                      & length(aString)=8 then
  340.                           ER_again3 = 0
  341.                      else
  342.                           say bred||"ERROR: Please enter Birthday again."||normal
  343.                     db.3.ER_i = aString
  344.                 end /* if */
  345.             end /* do */
  346.         end /* if Birthday-Edit */
  347.  
  348.         if ER_key = "P" then do                                /* PREWARNING */
  349.                 say "Enter prewarning-days (0 <= days <= 28):"
  350.                 ER_again3 = 0
  351.                 do until ER_again3=1
  352.                     pull db.4.ER_i
  353.                     if   db.4.ER_i = "" then db.4.ER_i=0
  354.                     if datatype(db.4.ER_i) = "NUM",
  355.                        & db.4.ER_i>=0 ,
  356.                        & db.4.ER_i<=28 then
  357.                           ER_again3=1
  358.                        else
  359.                           say bred||"ERROR: Enter a number from 0 to 28 !"||normal
  360.                 end /* do */
  361.          end /* if PreWarning-Edit */
  362.     end /* do while ER_again=1 */
  363.     db.5.ER_i = 0
  364.     call UpdateRecord ER_i
  365.     call SortDB
  366.   end /* if RecCount>0 */
  367. return
  368.  
  369.  
  370. /* **********************************************
  371.    * DeleteRecord
  372.    ********************************************** */
  373. DeleteRecord:
  374.   if RecCount>0 then do
  375.     call SysCls
  376.     say bcyan||"Delete record from database:"
  377.     say "----------------------------"||normal
  378.     say
  379.     say "Please enter number of record you wish to DELETE (from 1 to "||RecCount||")"
  380.     say "Hit <enter> to abort."
  381.     DR_i=0
  382.     do while DR_i<1 | DR_i>RecCount
  383.       pull DR_i
  384.       if DR_i="" then return
  385.     end
  386.     call ListRecord DR_i
  387.     say bred||"WARNING: Do you really want to DELETE this Record (Y/N) ?"
  388.     answer = ""
  389.     do until answer = "Y" | answer = "N"
  390.        pull answer
  391.     end
  392.     if answer = "Y" then do
  393.     do ii=DR_i to RecCount-1
  394.        iii = ii+1
  395.        db.1.ii = db.1.iii
  396.        db.2.ii = db.2.iii
  397.        db.3.ii = db.3.iii
  398.        db.4.ii = db.4.iii
  399.            db.5.ii = db.5.iii
  400.            db.6.ii = db.6.iii
  401.     end
  402.     RecCount = RecCount -1
  403.     end
  404.   end /* if */
  405. return
  406.  
  407.  
  408.  
  409. /* **********************************************
  410.    * ListRecord(n)
  411.    ********************************************** */
  412. ListRecord:
  413.     LR_i=arg(1)
  414.     say LR_i
  415.     call GotoXY 5,WhereY()-1
  416.     say db.1.LR_i
  417.     call GotoXY 35,WhereY()-1
  418.     say db.2.LR_i
  419.     call GotoXY 57,WhereY()-1
  420.     say db.3.LR_i
  421.     call GotoXY 65,WhereY()-1
  422.     say" ("||db.4.LR_i||")"
  423.     call GotoXY 71,WhereY()-1
  424.     say ":"||db.5.LR_i||" #"||db.6.LR_i
  425. return
  426.  
  427.  
  428. /* **********************************************
  429.    * PrintDB
  430.    ********************************************** */
  431. PrintDB:
  432.     if RecCount > 0 then do
  433.        call SysCls
  434.        say bcyan||"Print database to file or device:"
  435.        say "---------------------------------"||normal
  436.        say
  437.        say "Please enter a device/filename for database-output"
  438.        say "e.g. PRN for printer"
  439.        say "     c:\text.txt for a file"
  440.        say "     con for screen"
  441.        pull PDB_Device
  442.        say bred||"WARNING: Do you really want to print the database (Y/N)?"||normal
  443.        answer = ""
  444.        do until answer = "Y" | answer = "N"
  445.           pull answer
  446.        end
  447.        if answer = "Y" then do
  448.           dummy=lineout(PDB_Device,"    Birthday Calendar")
  449.           dummy=lineout(PDB_Device," ")
  450.           if SortIndex = 3 then do
  451.               dummy=lineout(PDB_Device,"    No.    mm/dd/yy (PW)  Name                        Memo               ")
  452.               dummy=lineout(PDB_Device,"    ---------------------------------------------------------------------")
  453.               do PDB_i = 1 to RecCount
  454.                   DBP_str = "    "||Format(PDB_i,3)
  455.                   DBP_str = DBP_str || "."
  456.                   DBP_str = DBP_str || "   "
  457.                   DBP_str = DBP_str || db.3.PDB_i
  458.                   DBP_str = DBP_str || " (" ||Format(db.4.PDB_i,2)||")  "
  459.                   DBP_str = DBP_str || Insert("",db.1.PDB_i,25)
  460.                   DBP_str = DBP_str || "   "
  461.                   DBP_str = DBP_str || Insert("",db.2.PDB_i,20)
  462.  
  463.                   dummy=lineout(PDB_Device,DBP_str)
  464.               end
  465.          end
  466.          else do
  467.               dummy=lineout(PDB_Device,"    No.    Name                        Memo                   mm/dd/yy (PW)")
  468.               dummy=lineout(PDB_Device,"    -----------------------------------------------------------------------")
  469.               do PDB_i = 1 to RecCount
  470.                   DBP_str = "    "||Format(PDB_i,3)
  471.                   DBP_str = DBP_str || "."
  472.                   DBP_str = DBP_str || "   "
  473.                   DBP_str = DBP_str || Insert("",db.1.PDB_i,25)
  474.                   DBP_str = DBP_str || "   "
  475.                   DBP_str = DBP_str || Insert("",db.2.PDB_i,20)
  476.                   DBP_str = DBP_str || "   "
  477.                   DBP_str = DBP_str || db.3.PDB_i
  478.                   DBP_str = DBP_str || " (" ||Format(db.4.PDB_i,2)||")  "
  479.  
  480.                   dummy=lineout(PDB_Device,DBP_str)
  481.               end
  482.  
  483.          end
  484.          dummy=lineout(PDB_Device)   /* close Device */
  485.        end
  486.     end
  487. return
  488.  
  489.  
  490. /* **********************************************
  491.    * ListDB
  492.    ********************************************** */
  493. ListDB:
  494.     call SysCls
  495.     say "No.  Name                          Memo                  mm/dd/yy (PW) :NE #D"
  496.     say "-----------------------------------------------------------------------------"
  497.     listedlines=0
  498.     do i=1 to RecCount
  499.        call ListRecord i
  500.        listedlines=listedlines+1
  501.        if listedlines=20 & RecCount>i then do              /* List page by page */
  502.       say
  503.       say "---HIT <ENTER> TO CONTINUE---"
  504.       pull dummy
  505.           call SysCls
  506.           say "No.  Name                          Memo                  mm/dd/yy (PW) :NE #D"
  507.           say "-----------------------------------------------------------------------------"
  508.           listedlines=0
  509.        end
  510.     end
  511.     say
  512.     say "Hit Enter..."
  513.     pull dummy
  514. return
  515.  
  516.  
  517. /* ********************************************
  518.    * ResetDB
  519.    * Reacticate passive events
  520.    ******************************************** */
  521. ResetDB:
  522.    if RecCount>0 then do
  523.        call SysCls
  524.        say bcyan||"Reactivate passive events:"
  525.        say "--------------------------"||normal
  526.        say
  527.        say bred||"WARNING: Do you really want to reactivate passive events in database (Y/N)?"||normal
  528.        answer = ""
  529.        do until answer = "Y" | answer = "N"
  530.           pull answer
  531.        end
  532.        if answer = "Y" then do
  533.           do RDB_i = 1 to RecCount
  534.              db.5.RDB_i = 0
  535.              call UpdateRecord RDB_i
  536.           end /* do */
  537.        end /* if */
  538.    end /* if */
  539. return
  540.  
  541.  
  542. /* **********************************************
  543.    * SwapRecords (a,b)
  544.    * Needed by Sortroutine
  545.    ********************************************** */
  546. SwapRecords:
  547.    SR_a=arg(1)
  548.    SR_b=arg(2)
  549.  
  550.    dbhelp.1 = db.1.SR_a
  551.    dbhelp.2 = db.2.SR_a
  552.    dbhelp.3 = db.3.SR_a
  553.    dbhelp.4 = db.4.SR_a
  554.    dbhelp.5 = db.5.SR_a
  555.    dbhelp.6 = db.6.SR_a
  556.  
  557.    db.1.SR_a = db.1.SR_b
  558.    db.2.SR_a = db.2.SR_b
  559.    db.3.SR_a = db.3.SR_b
  560.    db.4.SR_a = db.4.SR_b
  561.    db.5.SR_a = db.5.SR_b
  562.    db.6.SR_a = db.6.SR_b
  563.  
  564.    db.1.SR_b = dbhelp.1
  565.    db.2.SR_b = dbhelp.2
  566.    db.3.SR_b = dbhelp.3
  567.    db.4.SR_b = dbhelp.4
  568.    db.5.SR_b = dbhelp.5
  569.    db.6.SR_b = dbhelp.6
  570. return
  571.  
  572. /* **********************************************
  573.    * SortDB by SortIndex
  574.    ********************************************** */
  575. SortDB:
  576.   if RecCount > 1 then do
  577.       say
  578.       say "Sorting "RecCount" files."
  579.       do SDB_i = 1 to RecCount-1
  580.          say "Processing:"SDB_i"    "
  581.          call GotoXY 0,WhereY()-1
  582.          SDB_min = SDB_i
  583.          do SDB_j = SDB_i+1 to RecCount
  584.              if db.SortIndex.SDB_j < db.SortIndex.SDB_min then SDB_min = SDB_j
  585.          end
  586.          if SDB_min <> SDB_i then
  587.              call SwapRecords SDB_min, SDB_i
  588.       end
  589.   end
  590. return
  591.  
  592.  
  593. /* **********************************************
  594.    * SaveDB
  595.    ********************************************** */
  596. SaveDB:
  597.     say
  598.     say "Saving..."
  599.     do until rc=0 | rc=2
  600.        rc = SysFileDelete(DBFile)
  601.        if rc\=0 & rc \=2 then do
  602.       say bred||"ERROR("||rc||"): Could not delete old Database: "||DBFile
  603.       say bred||"           Try to fix the error and hit <enter>"
  604.       say bred||"           Or hit CTRL-C and <enter> afterwards to terminate."
  605.       pull dummy
  606.        end
  607.     end
  608.     ret=LineOut(DBFile,DBFirstLine)
  609.     ret=LineOut(DBFile,"SortIndex="||SortIndex)
  610.     ret=LineOut(DBFile,"")
  611.     do i=1 to RecCount
  612.        ret=LineOut(DBFile,db.1.i)
  613.        ret=LineOut(DBFile,db.2.i)
  614.        ret=LineOut(DBFile,db.3.i)
  615.        ret=LineOut(DBFile,db.4.i)
  616.        ret=LineOut(DBFile,db.5.i)
  617.        ret=LineOut(DBFile,"")
  618.     end
  619.     ret=LineOut(DBFile)           /* close file */
  620.     Say normal||"OK."
  621. return
  622.  
  623.  
  624. /* **********************************************
  625.    * LoadDB
  626.    ********************************************** */
  627. LoadDB:
  628.     call SysFileTree DBFile, dummy, "FO" ,"**-**" /* exists Database ?? */
  629.     if dummy.0 > 0 then do
  630.      if modeCheckDB = 0 then
  631.         say "Loading..."
  632.      say normal
  633.          dummy = LineIn(DBFile)
  634.          if dummy <> DBFirstLine then do
  635.              say bred||"ERROR: database ("||DBFile||") is not in correct format."
  636.              say bred||"       First line must be:"||DBFirstLine
  637.              say bred||"       Program terminated."
  638.              say normal
  639.              exit 1
  640.          end
  641.          dummy = LineIn(DBFile)
  642.          dummy.1= left(dummy,10)
  643.          dummy.2= right(dummy,1)
  644.          if dummy.1<>"SortIndex=" | (dummy.2<>1 & dummy.2<>3) then do
  645.              say bred||"ERROR: database ("||DBFile||") is not in correct format."
  646.              say bred||"       Second line must be:SortIndex=1 or SortIndex=3"
  647.              say bred||"       Program terminated."
  648.              say normal
  649.              exit 1
  650.          end
  651.          SortIndex = dummy.2
  652.          dummy        =LineIn(DBFile)   /* Empty line behind header */
  653.          if dummy <> "" then do
  654.             say bred||"ERROR: database ("||DBFile||") is not in correct format."
  655.             say bred||"       Third line must be empty."
  656.             say bred||"       Program terminated."
  657.             say normal
  658.             exit 1
  659.          end
  660.          do while Lines(DBFile) \= 0
  661.         RecCount = RecCount +1
  662.         db.1.RecCount=LineIn(DBFile)
  663.         db.2.RecCount=LineIn(DBFile)
  664.         db.3.RecCount=LineIn(DBFile)
  665.             db.4.RecCount=LineIn(DBFile)
  666.             db.5.RecCount=LineIn(DBFile)
  667.         dummy     =LineIn(DBFile)   /* Empty line behind every record */
  668.             if dummy <> "" then do
  669.                say
  670.                say bred||"ERROR: database ("||DBFile||") is not in correct format."
  671.                say bred||"       There must be an empty line behind a record (#"||RecCount||")."
  672.                say bred||"       Program terminated."
  673.                say normal
  674.                exit 1
  675.             end
  676.         if modeCheckDB = 0 then
  677.                 a = charout(,".")
  678.      end
  679.      ret = LineOut(DBFile)             /* Close File */
  680.     end
  681.     Call UpdateDB
  682. return
  683.  
  684.  
  685. /* ******************************************************
  686.    * CheckDB
  687.    * The Checkroutine for warnings and birthdaymessages
  688.    ****************************************************** */
  689. CheckDB:
  690.    if modeCheckDB=0 then call SysCls
  691.    say bcyan"Checking for birthdays:"
  692.    say "-----------------------"||normal
  693.    FoundBirthdays=0
  694.    Call UpdateDB                                /* Update the warningdates ! */
  695.    do i=1 to RecCount
  696.       Age= db.5.i - GetYY(db.3.i)
  697.       if db.6.i = 0 then do
  698.          say bred||"A HAPPY "||Age||". BIRTHDAY TO:"||normal
  699.      call ListRecord i
  700.          call PlaySong
  701.          FoundBirthdays=FoundBirthdays+1
  702.       end
  703.       if db.6.i > 0 then do
  704.          say bred||"WARNING: "||Age||". Birthday in "||db.6.i||" day(s) !"||normal
  705.      call ListRecord i
  706.          call WarningSound
  707.          FoundBirthdays=FoundBirthdays+1
  708.       end
  709.       if db.6.i >= 0 then do
  710.          say "Keep event active (Y/N) <enter>=YES ?"
  711.          answer = ""
  712.          do until answer = "Y" | answer = "N"
  713.             pull answer
  714.             if answer="" then do;answer="Y"; call GotoXY 1,WhereY()-1; say "y"; end
  715.          end
  716.          if answer="N" then do
  717.              db.5.i = db.5.i+1   /* next warning: next year ! */
  718.              call UpdateRecord i
  719.          end
  720.          say normal
  721.       end
  722.    end
  723.    say bcyan"-----------------------"
  724.    say FoundBirthdays "WARNINGS given."||normal
  725.    if modeCheckDB = 0 then do
  726.       say "Hit Enter..."
  727.       pull dummy
  728.    end
  729. return
  730.  
  731.  
  732.  
  733. /* *********************************************
  734.    * UpdateDB
  735.    * Update whole database !
  736.    ********************************************* */
  737. UpdateDB:
  738.    CurDate =Date("USA")
  739.    CurMM   = GetMM(CurDate)
  740.    CurDD   = GetDD(CurDate)
  741.    CurMMDD = GetMMDD(CurDate)   /* Month and Day mm/dd */
  742.    CurYY   = GetYY(CurDate)
  743.  
  744.    do UDB_i=1 to RecCount
  745.       Call UpdateRecord UDB_i
  746.    end
  747. return
  748.  
  749.  
  750. /* *************************************************
  751.    * UpdateRecord(index)
  752.    ************************************************* */
  753. UpdateRecord:
  754.     UR_i=arg(1)
  755.     G_Date= db.3.UR_i
  756.     G_Day = db.4.UR_i
  757.     G_Intervall1 = GetMMDD(DecreaseDate(G_Date, G_Day))
  758.     G_Intervall2 = GetMMDD(G_Date)
  759.  
  760.     if G_Intervall1 <= G_Intervall2 then do /* Normal:  |------1xxx2---------| */
  761.       if db.5.UR_i <= CurYY then do
  762.         db.5.UR_i = CurYY
  763.         if   CurMMDD < G_Intervall1,
  764.            | CurMMDD > G_Intervall2
  765.         then db.6.UR_i = -1                      /* No warning */
  766.         else do
  767.            diffdays=0
  768.            do while GetMMDD(DecreaseDate(G_Date,diffdays)) <> CurMMDD
  769.               diffdays=diffdays+1
  770.            end
  771.            db.6.UR_i = diffdays                  /* Birthday warning */
  772.            drop diffdays
  773.         end /* else */
  774.       end /* if */
  775.       else db.6.UR_i = -1   /* No Warning this year anymore */
  776.       if CurMMDD < G_Intervall1 then db.5.UR_i = CurYY    /* correct */
  777.       if CurMMDD > G_Intervall2 then db.5.UR_i = CurYY+1  /* correct */
  778.     end /* if NORMAL */
  779.  
  780.     if G_Intervall1 >  G_Intervall2 then do /* Wrapped: |xx2---------------1x| */
  781.       if db.5.UR_i < CurYY then db.5.UR_i = CurYY
  782.       if  (db.5.UR_i<=CurYY    & CurMM<=6),
  783.          |(db.5.UR_i = CurYY+1 & CurMM> 6) then do
  784.         if   CurMMDD < G_Intervall1,
  785.            & CurMMDD > G_Intervall2
  786.         then db.6.UR_i = -1                      /* No warning */
  787.         else do
  788.           diffdays=0
  789.           do while GetMMDD(DecreaseDate(G_Date,diffdays)) <> CurMMDD
  790.              diffdays=diffdays+1
  791.           end
  792.           db.6.UR_i = diffdays   /* Birthday Warning */
  793.           drop diffdays
  794.         end /* else */
  795.       end /* if */
  796.       else db.6.UR_i = -1   /* No Warning this year/next year anymore */
  797.       if   CurMMDD>G_Intervall2,
  798.          & CurMMDD<G_Intervall1 then db.5.UR_i = CurYY+1   /* correct */
  799.     end  /* if WRAPPED */
  800. return
  801.  
  802.  
  803.  
  804. /* **********************************************
  805.    * date=DecreaseDate(date,days)
  806.    * Returns DATE decreased by DAYS days
  807.    ********************************************** */
  808. DecreaseDate: procedure expose DaysOfMonth. bred normal
  809.   aDate=arg(1)
  810.   days=arg(2)
  811.   if days > 28 then do
  812.      say bred||"ERROR: More than 28 Warningdays in DB:" days normal
  813.      pull dummy
  814.      exit
  815.   end
  816.   aDateMM =substr(aDate,1,2)
  817.   aDateDD =substr(aDate,4,2)
  818.   aDateYY =substr(aDate,7,2)
  819.  
  820.   aDateDD = aDateDD-days
  821.  
  822.   if aDateDD < 1 then do              /* Switch of Month needed ? */
  823.      aDateMM = aDateMM -1             /* Prev Month */
  824.      if aDateMM = 0 then do           /* Switch of Year needed ? */
  825.          aDateMM=12                   /* December of prev. year */
  826.          aDateYY = aDateYY-1
  827.          if aDateYY < 0 then          /* Switch of Year from 1900->1899 */
  828.              aDateYY = 99
  829.      end
  830.      if isLeapYear(aDateYY) = 1 then
  831.          DaysOfMonth.2=29
  832.      aDateDD = (DaysOfMonth.aDateMM) + aDateDD
  833.   end
  834.                                                   /* Leading Zeroes ! */
  835.   if length(aDateMM) = 1 then aDateMM = '0'||aDateMM
  836.   if length(aDateDD) = 1 then aDateDD = '0'||aDateDD
  837.   if length(aDateYY) = 1 then aDateYY = '0'||aDateYY
  838.  
  839.   aDate = aDateMM||'/'||aDateDD||'/'||aDateYY
  840.   DaysOfMonth.2=28
  841. return aDate
  842.  
  843.  
  844.  
  845. /* ***********************************************
  846.    *boolean=isLeapYear(year)
  847.    *********************************************** */
  848. isLeapYear: procedure
  849.     y=arg(1)
  850.     if length(y) = 2 then y="19"||y
  851.     if y //   4 = 0 then retcode=1
  852.     if y // 100 = 0 then retcode=0
  853.     if y // 400 = 0 then retcode=1
  854. return retcode
  855.  
  856.  
  857. /* *********************************************
  858.    * DateFunctions
  859.    ********************************************* */
  860. GetMM:
  861. return substr(arg(1),1,2)
  862.  
  863. GetDD:
  864. return substr(arg(1),4,2)
  865.  
  866. GetYY:
  867. return substr(arg(1),7,2)
  868.  
  869. GetMMDD:
  870. return substr(arg(1),1,5)
  871.  
  872.  
  873. /* **********************************************
  874.    *  AnalyzeCmdLine
  875.    *  This Procedure sets the demanded flags
  876.    *  IN: -
  877.    * OUT: -
  878.    ********************************************** */
  879. AnalyzeCmdLine:
  880.     do while cmdline \= ""
  881.     parse var cmdline aWord cmdline
  882.         if pos(substr(aWord,1,1), '/-') \= 0 then do       /* oh! a switch */
  883.           if pos(substr(aWord,2,1), '?Hh') \= 0 then      /* Help */
  884.         call HelpScreen
  885.           else if pos(substr(aWord,2,1), 'Cc') \= 0 then  /* Just Check DB */
  886.         modeCheckDB=1
  887.           else if pos(substr(aWord,2,1), 'Qq') \= 0 then  /* quiet !!! */
  888.             modeQuiet=1
  889.       else do
  890.         say byellow"ERROR : Unknown switch - " aWord
  891.         say normal
  892.         call HelpScreen
  893.       end /* else */
  894.     end /* if pos...*/
  895.     end /* do */
  896. return
  897.  
  898. /* ***********************************************
  899.    * HelpScreen
  900.    * Displays the Helpscreen and exists
  901.    *********************************************** */
  902. HelpScreen:
  903.     say byellow||"Birthday Reminder V 1.0"
  904.     say "-----------------------"
  905.     say bcyan
  906.     say "Birthday.cmd checks a database for coming birthdays."
  907.     say
  908.     say "To edit the database run birthday.cmd without any parameters:"
  909.     say "BIRTHDAY.CMD<enter>"
  910.     say
  911.     say "Valid parameters:"
  912.     say "/c   - Checkmode: just check the database and terminate program afterwards."
  913.     say "       This is good for STARTUP.CMD. e.g.:"
  914.     say "       CALL c:\cmd-files\birthday.cmd /c"
  915.     say "/q   - Quietmode:  play NO tunes for birthday- and warning-messages."
  916.     say
  917.     say "(C) Feb.1994 by Wolfram Koerner"
  918.     say "FREEWARE but: Please do not spread it after you changed it. If you have bugs or"
  919.     say "improvements tell them to me. So we can implement them together and no version-"
  920.     say "confusion will raise: koerner@cip.informatik.uni-wuerzburg.de"
  921.     say "or: Wolfram Koerner, Friedenstrasse 5a, 97072 Wuerzburg, GERMANY"
  922.     say normal
  923.     exit 1
  924. return
  925.  
  926.  
  927. /* ***********************************************
  928.    * Set Color Strings for AnsiColor
  929.    *********************************************** */
  930. InitColors:
  931.   esc     = '1B'x          /* define ESCape character */
  932.   red     = esc||"[31m"    /* ANSI.SYS-control for red foreground */
  933.   yellow = esc||"[33m"    /* ANSI.SYS-control for yellow foreground */
  934.   cyan     = esc||"[36m"    /* ANSI.SYS-control for cyan foreground */
  935.   normal = esc||"[0m"     /* ANSI.SYS-control for resetting attributes to normal */
  936.   bright = esc||"[1m"     /* ANSI.SYS-control for bright foreground colors */
  937.   bred      = bright || red
  938.   byellow = bright || yellow
  939.   bcyan   = bright || cyan
  940. RETURN
  941.  
  942. /* ************************************************
  943.    * WhereX()
  944.    ************************************************ */
  945. WhereX: procedure
  946.     parse value SysCurPos() with W_z W_s
  947. return W_s
  948.  
  949. /* ************************************************
  950.    * WhereY()
  951.    ************************************************ */
  952. WhereY: procedure
  953.     parse value SysCurPos() with W_z W_s
  954. return W_z
  955.  
  956. /* ************************************************
  957.    * GotoXY(x,y)
  958.    ************************************************ */
  959. GotoXY: procedure
  960.     G_s=arg(1)
  961.     G_z=arg(2)
  962.     G_dummy=SysCurPos(G_z, G_S)
  963. return
  964.  
  965. /* -------------------------------- END ------------------------------- */
  966.  
  967.