Source file: /~heha/hs/Termini.zip/16bit/termini.pas

program Termini;
{$K+}
uses WinProcs, Wintypes, Win31, Shellapi,WinDos;

var
 fn:array[0..255] of Char;	{Puffer für INI-Dateiname}
 date:record			{Puffer fürs Datum}
  d,m,y,dow:Word;
 end;

procedure Zeig_Geburtstage(Tag:PChar);
 var
  s,n:array[0..255] of Char;	{Puffer für INI-Dateiname}
  vsrec:record
   tag,sp:PChar;
   nn:Word;
  end;
 begin
  vsrec.tag:=Tag;
  vsrec.sp:=n;
{in Zugriffsschlüssel wandeln}
  wvsprintf(s,'%02u.%02u.',date);
{Möglichen Geburtstag abfragen}
  if GetPrivateProfileString('Geburtstage',s,'',n,sizeof(n),fn)<>0
  then begin
   wvsprintf(s,'%s hat %s Geburtstag!',vsrec);
   MessageBox(0,s,'Termini',MB_OK);
  end;
  date.dow:=date.y;
  for date.y:=1900 to date.dow do begin
   wvsprintf(s,'%02u.%02u.%04u',date);
{Mögliche Geburtstage abfragen}
   if GetPrivateProfileString('Geburtstage',s,'',n,sizeof(n),fn)<>0
   then begin
    vsrec.nn:=date.dow-date.y;
    wvsprintf(s,'%s hat %s den %u. Geburtstag!',vsrec);
    MessageBox(0,s,'Termini',MB_OK);
   end;
  end;
 end;

procedure Termin(Tag,key:PChar);
 var
  s,n:array[0..255] of Char;	{Puffer für INI-Dateiname}
  vsrec:record
   tag,sp:PChar;
  end;
 begin
  vsrec.tag:=Tag;
  vsrec.sp:=n;
  if GetPrivateProfileString('sonstige Termini',key,'',n,sizeof(n),fn)<>0
  then begin
   wvsprintf(s,'%s ist folgender Termin:'#10#10'%s.',vsrec);
   MessageBox(0,s,'Termini',MB_OK);
  end;
 end;

procedure Zeig_Termine(Tag:PChar);
 var
  s,n:array[0..255] of Char;	{Puffer für INI-Dateiname}
 begin
{Termin ohne Jahr abfragen}
  wvsprintf(s,'%02u.%02u.',date);
  Termin(Tag,s);
{Termin mit Jahr abfragen}
  wvsprintf(s,'%02u.%02u.%04u',date);
  Termin(Tag,s);
 end;

procedure Inc_Datum;
 begin
  with date do begin
   Inc(d);			{d:=d+1}
   if (d=32)
   or (d=31) and (m in [4,6,9,11])
   or (d=29) and (m=2) and (y mod 4 <>0) {kein Schaltjahr}
   or (d=30) and (m=2) and (y mod 4 =0)  {Schaltjahr}
   then begin
    d:=1; Inc(m);
    if m=13 then begin
     m:=1; Inc(y);
    end;
   end;
  end;
 end;

function Heute_gerufen:Boolean;
 var
  s,n:array[0..255] of Char;	{Puffer für INI-Dateiname}
 begin
  wvsprintf(s,'%02u.%02u.%04u',date);
  GetPrivateProfileString('Einstellungen','Letzter Aufruf','',
    n,sizeof(n),fn);
  if lstrcmpi(s,n)<>0 then begin
   WritePrivateProfileString('Einstellungen','Letzter Aufruf',s,fn);
   Heute_gerufen:=false;
  end else begin
   Heute_gerufen:=true;
  end;
 end;

var
 tic: Word;
 Msg: TMsg;
begin
{INI-Dateiname mit Pfad beschaffen}
 lstrcpy(fn+GetModuleFileName(HInstance,fn,sizeof(fn))-3,'INI');
{Datum beschaffen}
 with date do GetDate(y,m,d,dow);
 if Heute_gerufen then exit;
{Etwas warten (wegen Bootvorgang)}
{$Q-}
 tic:=GetTickCount;
 repeat
  PeekMessage(Msg,0,0,0,PM_REMOVE);
 until Word(Word(GetTickCount)-tic)>5000;
{Messageboxen zeigen}
 Zeig_Geburtstage('Heute');
 Inc_Datum;
 Zeig_Geburtstage('Morgen');
 Inc_Datum;
 Zeig_Geburtstage('Übermorgen');

 with date do GetDate(y,m,d,dow);
 Zeig_Termine('Heute');
 Inc_Datum;
 Zeig_Termine('Morgen');

end.