mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-17 22:38:43 +02:00
138 lines
3.0 KiB
ObjectPascal
138 lines
3.0 KiB
ObjectPascal
Program GetDate;
|
||
|
||
{ GetDate v1.0 1995 by Andreas Tetzl }
|
||
{ Public Domain }
|
||
|
||
{
|
||
Translated to fpc pascal
|
||
19 Mar 2001.
|
||
|
||
nils.sjoholm@mailbox.swipnet.se
|
||
}
|
||
|
||
uses amigados, strings;
|
||
|
||
const template : pchar = 'Format/K,Help/S';
|
||
|
||
version : pchar = '$VER: GetDate 1.0 (21.2.95)';
|
||
|
||
VAR DS : tDateStamp;
|
||
DT : _tDateTime;
|
||
rda : pRDArgs;
|
||
WeekDay, Date, Time, hours, mins, secs, day, month, year : pchar;
|
||
vec : Array[0..1] of longint;
|
||
i : longint;
|
||
LFormat : pchar;
|
||
|
||
Procedure PrintFormat;
|
||
VAR Str : string;
|
||
tmp : string;
|
||
Begin
|
||
Str := strpas(LFormat);
|
||
tmp := '';
|
||
For i:=1 to length(Str) do
|
||
begin
|
||
|
||
If Str[i]='%' then
|
||
Begin
|
||
Case UpCase(Str[i+1]) of
|
||
('D') : tmp := tmp + strpas(Date);
|
||
('W') : tmp := tmp + strpas(WeekDay);
|
||
('T') : tmp := tmp + strpas(Time);
|
||
('H') : tmp := tmp + strpas(hours);
|
||
('M') : tmp := tmp + strpas(Mins);
|
||
('S') : tmp := tmp + strpas(Secs);
|
||
('A') : tmp := tmp + strpas(Day);
|
||
('O') : tmp := tmp + strpas(Month);
|
||
('Y') : tmp := tmp + strpas(Year);
|
||
end;
|
||
end
|
||
else
|
||
tmp := tmp + Str[i];
|
||
end;
|
||
Writeln(tmp);
|
||
end;
|
||
|
||
Procedure Help;
|
||
Begin
|
||
Writeln(#10'GetDate v1.0 1995 by Andreas Tetzl');
|
||
Writeln('Public Domain'#10);
|
||
Writeln('How to use the placeholders for Format:'#10);
|
||
Writeln(' %d : Datum');
|
||
Writeln(' %w : Weekday');
|
||
Writeln(' %t : Time with Hour, Minutes and Seconds');
|
||
Writeln(' %h : Hour');
|
||
Writeln(' %m : Minutes');
|
||
Writeln(' %s : Seconds');
|
||
Writeln(' %a : Day');
|
||
Writeln(' %o : Month');
|
||
Writeln(' %y : Year'#10);
|
||
Exit;
|
||
end;
|
||
|
||
begin
|
||
For i:=0 to 1 do Vec[i]:=0;
|
||
|
||
rda:=ReadArgs(Template,@vec,NIL);
|
||
If rda=NIL then
|
||
Begin
|
||
If PrintFault(IoErr,NIL) then;
|
||
halt(10);
|
||
end;
|
||
|
||
LFormat:=StrAlloc(100);
|
||
|
||
If StrComp(pointer(vec[0]),pchar('')) <> 0 then StrCopy(LFormat,pointer(vec[0])) else LFormat:=NIL;
|
||
|
||
|
||
If vec[1]<>0 then Help;
|
||
|
||
WeekDay:=StrAlloc(LEN_DATSTRING);
|
||
Date:=StrAlloc(LEN_DATSTRING);
|
||
Time:=StrAlloc(LEN_DATSTRING);
|
||
Hours:=StrAlloc(10);
|
||
Mins:=StrAlloc(10);
|
||
Secs:=StrAlloc(10);
|
||
Day:=StrAlloc(10);
|
||
Month:=StrAlloc(10);
|
||
Year:=StrAlloc(10);
|
||
|
||
DateStamp(pDateStamp(@DS));
|
||
DT.dat_Stamp:=DS;
|
||
DT.dat_Format:=Format_DOS;
|
||
DT.dat_StrDay:=WeekDay;
|
||
DT.dat_StrDate:=Date;
|
||
DT.dat_StrTime:=Time;
|
||
If DOSDateToStr(@DT) then begin
|
||
|
||
StrlCopy(hours,Time,2);
|
||
|
||
StrlCopy(Mins,addr(Time[3]),2);
|
||
StrlCopy(Secs,addr(Time[6]),2);
|
||
StrlCopy(Day,Date,2);
|
||
StrlCopy(Month,addr(Date[3]),3);
|
||
StrlCopy(Year,addr(Date[7]),2);
|
||
|
||
{ In den deutschen Locale-Strings von OS3.0 scheint ein Fehler zu sein. }
|
||
{ Am Datums-String ist hinten noch ein Leerzeichen, also '16-Feb-95 '. }
|
||
{ Hier wird gepr<70>ft, ob das letzte Zeichen ein Leerzeichen ist. }
|
||
{ Das Leerzeichen wird dann durch '\0' (Stringende) ersetzt. }
|
||
If Date[StrLen(Date)-1]=' ' then Date[StrLen(Date)-1]:=#0;
|
||
end;
|
||
If LFormat=NIL then
|
||
Writeln(WeekDay,' ',Date,' ',Time)
|
||
else
|
||
PrintFormat;
|
||
|
||
StrDispose(LFormat);
|
||
StrDispose(WeekDay);
|
||
StrDispose(date);
|
||
StrDispose(Time);
|
||
StrDispose(hours);
|
||
StrDispose(mins);
|
||
StrDispose(secs);
|
||
StrDispose(Day);
|
||
StrDispose(Month);
|
||
StrDispose(Year);
|
||
end.
|