home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / APPOINT1.ZIP / APPOINT1.PAS
Encoding:
Pascal/Delphi Source File  |  1986-02-02  |  9.5 KB  |  333 lines
  1. {
  2. .R:E
  3. }
  4. program readappoint;
  5. {$C-}
  6. type
  7.     string10=string[10];
  8.     string26=string[26];
  9.     string66=string[66];
  10.  
  11.     appoint = record
  12.                yr: byte;
  13.                mo: byte;
  14.                da: byte;
  15.                hr: byte;
  16.                txt: string26;
  17.              end;
  18.      SK2    = record
  19.                yr: byte;
  20.                mo: byte;
  21.                da: byte;
  22.                hr: byte;
  23.                app: string26;
  24.                hour: string10;
  25.                time: real;
  26.              end;
  27. var
  28.   appointfile,commandline,outplace: string66;
  29.   appfile : file of appoint;
  30.   outfile : text;
  31.   skread: appoint;
  32.   sktmp:  sk2;
  33.   skdat: array[1..1000] of sk2;
  34.   i,j,k,noofent,scrnlen: integer;
  35.   m,d,y,todaytest:         byte;
  36.   hour: string10;
  37.   today,thisdate,before,after: real;
  38.   noofparam,dm,dy: integer;
  39.   answer: char;
  40. const
  41.   day:array[0..6] of string10=('Sunday   ','Monday   ','Tuesday  ','Wednesday',
  42.     'Thursday ','Friday   ','Saturday ');
  43. function days(m,d,y,h: integer):real;
  44.  var
  45.   leap: integer;
  46.  
  47.  const
  48.   diy: array[83..93] of integer=(0,366,731,1096,1461,1827,2192,2557,2922,3288,3653);
  49.   dom: array[1..2] of array[1..12] of integer=((0,31,59,90,120,151,181,212,243,273,304,334),
  50.   (0,31,60,91,121,152,182,213,244,274,305,335));
  51.  begin  {function days}
  52.   leap:=1;
  53.   if (1900+y) mod 4 = 0 then leap:=2;
  54.   days:=diy[y]+dom[leap,m]+d+h/40;
  55.  end; {function days}
  56.  
  57. procedure GetDate(var mo,da,yr:byte);
  58. type
  59.   regpack = record
  60.               ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
  61.             end;
  62.  
  63. var
  64.   recpack:       regpack;                {record for MsDos call}
  65.   month,day:     string[2];
  66.   year:          string[4];
  67.   dx,cx:         integer;
  68.  
  69. begin  {procedure getdate}
  70.   with recpack do
  71.   begin {t}
  72.     ax := $2a shl 8;
  73.   end; {t}
  74.   MsDos(recpack);                        { call function }
  75.   with recpack do
  76.   begin {t}
  77.     yr:=cx-1900;                        {convert to string}
  78.     da:=dx mod 256;                     { " }
  79.     mo:=dx shr 8;                     { " }
  80.   end; {t}
  81. end;{procedure getdate}
  82.  
  83. procedure help;
  84.    begin  {procedure help}
  85.    Writeln('Appoint.com v1.11 retrieves appointments from Sidekick''s Appointment Calender');
  86.    writeln('The options are as follows and must be separated by a space:');
  87.    writeln('/F[d:][path]filename.ft   the [''s should not appear on the commandline');
  88.    writeln('                          the information within [] is optional');
  89.    writeln('/Mnn     display an entire months appointments /M5 or /M12');
  90.    writeln('/Bnn     display appointments starting nn days before today /B2 is default');
  91.    writeln('/Ann     display appointments starting nn days after today /A7 is default');
  92.    Writeln('/Ynn     Changes default year to nn as in /y86 /m1 would display appointments');
  93.    writeln('          for january of 1986');
  94.    writeln('/P       Route the output to the system printer');
  95.    writeln('/S       Sort and rewrite all appointments');
  96.    writeln('/Dmmyy   delete all appointments prior to mm/01/yy ');
  97.    writeln(' example  appoint /FD:\SKDAT\APPOINT.APP /B3 /A8 /P');
  98.    writeln('use D:\SIDEKICK\APPOINT.APP  as the file and output the 3 days before');
  99.    writeln('today and the 8 days after today to the printer');
  100. end;{procedure help}
  101. procedure readsk;
  102. begin
  103.  for i:= 1 to filesize(appfile)-1 do
  104.   begin {1}
  105.   seek(appfile,i);read(appfile,skread);
  106.   with skread do
  107.    begin {2}
  108.    thisdate:=days(mo,da,yr,hr);
  109.    if (length(txt) > 0) and (trunc(thisdate+0.01) <= trunc(after+0.01)) and
  110.    (trunc(thisdate+0.01) >=trunc(before+0.01))  then
  111.     begin {3}
  112.  
  113.     noofent:=noofent+1;
  114.     skdat[noofent].yr:=yr;
  115.     skdat[noofent].mo:=mo;
  116.     skdat[noofent].da:=da;
  117.     skdat[noofent].hr:=hr;
  118.     skdat[noofent].app:=txt;
  119.     skdat[noofent].time:=days(mo,da,yr,hr);
  120.     with skdat[noofent] do
  121.      begin {4}
  122.       if hr=0 then hour:='Title'
  123.       else
  124.        begin {5}
  125.        str(8+ (hr-1) div 2,hour);
  126.        if (hr > 0) and (hr mod 2 = 0) then hour:=hour+':30';
  127.        if hr mod 2 = 1 then hour:=hour+':00';
  128.        end;  {5}
  129.       end;  {4}
  130.      end;  {3}
  131.    end;   {2}
  132.  end;    {1}
  133. end; {procedure readsk}
  134.  
  135. Procedure sortsk;
  136. begin {procedure sortsk}
  137.  for i :=2 to noofent do
  138.   begin {1}
  139.   for j:= 2 to noofent do
  140.    begin {2}
  141.    if skdat[j].time < skdat[j-1].time then
  142.     begin {t}
  143.     sktmp:=skdat[j-1];
  144.     skdat[j-1]:=skdat[j];
  145.     skdat[j]:=sktmp;
  146.     end;  {t}
  147.    end; {2}
  148.   end; {1}
  149. end; {procedure sortsk}
  150.  
  151. Procedure outsk;
  152. begin {procedure outsk}
  153.  for i:=1 to noofent do
  154.   begin {1}
  155.   with skdat[i] do
  156.    begin {2}
  157.  
  158.    if (trunc(time+0.01)=trunc(today+0.01)) and (todaytest=0) then
  159.     begin {t}
  160.     writeln (outfile,'TODAY');
  161.     scrnlen:=scrnlen+1;
  162.     todaytest:=1;
  163.     end; {t}
  164.    if i=1 then
  165.     begin {t}
  166.     writeln(outfile,mo:2,'/',da:2,'/',yr:2,' ',day[(trunc(time+5) mod 7)]:10);
  167.     scrnlen:=scrnlen+1;
  168.     end   {t}
  169.    else
  170.     begin {3}
  171.     if trunc(time+0.001) > trunc(skdat[i-1].time+0.001) then
  172.      begin {t}
  173.      writeln(outfile,mo:2,'/',da:2,'/',yr:2,' ',day[(trunc(time+5) mod 7)]:10);
  174.      scrnlen:=scrnlen+1;
  175.      end;  {t}
  176.     end;  {3}
  177.    writeln(outfile,'     ',hour:6,' ',app);
  178.    scrnlen:=scrnlen+1;
  179.    end; {2}
  180.   if (scrnlen>=22) and (outplace='CON:') then
  181.    begin {t}
  182.    write('           please press a key to continue');
  183.    read(kbd,answer);
  184.    writeln;
  185.    scrnlen:=0
  186.    end; {t}
  187.   end; {1}
  188.  if outplace='LST:' then writeln(outfile,chr(12));
  189. end; {procedure outsk}
  190.  
  191. begin {program appoint}
  192.  outplace:='CON:';
  193.  noofent:=0;todaytest:=0;scrnlen:=0;
  194.  getdate(m,d,y);
  195.  today:=days(m,d,y,0);
  196.  before:=today-2;after:=today+7;
  197.  appointfile:='D:\SKDAT\APPOINT.DLK';
  198.  noofparam:=paramcount;
  199.  if noofparam = 0 then
  200.   begin {1t}
  201.   help;
  202.   exit;
  203.   end;  {1t}
  204.  if noofparam > 0 then
  205.   begin {2}
  206.   for i:=1 to noofparam do
  207.    begin{3}
  208.    commandline:=paramstr(i);
  209.    if upcase(commandline[2])='Y' then
  210.     begin {4t}
  211.     val(copy(commandline,3,length(commandline)),j,k);
  212.     y:=j;
  213.     end;  {4t}
  214.    end;{3}
  215.   for i:=1 to noofparam do
  216.    begin {5}
  217.    commandline:=paramstr(i);
  218.    if commandline[1]='/' then
  219.     begin {6}
  220.      case upcase(commandline[2]) of {case}
  221.      'F' : begin {t}
  222.            appointfile:=copy(commandline,3,length(commandline));
  223.            end;  {t}
  224.      'M' : begin {t}
  225.            val(copy(commandline,3,length(commandline)),j,k);
  226.            before:=days(j,1,y,0);
  227.            after:=days(j+1,1,y,0)-1;
  228.            if j=12 then
  229.            after:=days(1,1,y+1,0)-1;
  230.            end;   {t}
  231.      'B' : begin {t}
  232.            val(copy(commandline,3,length(commandline)),j,k);
  233.            before:=today-j;
  234.            end;  {t}
  235.      'A' : begin {t}
  236.            val(copy(commandline,3,length(commandline)),j,k);
  237.            after:=today+j;
  238.            end;  {t}
  239.      'P' : outplace:='LST:';
  240.      'D' : begin {1}
  241.            val(copy(commandline,length(commandline)-1,length(commandline)-2),dy,k);
  242.            val(copy(commandline,3,length(commandline)-4),dm,k);
  243.            writeln(days(dm,01,dy,0):8:3);
  244.            write(' delete all data before ',dm:2,'/01/',dy:2,'(n/y) ?');
  245.            answer:='N';
  246.            read(trm,answer);
  247.            if upcase(answer)='Y' then
  248.             begin{2}
  249.             writeln('the data will be deleted');
  250.             before:=days(dm,01,dy,0);
  251.             after:=31000.0;
  252.             assign(appfile,APPOINTFILE);reset(appfile);
  253.  
  254.             readsk;
  255.             sortsk;
  256.             rewrite(appfile);
  257.             with skread do
  258.              begin{3}
  259.              for i:=1 to noofent do
  260.               begin {4}
  261.               yr:=skdat[i].yr;
  262.               mo:=skdat[i].mo;
  263.               da:=skdat[i].da;
  264.               hr:=skdat[i].hr;
  265.               txt:=skdat[i].app;
  266.               seek(appfile,i);
  267.               write(appfile,skread);
  268.               end; {4}
  269.              end; {3}
  270.             exit;
  271.             end;{2}
  272.             writeln('the data will not be deleted');
  273.            end;{1}
  274.      'S' : begin{1}
  275.             before:=0.0;
  276.             after:=31000.0;
  277.             assign(appfile,APPOINTFILE);reset(appfile);
  278.             readsk;
  279.             sortsk;
  280.             rewrite(appfile);
  281.             with skread do
  282.              begin{3}
  283.              for i:=1 to noofent do
  284.               begin {4}
  285.               yr:=skdat[i].yr;
  286.               mo:=skdat[i].mo;
  287.               da:=skdat[i].da;
  288.               hr:=skdat[i].hr;
  289.               txt:=skdat[i].app;
  290.               seek(appfile,i);
  291.               write(appfile,skread);
  292.               end; {4}
  293.              end; {3}
  294.             exit;
  295.            end;{1}
  296.      'L' : begin
  297.            end;
  298.      'E' :  begin{1}
  299.             before:=0.0;
  300.             after:=31000.0;
  301.             assign(appfile,APPOINTFILE);reset(appfile);
  302.             readsk;
  303.             sortsk;
  304.             with skread do
  305.              begin{3}
  306.               i:=1;
  307.               writeln('number of appointments is ',noofent);
  308.               for j:=1 to 2 do
  309.               begin
  310.               yr:=skdat[i].yr;
  311.               mo:=skdat[i].mo;
  312.               da:=skdat[i].da;
  313.               hr:=skdat[i].hr;
  314.               txt:=skdat[i].app;
  315.               i:=noofent;
  316.               writeln(mo:2,'/',da:2,'/',yr:2,'   ',txt);
  317.               end;
  318.              end; {3}
  319.             exit;
  320.            end;{1}
  321.  
  322.      end; {case}
  323.     end; {6}
  324.    end; {5}
  325.   end; {2}
  326.  assign(outfile,outplace);
  327.  assign(appfile,APPOINTFILE);reset(appfile);
  328.  readsk;
  329.  sortsk;
  330.  outsk;
  331.  close(appfile);
  332. end. {program appoint}
  333.