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.
Vorgefundene Kodierung: UTF-8 | 0
|