ak> i don't know the actual format but usually it's what's called unix
ak> timestamp.the value represents the seconds counted from 1.1.70.
SB> Thanks, I was wondering about that...if that is what they
SB> are using, I can put something together. Do you know of a
SB> Delphi function to do it?
Hopefully the following, written by the late great Trevor Carlsen for TP6/7
will do what you need (and maybe more) with a little adaptation for Delphi.
Cheers, Ian
UNIT TCDate;
{ Author: Trevor J Carlsen Released into the public domain }
{ PO Box 568 }
{ Port Hedland }
{ Western Australia 6721 }
{ Voice +61 91 732 026 }
(* includes 30 Jun 92 update to UnixTime - thanx tc - ivs 3 Jul 92 *)
interface
uses dos;
type
Date = word;
UnixTimeStamp = longint;
const
WeekDays : array[0..6] of string[9] =
('Sunday','Monday','Tuesday','Wednesday','Thursday',
'Friday','Saturday');
months : array[1..12] of string[9] =
('January','February','March','April','May','June','July',
'August','September','October','November','December');
function DayOfTheWeek(pd : date): byte;
{ Returns the day of the week for any date Sunday = 0 .. Sat = 6 }
{ pd = a packed date as returned by the function PackedDate }
{ eg... writeln('Today is ',WeekDays[DayOfTheWeek(Today))]; }
function PackedDate(yr,mth,d: word): date;
{ Packs a date into a word which represents the number of days since }
{ Dec 31,1899 01-01-1900 = 1 }
function UnixTime(yr,mth,d,hr,min,sec: word): UnixTimeStamp;
{ Packs a date and time into a four byte unix style variable which }
{ represents the number of seconds that have elapsed since midnight }
{ on Jan 1st 1970. }
procedure UnPackDate(VAR yr,mth,d: word; pd : date);
{ Unpacks a word returned by the function PackedDate into its }
{ respective parts of year, month and day }
procedure UnPackUnix(var yr,mth,d,hr,min,sec: word; uts: UnixTimeStamp);
{ Unpacks a UnixTimeStamp variable into its component parts. }
function DateStr(pd: date; format: byte): string;
{ Unpacks a word returned by the function PackedDate into its }
{ respective parts of year, month and day and then returns a string }
{ formatted according to the specifications required. }
{ If the format is > 9 then the day of the week is prefixed to the }
{ returned string. }
{ Formats supported are: }
{ 0: dd/mm/yy }
{ 1: mm/dd/yy }
{ 2: dd/mm/yyyy }
{ 3: mm/dd/yyyy }
{ 4: [d]d xxx yyyy (xxx is alpha month of 3 chars) }
{ 5: xxx [d]d, yyyy }
{ 6: [d]d FullAlphaMth yyyy }
{ 7: FullAlphaMth [d]d, yyyy }
{ 8: [d]d-xxx-yy }
{ 9: xxx [d]d, 'yy }
function ValidDate(yr,mth,d : word; VAR errorcode : byte): boolean;
{ Validates the date and time data to ensure no out of range errors }
{ can occur and returns an error code to the calling procedure. A }
{ errorcode of zero is returned if no invalid parameter is detected. }
{ Errorcodes are as follows: }
{ Year out of range ( 2078) bit 0 of errorcode is set. }
{ Month 12 bit 1 of errorcode is set. }
{ Day 31 bit 2 of errorcode is set. }
{ Day out of range for month bit 2 of errorcode is set. }
procedure ParseDateString(var dstr; var y,m,d : word; format : byte);
{ Parses a date string in several formats into its component parts }
{ It is the programmer's responsibility to ensure that the string }
{ being parsed is a valid date string in the format expected. }
{ Formats supported are: }
{ 0: dd/mm/yy[yy] }
{ 1: mm/dd/yy[yy] }
function NumbOfDaysInMth(y,m : word): byte;
{ returns the number of days in any month }
function Today : date;
{ returns the number of days since 01-01-1900 }
{=============================================================================
}
implementation
const
TDays : array[Boolean,0..12] of word =
((0,31,59,90,120,151,181,212,243,273,304,334,365),
(0,31,60,91,121,152,182,213,244,274,305,335,366));
UnixDatum = longint(25568);
function DayOfTheWeek(pd : date): byte;
begin
DayOfTheWeek := pd mod 7;
end;
function PackedDate(yr,mth,d : word): date;
{ valid for all years 1900 to 2078 }
var
temp : word;
lyr : boolean;
begin
lyr := (yr mod 4 = 0) and (yr 1900);
if yr >= 1900 then
dec(yr,1900);
temp := yr * word(365) + (yr div 4) - ord(lyr);
inc(temp,TDays[lyr][mth-1]);
inc(temp,d);
PackedDate := temp;
end; { PackedDate }
function UnixTime(yr,mth,d,hr,min,sec: word): UnixTimeStamp;
{ Returns the number of seconds since 00:00 01/01/1970 }
var
temp : UnixTimeStamp;
begin
temp := 86400 * (PackedDate(yr,mth,d) - UnixDatum);
(* 3 Jul 92 ivs. Was:
UnixTime := temp + hr * 3600 + min * 60 + sec;
end; { UnixTime }
tc> Add the typecast to your version. Without it any timestamp after
tc> approximately 1812 hours on any day will be incorrect.
*)
UnixTime := temp + longint(hr) * 3600 + min * 60 + sec;
end; { UnixTime } {^^^^^^^^^^^}
procedure UnPackDate(var yr,mth,d: word; pd : date);
{ valid for all years 1900 to 2078 }
var
julian : word;
lyr : boolean;
begin
d := pd;
yr := (longint(d) * 4) div 1461;
julian := d - (yr * 365 + (yr div 4));
inc(yr,1900);
lyr := (yr mod 4 = 0) and (yr 1900);
inc(julian,ord(lyr));
mth := 0;
while julian > TDays[lyr][mth] do
inc(mth);
d := julian - TDays[lyr][mth-1];
end; { UnPackDate }
procedure UnPackUnix(var yr,mth,d,hr,min,sec: word; uts: UnixTimeStamp);
var
temp : UnixTimeStamp;
begin
UnPackDate(yr,mth,d,date(uts div 86400) + UnixDatum);
temp := uts mod 86400;
hr := temp div 3600;
min := (temp mod 3600) div 60;
sec := temp mod 60;
end; { UnPackUnix }
function DateStr(pd: date; format: byte): string;
var
y,m,d : word;
YrStr : string[5];
MthStr : string[11];
DayStr : string[8];
TempStr : string[5];
begin
UnpackDate(y,m,d,pd);
str(y,YrStr);
str(m,MthStr);
str(d,DayStr);
TempStr := '';
if format > 9 then
TempStr := copy(WeekDays[DayOfTheWeek(pd)],1,3) + ', ';
if (format mod 10) < 4 then begin
if m < 10 then
MthStr := '0'+MthStr;
if d < 10 then
DayStr := '0'+DayStr;
end;
case format mod 10 of { force format to a valid value }
0: DateStr := TempStr+DayStr+'/'+MthStr+'/'+copy(YrStr,3,2);
1: DateStr := TempStr+MthStr+'/'+DayStr+'/'+copy(YrStr,3,2);
2: DateStr := TempStr+DayStr+'/'+MthStr+'/'+YrStr;
3: DateStr := TempStr+MthStr+'/'+DayStr+'/'+YrStr;
4: DateStr := TempStr+DayStr+' '+copy(months[m],1,3)+' '+YrStr;
5: DateStr := TempStr+copy(months[m],1,3)+' '+DayStr+' '+YrStr;
6: DateStr := TempStr+DayStr+' '+months[m]+' '+YrStr;
7: DateStr := TempStr+months[m]+' '+DayStr+' '+YrStr;
8: DateStr :=
TempStr+DayStr+'-'+copy(months[m],1,3)+'-'+copy(YrStr,3,2);
9: DateStr := TempStr+copy(months[m],1,3)+' '+DayStr+','''
+copy(YrStr,3,2);
end; { case }
end; { DateStr }
function ValidDate(yr,mth,d : word; var errorcode : byte): boolean;
begin
errorcode := 0;
if (yr 2078) then
errorcode := (errorcode or 1);
if (d 31) then
errorcode := (errorcode or 2);
if (mth 12) then
errorcode := (errorcode or 4);
case mth of
4,6,9,11: if d > 30 then errorcode := (errorcode or 2);
2: if d > (28 + ord((yr mod 4) = 0)) then
errorcode := (errorcode or 2);
end; {case }
ValidDate := (errorcode = 0);
if errorcode 0 then write(#7);
end;
procedure ParseDateString(var dstr; var y,m,d : word; format : byte);
var
left,middle : word;
errcode : integer;
st : string absolute dstr;
begin
val(copy(st,1,2),left,errcode);
val(copy(st,4,2),middle,errcode);
val(copy(st,7,4),y,errcode);
case format of
0: begin
d := left;
m := middle;
end;
1: begin
d := middle;
m := left;
end;
end; { case }
end; { ParseDateString }
function NumbOfDaysInMth(y,m : word): byte;
{ valid for the years 1900 - 2078 }
begin
case m of
1,3,5,7,8,10,12: NumbOfDaysInMth := 31;
4,6,9,11 : NumbOfDaysInMth := 30;
2 : NumbOfDaysInMth := 28 +
ord((y mod 4) = 0) - ord(y = 1900);
end;
end;
function Today : date;
var y,m,d,dw : word;
begin
GetDate(y,m,d,dw);
Today := PackedDate(y,m,d);
end;
end. { Unit TCDate }
--- QM v1.30
---------------
* Origin: Magic Puddin' (3:626/660.0)
|