TIP: Click on subject to list as thread! ANSI
echo: pascal
to: ALL
from: IAN LIN
date: 1998-04-17 15:17:00
subject: daylight savings time

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)

SOURCE: echomail via exec-pc

Email questions or comments to sysop@ipingthereforeiam.com
All parts of this website painstakingly hand-crafted in the U.S.A.!
IPTIA BBS/MUD/Terminal/Game Server List, © 2025 IPTIA Consulting™.