Program: DLS Daylight Savings Time
File: DLS.PAS
Purpose: updates clock when time changes
Syntax: first time use: DLS s
Every other time: DLS
Intended use: run in autoexec.bat, but you can run it anywhere you like.
The algorithm is: add an hour to the clock between 1st Sunday of April
and last Sunday of October, otherwise subtract an hour.
To ensure no change is made repeatedly, the EXE file
date is updated to show when the last change was made.
The parameter "s" sets the file date and makes no
time changes, so DLS is properly updated to know
not to make a clock change at the wrong time. Sourec code:
uses dos;
const
dayticks=1572840;
nl=#13#10; {new line in text files}
Const {filemode bitmapped values}
fmread = 0; {read only}
fmwrite = 1; {write only}
fmopen = 2; {read/write}
fmnoshare = 16; {no sharing}
fmnowrite = 32; {share: deny write}
fmnoread = 48; {share: deny read}
fmshare = 64; {share: read/write}
fmpriv = 128; {private to current process}
Function upstr(s:string):string;
var c:byte;
begin
if length(s)>0 then for c:=1 to length(s) do s[c]:=upcase(s[c]);
upstr:=s;
end;
Function leapyear(y:word):boolean;
begin
leapyear:=((y mod 4=0) and (y mod 1000)) or ((y mod 400=0) and (y mod
40000));end;
Function Zeller(d,m:byte; y:word):byte;
{Day of week for given date found. 0..6=Sunday..Saturday}
var
amonth,ayear,century,last2,mcorrect,ycorrect:word;
begin
if m<=2 then begin
amonth:=10+m;
ayear:=y-1;
end
else begin
amonth:=m-2;
ayear:=y;
end;
mcorrect:=(26*amonth-2) div 10;
century:=ayear div 100;
last2:=ayear mod 100;
ycorrect:=last2 + last2 div 4 + century div 4 + 5*century;
zeller:=(d+mcorrect+ycorrect) mod 7;
end;
function timeahead(const time_in:longint {packed time}):boolean;{ output:
true if within time period when 1 hour is added to time,
false otherwise
}
var
timeunpacked:datetime;
periodahead,periodback:longint;
begin
{set start of time-ahead period}
unpacktime(time_in,timeunpacked); {only year will be kept}
with timeunpacked do begin
{initially start at 02:00 1 Apr}
month:=4;
day:=1;
hour:=2;
min:=0;
sec:=0;
{adjust to be first Sunday. Zeller returns weekday, 0 for Sunday, 6
for Saturday. 7-zeller is how many days to add, unless it's 7 then
add 0.}
inc(day,(7-zeller(day,month,year)) mod 7);
end;
{pack time-ahead start boundary}
packtime(timeunpacked,periodahead);
{set start of time-back period at }
with timeunpacked do begin
{initially start at 02:00 31 Oct}
month:=10;
day:=31;
{adjust to be the last Sunday}
dec(day,zeller(day,month,year));
end;
{pack start of time-back period}
packtime(timeunpacked,periodback);
{check if within time-ahead period, return as function result}
timeahead:=(time_in>=periodahead) and (time_in23 then begin
getdate(year,month,day,weekday);
inc(day);
hour:=hour mod 24;
{function required to find last day of any month}
if day>lastday(month,year) then begin
day:=day - lastday(month,year);
inc(month);
if month>12 then begin
month:=month mod 12;
inc(year);
end;
end;
{date has changed so update date as well}
setdate(year,month,day);
end;
settime(hour,min,sec,hsec);
writeln('DLS: added 1 hour.');
end;
procedure subhour; {subtract 1 hour from clock}
var hour,min,sec,hsec:word;
year,month,day,weekday:word;
begin
gettime(hour,min,sec,hsec);
if hour>1 then dec(hour)
else begin
hour:=23;
getdate(year,month,day,weekday);
dec(day);
if day<1 then begin
dec(month);
if month<1 then begin
dec(year);
month:=12;
end;
{not done, correct year here}
day:=lastday(month,year);
end;
{date has changed so update it too}
setdate(year,month,day);
end;
settime(hour,min,sec,hsec);
writeln('DLS: subtracted 1 hour.');
end;
{global}
var
arg:string;
today_ahead,exe_ahead,showhelp:boolean;
timeunpacked:datetime;
timepacked:longint;
hsec,weekday:word; {not stored, required for gettime/getdate}
exef:file;
argpos:byte;
{program}
begin
{only show help, if ?,-?,h,-h used as arg 1}
showhelp:=false;
if paramcount>0 then begin
arg:=upstr(paramstr(1));
argpos:=1+ord(arg[1] in ['/','-']);
{show help only if argpos char exists and is ? or h}
showhelp:=(argpos<=length(arg)) and (arg[argpos] in ['?','h','H']);
end;
if showhelp then begin
writeln('This program adjusts the time ahead or back 1 hour for daylight
savings');
writeln('time. The EXE file date changes to be the last time the
date/time was');
writeln('changed.'+nl); {+nl starts a new text line}
writeln('To run this program for the first time, make sure your clock is
already');
writeln('correct and then run DLS with "s" as the command line. Example:
dls.exe s');
writeln('The clock will not change and the EXE file date will. From now
on when');
writeln('you run DLS, the time will change with daylight savings.'+nl);
writeln('Run this program each time the computer is re-booted so the
clock is');
writeln('checked often. This program is not a TSR.');
end
else begin {not help mode}
assign(exef,paramstr(0));
{startup mode if command line is s}
{if startup mode then set EXE date to today}
if (paramcount>0) and (upstr(paramstr(1))='S') then begin
{save in unpacked time}
with timeunpacked do begin
{get date}
getdate(year,month,day,weekday);
{get time}
gettime(hour,min,sec,hsec);
end;
{pack time}
packtime(timeunpacked,timepacked);
{set EXE file date}
{open for writing, deny shared writing}
filemode:=fmopen+fmnowrite;
reset(exef);
setftime(exef,timepacked);
close(exef);
writeln('DLS: reset done.');
end
else begin {not startup mode}
{check time period for EXE date}
{open EXE, get time, close EXE, check time period}
filemode:=2;
reset(exef);
getftime(exef,timepacked);
close(exef);
exe_ahead:=timeahead(timepacked);
{check time period for today}
with timeunpacked do begin
gettime(hour,min,sec,hsec);
getdate(year,month,day,weekday);
end;
packtime(timeunpacked,timepacked);
today_ahead:=timeahead(timepacked);
{if time periods mismatch then change clock and update EXE}
if exe_aheadtoday_ahead then begin
{add 1h if today in time-ahead period}
if today_ahead then addhour
{sub 1h if today not in time-ahead period}
else subhour;
{update EXE}
filemode:=fmopen+fmnowrite;
reset(exef);
setftime(exef,timepacked);
close(exef);
end
else writeln('DLS: no change');
end;
end;
end.
- Area: FIDO International:Pascal
-------------------------------------------
Msg#: 1614 Rec'd Date: 07 Jun 94
0:28:25
From: TOM CARROLL Read: Yes Replied: No
To: IAN LIN Mark:
Subj: +/- 1:00:00
------------------------------------------------------------------------------
--- Maximus 2.01wb
---------------
* Origin: *Synthesis* Kingston, Ont., Canada! (1:249/127)
|