Sehe ich beim Datei-Timestamp den Wald vor lauter Bäumen nicht?

[alfware17]

Ich habe aus einer Anwendung heraus (Umpacken von ZIP auf 7z und anschließend Timestamp wieder original setzen), für die ich mir extra ein 20 Jahre altes Unix Touch.EXE und ein Script für 1000 Archive besorgt hatte, beschlossen, selbst so ein Touch zu schreiben.
Gesagt getan, in Python und Java hat ChatGPT das für mich gemacht, in Lazarus habe ich dann selber. Dann wollte ich es portieren von Lazarus auf Turbo-Pascal und auch schauen, ob es Linux-fähig wäre.
Okay, ich habe viel probiert und gelernt, weiß jetzt was ein DOS-Timestamp ist und was ein Unix-Timestamp, habe viele Funktionen zum Erzeugen und Formatieren und Umrechnungen gemacht - mehr als ich eigentlich brauche für das Touch. Aber meine Zeit-Unit soll da umgebaut/erweitert werden, da die bisher eine alternative Zahl in Tausendstel-Sekunden benutzt.

Nun meine Fragen: es gelingt mir irgendwie nicht, den Unix-Timestamp zum Setzen/Lesen der Änderungszeit zu benutzen. Ich kann ihn berechnen, konvertieren aber weder lesen noch setzen. ZB Heute wird dann nach 2049 verschoben. Geht mit Pascal wirklich nur der DOS-Timestamp? Mit allen Einschränkungen, keine Sekundenbruchteile und sogar nur Rundung auf gerade Sekunden (2). Ich dachte, Python kann das, und zB der Totalcommander zeigt zumindestens ungerade Sekunden an.

Code: Alles auswählen

program Touch;

{$IFNDEF DOS}
   {$MODE OBJFPC}
   uses SysUtils, DateUtils, Dos, Stdio, Zeit, Watch
     {$IFDEF UNIX} , BaseUnix {$ENDIF};
{$ELSE}
   uses Dos, Stdio, Zeit, Watch;
{$ENDIF}

type
   TTimestamp = {$IFDEF DOS} TDosTime {$ELSE} Card {$ENDIF};

procedure PrintHelp;
begin
   WriteLn('Usage: touch [OPTIONS] <filename>');
   WriteLn('Options:');
   WriteLn('  -r <file>   Set the timestamp of <filename> to that of <file>');
   WriteLn('  -t <time>   Set the timestamp of <filename> to the specified time (YYYYMMDDhhmmss)');
   WriteLn('  -a          Change only the access time');
   WriteLn('  -m          Change only the modification time');
   WriteLn('  -h          Show this help message');
   Halt(0);
end;

procedure Abort(reason: String);
begin
   Writeln(reason);
   Halt(1);
end;

function GetFileTime(FileName: string): TTimestamp;
{$IFDEF DOS}
var
   F: File;
   DT: TDosTime;
begin
   Assign(F, FileName);
   {$I-} Reset(F); {$I+}
   if IOResult <> 0 then begin
      GetFileTime := -1;
      Exit;
   end;
   GetFTime(F, DT);
   Close(F);
   GetFileTime := DT;
{$ELSE}
var
   Info: SearchRec;
begin
   FindFirst(FileName, faAnyFile, Info);
   if DosError = 0 then begin
      GetFileTime := TimeDos2Timestamp(Info.Time);
      FindClose(Info);
   end else
      GetFileTime := -1;
{$ENDIF}
end;

procedure SetFileTime(FileName: string; TS: TTimestamp; ChangeAccess, ChangeModify: Boolean);
{$IFDEF UNIX}
var
   UT: TUTimBuf;
begin
   if ChangeAccess then begin
      UT.actime := TS;
      UT.modtime := TS;
      FpUtime(FileName, @UT);
   end;
{$ENDIF}
{$IFDEF DOS}
var
   F: File;
begin
   if ChangeModify then begin
      Assign(F, FileName);
      {$I-} Reset(F); {$I+}
      if IOResult <> 0 then begin
         Rewrite(F);
         if IOResult <> 0 then Exit;
      end;
      SetFTime(F, TS);
      Close(F);
   end;
{$ELSE}
begin
   if ChangeModify then
      FileSetDate(FileName, TS);
{$ENDIF}
end;

function ParseDateTime(DateTimeStr: string): TTimestamp;
var
   Year, Month, Day, Hour, Minute, Second: Integer;
   TS: TTimestamp;
begin
   TS := 0;
   if Length(DateTimeStr) = 14 then begin
      Year := Str2Card(Copy(DateTimeStr, 1, 4));
      Month := Str2Card(Copy(DateTimeStr, 5, 2));
      Day := Str2Card(Copy(DateTimeStr, 7, 2));
      Hour := Str2Card(Copy(DateTimeStr, 9, 2));
      Minute := Str2Card(Copy(DateTimeStr, 11, 2));
      Second := Str2Card(Copy(DateTimeStr, 13, 2));
      if (Year < 1980) or (Month < 1) or (Month > 12) or (Day < 1) or (Day > 31) then TS := -1;
      case Month of
        1, 3, 5, 7, 8, 10, 12: if Day > 31 then TS := -1;
        4, 6, 9, 11: if Day > 30 then TS := -1;
        2: if (IsLeapYear(Year) and (Day > 29)) or (Day > 28) then TS := -1;
      end;
      if (Hour < 0) or (Hour > 23) or (Minute < 0) or (Minute > 59) or
         (Second < 0) or (Second > 59) then TS := -1;
   end
   else TS := -1;
   if TS = 0 then TS :=
                 {$IFDEF DOS} DTValues2TimeDos (Year, Month, Day, Hour, Minute, Second);
                 {$ELSE} DTValues2Timestamp(Year, Month, Day, Hour, Minute, Second, 0);
                 {$ENDIF}
   ParseDateTime := TS;
end;

procedure ShowTimeStamp(Kommentar: String; TS: TTimestamp);
begin
   (*
      Write(Kommentar, '(LongInt): ', TS);
      Writeln('    (Date/Time): ', {$IFDEF DOS} FormatTimeDos {$ELSE} FormatTimestamp {$ENDIF} (TS));
   *)
   Writeln(Kommentar,' ', {$IFDEF DOS} FormatTimeDos {$ELSE} FormatTimestamp {$ENDIF} (TS));
end;

var
   i: Integer;
   FileName: string;
   SourceFile: string;
   Timestamp, Temp: TTimestamp;
   ChangeAccess, ChangeModify: Boolean;
   OptC: char;
   OptS: string;
begin
   if ParamCount = 0 then begin
      PrintHelp;
      Halt(1);
   end;
   ChangeAccess := False;
   ChangeModify := False;
   SourceFile := '';
   Timestamp := {$IFDEF DOS} GetTimeDos {$ELSE} GetTimestamp {$ENDIF};
   i := 1;
   while i <= ParamCount do begin
      OptS := Paramstr(i);
      if OptS[1] <> '-'
         then FileName := OptS
         else begin
            OptC := OptS[2];
            case OptC of
              'h' : PrintHelp;
              'r' : begin
                       if i + 1 <= ParamCount then begin
                          SourceFile := ParamStr(i + 1);
                          Inc(i);
                       end
                       else Abort('Error: no reference file is given after -r');
                       Timestamp := GetFileTime(SourceFile);
                       if Timestamp <> -1
	      	          then ShowTimeStamp('reference timestamp: ', Timestamp)
                          else Abort('Error: no valid timestamp for reference file');
                    end;
              't' : begin
                       if i + 1 <= ParamCount then begin
                          Temp := ParseDateTime(ParamStr(i + 1));
                          if Temp < 0 then
                             Abort('Error: timestamp given has no valid format ' + Paramstr(i + 1));
                          Timestamp := Temp;
                          Inc(i);
                       end
                       else Abort('Error: no timestamp is given after -t');
                    end;
              'a' : ChangeAccess := True;
              'm' : ChangeModify := True;
              else  Abort('Error: wrong parameter ' + Paramstr(i));
            end;
         end;
         Inc(i);
   end;
   if FileName = '' then
      Abort('Error: no file name is given');
   if not ChangeAccess and not ChangeModify then begin
      ChangeAccess := True;
      ChangeModify := True;
   end;
   SetFileTime(FileName, Timestamp, ChangeAccess, ChangeModify);
   Writeln('Timestamp: '+
           {$IFDEF DOS} FormatTimeDos {$ELSE} FormatTimestamp {$ENDIF} (Timestamp) +
           ' for file "' + FileName + '" has been set.');
   Readln;
end.

und die Unit dazu:

Code: Alles auswählen

unit watch;

{$IFNDEF DOS}
{$mode objfpc}{$H+}
{$ENDIF}

interface

uses Stdio;

type
   TDosTime = LongInt;

function GetTimestamp: Card;
function DTValues2Timestamp(Year, Month, Day, Hour, Min, Sec, Sec100: Word): Card;
function FormatTimestamp(TS: Card): string;
function FormatDTValues(Year, Month, Day, Hour, Min, Sec, Sec100: Word): string;
procedure Timestamp2DTValues(TS: Card; var Year, Month, Day, Hour, Min, Sec, Sec100: Word);

function GetTimeDos: TDosTime;
function DTValues2TimeDos(Year, Month, Day, Hour, Min, Sec: Word): TDosTime;
function FormatTimeDos(DT: TDosTime): string;
procedure TimeDos2DTValues(DT: TDosTime; var Year, Month, Day, Hour, Min, Sec: Word);

function Timestamp2TimeDos(TS: Card): TDosTime;
function TimeDos2Timestamp(DT: TDosTime): Card;

function IsLeapYear(Year: Word): Boolean;
function GetCurrentYear: Word;

implementation

uses
   Dos;

const
   DaysInMonth: array[1..12] of Word = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

function IsLeapYear(Year: Word): Boolean;
begin
   IsLeapYear := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
end;

procedure Timestamp2DTValues(TS: Card; var Year, Month, Day, Hour, Min, Sec, Sec100: Word);
var
   DaysLeft: Card;
begin
   DaysLeft := TS div 86400000;
   TS := TS mod 86400000;
   Year := 1970;
   while DaysLeft >= (365 + Ord(IsLeapYear(Year))) do begin
      Dec(DaysLeft, 365 + Ord(IsLeapYear(Year)));
      Inc(Year);
   end;
   Month := 1;
   while DaysLeft >= (DaysInMonth[Month] + Ord((Month = 2) and IsLeapYear(Year))) do begin
      Dec(DaysLeft, DaysInMonth[Month] + Ord((Month = 2) and IsLeapYear(Year)));
      Inc(Month);
   end;
   Day := DaysLeft + 1;
   Hour := TS div 3600000;
   TS := TS mod 3600000;
   Min := TS div 60000;
   TS := TS mod 60000;
   Sec := TS div 1000;
   Sec100 := (TS mod 1000) div 10;
end;

function DTValues2Timestamp(Year, Month, Day, Hour, Min, Sec, Sec100: Word): Card;
var
   TotalDays: Card;
   i: Integer;
begin
   TotalDays := 0;
   for i := 1970 to Year - 1 do
      if IsLeapYear(i)
         then Inc(TotalDays, 366)
         else Inc(TotalDays, 365);
   for i := 1 to Month - 1 do
      Inc(TotalDays, DaysInMonth[i] + Ord((i = 2) and IsLeapYear(Year)));
   Inc(TotalDays, Day - 1);
   DTValues2Timestamp := TotalDays * 86400000 + Hour * 3600000 + Min * 60000 + Sec * 1000 + Sec100 * 10;
end;

function GetTimestamp: Card;
var
   Year, Month, Day, Hour, Min, Sec, Sec100, Dummy: Word;
begin
   GetDate(Year, Month, Day, Dummy);
   GetTime(Hour, Min, Sec, Sec100);
   GetTimestamp := DTValues2Timestamp(Year, Month, Day, Hour, Min, Sec, Sec100);
end;

function FormatDTValues(Year, Month, Day, Hour, Min, Sec, Sec100: Word): string;
begin
  FormatDTValues :=
     Str0Card(Day,2) +  '.' +
     Str0Card(Month,2) +  '.' +
     Str0Card(Year,2) +  ' ' +
     Str0Card(Hour,2) +  ':' +
     Str0Card(Min,2) +  ':' +
     Str0Card(Sec,2) +  ',' +
     Str0Card(Sec100,3);
end;

function FormatTimestamp(TS: Card): string;
var
   Year, Month, Day, Hour, Min, Sec, Sec100: Word;
begin
   Timestamp2DTValues(TS, Year, Month, Day, Hour, Min, Sec, Sec100);
   FormatTimestamp := FormatDTValues(Year, Month, Day, Hour, Min, Sec, Sec100);
end;

function DTValues2TimeDos(Year, Month, Day, Hour, Min, Sec: Word): TDosTime;
begin
  if Year < 1980 then Year := 1980;    { DOS erlaubt keine Jahre vor 1980 }
  DTValues2TimeDos :=
     (LongInt(Year - 1980) shl 25) or  { Jahr ab 1980 speichern (7 Bit) }
     (LongInt(Month) shl 21)       or  { Monat (4 Bit) }
     (LongInt(Day) shl 16)         or  { Tag (5 Bit) }
     (LongInt(Hour) shl 11)        or  { Stunde (5 Bit) }
     (LongInt(Min) shl 5)          or  { Minute (6 Bit) }
     (LongInt(Sec div 2));             { Sekunde/2 (5 Bit) }
end;

function GetTimeDos: TDosTime;
var
   Year, Month, Day, Dummy, Hour, Min, Sec: Word;
begin
   GetDate(Year, Month, Day, Dummy);
   GetTime(Hour, Min, Sec, Dummy);
   GetTimeDos := DTValues2TimeDos(Year, Month, Day, Hour, Min, Sec);
end;

procedure TimeDos2DTValues(DT: TDosTime; var Year, Month, Day, Hour, Min, Sec: Word);
begin
   Year := 1980 + (DT shr 25) and $7F;
   Month := (DT shr 21) and $0F;
   Day := (DT shr 16) and $1F;
   Hour := (DT shr 11) and $1F;
   Min := (DT shr 5) and $3F;
   Sec := (DT and $1F) * 2;
end;

function FormatTimeDos(DT: TDosTime): string;
var
   Hour, Min, Sec: Word;
   Year, Month, Day: Word;
begin
   TimeDos2DTValues(DT, Year, Month, Day, Hour, Min, Sec);
   FormatTimeDos := FormatDTValues(Year, Month, Day, Hour, Min, Sec, 0);
end;

function Timestamp2TimeDos(TS: Card): TDosTime;
var
   Year, Month, Day, Hour, Min, Sec, Sec100: Word;
begin
   Timestamp2DTValues(TS, Year, Month, Day, Hour, Min, Sec, Sec100);
   Timestamp2TimeDos := DTValues2TimeDos(Year, Month, Day, Hour, Min, Sec);
end;

function TimeDos2Timestamp(DT: TDosTime): Card;
var
   Year, Month, Day, Hour, Min, Sec: Word;
begin
   TimeDos2DTValues(DT, Year, Month, Day, Hour, Min, Sec);
   TimeDos2Timestamp := DTValues2Timestamp(Year, Month, Day, Hour, Min, Sec, 0);
end;

function GetCurrentYear: Word;
var
   Year, Dummy: Word;
begin
   GetDate(Year, Dummy, Dummy, Dummy);
   GetCurrentYear := Year;
end;

end.

Kann ich mir die Unterscheidung im Hauptprogramm sparen und nur mit DOS-Timestamp arbeiten, da Pascal eh nichts anderes kann? Die anderen Funktionen brauche ich schon noch, nur eben dann nicht mehr in diesem Programm

[Jorg3000]

Moin!

ZB Heute wird dann nach 2049 verschoben. Geht mit Pascal wirklich nur der DOS-Timestamp?

Ich glaube nicht, dass es ein Pascal-Problem ist, sondern eher ein Fehler in den Umrechnungsfunktionen. ChatGPT erzeugt gerne hübsch aussehenden Mist. Oder die Funktionen werden mit falschen Parametern aufgerufen oder falsch kombiniert.
Hast du die Umrechnungsfunktionen mal direkt getestet, ohne Dateien? Also einfach mal einen DOS- in einen Linux-Timestamp umgerechnet und zurück?

Übrigens, ich finde die Definition: type TTimestamp = {$IFDEF DOS} TDosTime {$ELSE} Card {$ENDIF};
ganz unglücklich, denn bei einem unklaren Typ ist es im Quellcode nur schwerlich nachverfolgbar, was gerade genau passiert.

Anstatt überall im Code mit bedingter Kompilierung zu arbeiten, könnte man auch überlegen, eine Unit speziell für DOS/Windows und eine für Linux zu machen - mit gleichem Interface-Teil natürlich.

[Zvoni]

Bin jetzt nicht durch den ganzen Code gegangen, aber mir ist aufgefallen, dass du ne ziemlich komplizierte Schaltjahr Rechnung hast

Ich hatte hierzu mal nen Vorschlag zur Verbesserung im internat. Forum gestellt.

Anbei meine eigene Funktionen:

Code: Alles auswählen

Function IsLeapYear(Year:Word):Boolean;
Begin
  If Year mod 100<>0 Then
     Result:=(Year And 3)=0
  Else
     Result:=(Year And 15)=0;
End;

Function DaysInMonth(const AYear, AMonth: Word): Word;
begin
  If AMonth=2 Then
     Result:=28+Ord(IsLeapYear(AYear))
  Else
     Result:=30 Or (AMonth Xor (AMonth shr 3));
end;

Das allgemeine Ergebnis war, dass meine Funktionen deutlich schneller waren

[alfware17]

@ Zvoni, vielen Dank das habe ich glatt mal eingebaut mit dem Schaltjahr. Und dann die ganze String-Parserei ausgelagert, vielleicht fallen mir noch ein paar Formate ein. Auf die Dateutils wollte ich ja bewußt verzichten...

@Jorg3000, ja du hast ja recht, es ist etwas unübersichtlich geworden - daher fragte ich ja auch, ob ich mich auch einen der beiden Timestamps stürzen kann, wenn die File-Operationen eh nur den einen können. Und habe es dann auch so gemacht (siehe die Unit Watch, TimestampDos -> umbenannt in Timestamp und der andere eben TimeUnx).

Wie immer war dann der Teufel im Detail, weil als ich es im Linux testen wollte, stellte sich heraus, die wollen für fpUptime doch wieder den Unx-Timestamp und jede Menge Klimmzüge mit Zeitzonen UTC usw, ja ich weiß mein PC und meine Virtual Boxen sind wahrscheinlich hoffnungslos verstellt und Linux ist wie immer gnadenlos kleinlich was ich aber gut finde, solange wie es immer eine Stellschraube gibt.

Mein "2049-Problem" konnte ich zwar nicht lösen, es ist aber weg, seit ich für Win/Dos konsequent Dos-Timestamp nutze. Ich vermute da war noch was mit mal 1000 oder durch 1000,
jedenfalls hatte Linux auch erst 1908 usw ermittelt.

Also die Aussage für mich bleibt - ich kann mir die beiden Timestamps gerne berechnen, in Windows/Dos taugt allerdings für Dateiattribute nur der ältere, und daß das so konsequent bei Lazarus/Freepascal auch gilt (Windows), finde ich schade. Aber ok, wenn das Betriebssystem oder Filesystem nicht mehr her gibt.

Hier mein abschließender Code - die Watch werde ich später mal in meine Zeit-Unit integrieren, wo ich wie gesagt so ein paar unterschiedliche Timestamps und Parsen und Konvertieren gut gebrauchen kann.

Code: Alles auswählen

program Touch;

{$IFNDEF DOS}
   {$MODE OBJFPC}
   uses SysUtils, DateUtils, Dos, Stdio, Zeit, Watch
     {$IFDEF UNIX} , BaseUnix, Unix {$ENDIF};
{$ELSE}
   uses Dos, Stdio, Zeit, Watch;
{$ENDIF}

procedure PrintHelp;
begin
   WriteLn('Usage: touch [OPTIONS] <filename>');
   WriteLn('Options:');
   WriteLn('  -r <file>   Set the timestamp of <filename> to that of <file>');
   WriteLn('  -t <time>   Set the timestamp of <filename> to the specified time (YYYYMMDDhhmmss)');
   WriteLn('  -a          Change only the access time');
   WriteLn('  -m          Change only the modification time');
   WriteLn('  -h          Show this help message');
   Halt(0);
end;

procedure Abort(reason: String);
begin
   Writeln(reason);
   Halt(1);
end;

function GetFileTime(FileName: string): TDosTime;
{$IFDEF DOS}
var
   F: File;
   DT: TDosTime;
begin
   Assign(F, FileName);
   {$I-} Reset(F); {$I+}
   if IOResult <> 0 then begin
      GetFileTime := -1;
      Exit;
   end;
   GetFTime(F, DT);
   Close(F);
   GetFileTime := DT;
{$ELSE}
var
   Info: SearchRec;
begin
   FindFirst(FileName, faAnyFile, Info);
   if DosError <> 0 then begin
      GetFileTime := -1;
      Exit;
   end;
   GetFileTime := Info.Time;
   FindClose(Info);
{$ENDIF}
end;

procedure SetFileTime(FileName: string; TS: TDosTime; ChangeAccess, ChangeModify: Boolean);
{$IFDEF UNIX}
var
    UTS: TUnxTime;
    LocalDT, UtcDT: TDateTime;
    UT: TUTimBuf;
{$ENDIF}
{$IFDEF DOS}
var
   F: File;
{$ENDIF}
begin
   if GetFileTime(FileName) < 0 then Exit;
   {$IFDEF UNIX}
   UTS := Timestamp2TimeUnx(TS) div 1000;
   LocalDT := UnixToDateTime(UTS);
   UtcDT := LocalTimeToUniversal(LocalDT);
   UTS := DateTimeToUnix(UtcDT);
   if ChangeAccess then 
      UT.actime := UTS;
   if ChangeModify then 
      UT.modtime := UTS;
   fpUtime(FileName, @UT);
   {$ELSE}
      {$IFDEF DOS}
      if ChangeModify then begin
         Assign(F, FileName);
         {$I-} Reset(F); {$I+}
         if IOResult <> 0 then Exit;
         SetFTime(F, TS);
         Close(F);
      end;
      {$ELSE}
      if ChangeModify then
         FileSetDate(FileName,TS);
      {$ENDIF}
   {$ENDIF}
end;

procedure ShowTimeStamp(Kommentar: String; TS: TDosTime);
begin
   Writeln(Kommentar,' ', FormatTimestamp(TS));
end;

var
   i: Integer;
   FileName: string;
   SourceFile: string;
   Timestamp, tmpDT: TDosTime;
   tmpUnx: TUnxTime;
   ChangeAccess, ChangeModify: Boolean;
   OptC: char;
   OptS: string;
begin
   if ParamCount = 0 then begin
      PrintHelp;
      Halt(1);
   end;
   ChangeAccess := False;
   ChangeModify := False;
   SourceFile := '';
   Timestamp := GetTimestamp;
   i := 1;
   while i <= ParamCount do begin
      OptS := Paramstr(i);
      if OptS[1] <> '-'
         then FileName := OptS
         else begin
            OptC := OptS[2];
            case OptC of
              'h' : PrintHelp;
              'r' : begin
                       if i + 1 <= ParamCount then begin
                          SourceFile := ParamStr(i + 1);
                          Inc(i);
                       end
                       else Abort('Error: no reference file is given after -r');
                       Timestamp := GetFileTime(SourceFile);
                       if Timestamp <> -1
	      	          then ShowTimeStamp('reference timestamp: ', Timestamp)
                          else Abort('Error: no valid timestamp for reference file');
                    end;
              't' : begin
                       if i + 1 <= ParamCount then begin
                          ParseDateTime(ParamStr(i + 1), tmpDT, tmpUnx);
                          if tmpDT < 0 then
                             Abort('Error: timestamp given has no valid format ' + Paramstr(i + 1));
                          Timestamp := tmpDT;
                          Writeln('-t using DT: ', FormatTimestamp(Timestamp), ' UNX: ', FormatTimeUnx(tmpUnx));
                          Inc(i);
                       end
                       else Abort('Error: no timestamp is given after -t');
                    end;
              'a' : ChangeAccess := True;
              'm' : ChangeModify := True;
              else  Abort('Error: wrong parameter ' + Paramstr(i));
            end;
         end;
         Inc(i);
   end;
   if FileName = '' then
      Abort('Error: no file name is given');
   if GetFileTime(FileName) < 0 then
      Abort('Error: file not exits!');
   if not ChangeAccess and not ChangeModify then begin
      ChangeAccess := True;
      ChangeModify := True;
   end;
   SetFileTime(FileName, Timestamp, ChangeAccess, ChangeModify);
   Writeln('Timestamp: '+ FormatTimestamp(Timestamp) + ' for file "' + FileName + '" has been set');
end.

Code: Alles auswählen

unit watch;

{$IFNDEF DOS}
{$mode objfpc}{$H+}
{$ENDIF}

interface

uses Stdio;

const
   MS_PER_DAY     = 86400000;
   MS_PER_HOUR    = 3600000;
   MS_PER_MINUTE  = 60000;
   MS_PER_SECOND  = 1000;

type
   TDosTime = LongInt;
   TUnxTime = Card;

function GetTimeUnx: TUnxTime;
function DTValues2TimeUnx(Year, Month, Day, Hour, Min, Sec, MSec: Word): TUnxTime;
function FormatTimeUnx(TS: TUnxTime): string;
function FormatDTValues(Year, Month, Day, Hour, Min, Sec, MSec: Word): string;
procedure TimeUnx2DTValues(TS: TUnxTime; var Year, Month, Day, Hour, Min, Sec, MSec: Word);

function GetTimestamp: TDosTime;
function DTValues2Timestamp(Year, Month, Day, Hour, Min, Sec: Word): TDosTime;
function FormatTimestamp(DT: TDosTime): string;
procedure Timestamp2DTValues(DT: TDosTime; var Year, Month, Day, Hour, Min, Sec: Word);

function TimeUnx2Timestamp(TS: TUnxTime): TDosTime;
function Timestamp2TimeUnx(DT: TDosTime): TUnxTime;

function IsLeapYear(Year: Word): Boolean;
function DaysInMonth(Year, Month: Word): Word;

procedure ParseDateTime(DateTimeStr: string; var DT: TDosTime; var UT: TUnxTime);

function GetCurrentYear: Word;

implementation

uses
   Dos;

function IsLeapYear(Year: Word):Boolean;
begin
  if Year mod 100 <> 0
     then IsLeapYear := (Year and 3) = 0
     else IsLeapYear := (Year and 15) = 0;
end;

function DaysInMonth(Year, Month: Word): Word;
begin
  if Month = 2
     then DaysInMonth := 28 + ord(IsLeapYear(Year))
     else DaysInMonth := 30 or (Month xor (Month shr 3));
end;

procedure TimeUnx2DTValues(TS: TUnxTime; var Year, Month, Day, Hour, Min, Sec, MSec: Word);
var
   DaysLeft: TUnxTime;
begin
   DaysLeft := TS div MS_PER_DAY;
   TS := TS mod MS_PER_DAY;
   Year := 1970;
   while DaysLeft >= 365 + ord(IsLeapYear(Year)) do begin
      Dec(DaysLeft, 365 + ord(IsLeapYear(Year)));
      Inc(Year);
   end;
   Month := 1;
   while DaysLeft >= DaysInMonth(Year, Month) do begin
      Dec(DaysLeft, DaysInMonth(Year, Month));
      Inc(Month);
   end;
   Day := DaysLeft + 1;
   Hour := TS div MS_PER_HOUR;
   TS := TS mod MS_PER_HOUR;
   Min := TS div MS_PER_MINUTE;
   TS := TS mod MS_PER_MINUTE;
   Sec := TS div MS_PER_SECOND;
   MSec := (TS mod MS_PER_SECOND);
end;

function DTValues2TimeUnx(Year, Month, Day, Hour, Min, Sec, MSec: Word): TUnxTime;
var
   TotalDays: TUnxTime;
   i: Integer;
begin
   TotalDays := 0;
   for i := 1970 to Year - 1 do
      Inc(TotalDays, 365 + Ord(IsLeapYear(i)));
   for i := 1 to Month - 1 do
      Inc(TotalDays, DaysInMonth(Year, i));
   Inc(TotalDays, Day - 1);
   DTValues2TimeUnx :=
      TotalDays * MS_PER_DAY + Hour * MS_PER_HOUR + Min * MS_PER_MINUTE +
      Sec * MS_PER_SECOND + MSec;
end;

function GetTimeUnx: TUnxTime;
var
   Year, Month, Day, Hour, Min, Sec, MSec, Dummy: Word;
begin
   GetDate(Year, Month, Day, Dummy);
   GetTime(Hour, Min, Sec, MSec);
   GetTimeUnx := DTValues2TimeUnx(Year, Month, Day, Hour, Min, Sec, MSec);
end;

function FormatDTValues(Year, Month, Day, Hour, Min, Sec, MSec: Word): string;
var temp: string;
begin
  temp :=
     Str0Card(Day,2) +  '.' +
     Str0Card(Month,2) +  '.' +
     Str0Card(Year,2);
  if (Hour > 0) or (Min > 0) or (Sec > 0) then
     temp := temp + ' ' +
     Str0Card(Hour,2) +  ':' +
     Str0Card(Min,2) +  ':' +
     Str0Card(Sec,2);
  if MSec > 0 then
     temp := temp +  ',' +
     Str0Card(MSec,3);
  FormatDTValues := temp;
end;

function FormatTimeUnx(TS: TUnxTime): string;
var
   Year, Month, Day, Hour, Min, Sec, MSec: Word;
begin
   TimeUnx2DTValues(TS, Year, Month, Day, Hour, Min, Sec, MSec);
   FormatTimeUnx := FormatDTValues(Year, Month, Day, Hour, Min, Sec, MSec);
end;

function DTValues2Timestamp(Year, Month, Day, Hour, Min, Sec: Word): TDosTime;
begin
  if Year < 1980 then Year := 1980;    { DOS erlaubt keine Jahre vor 1980 }
  DTValues2Timestamp :=
     (LongInt(Year - 1980) shl 25) or  { Jahr ab 1980 speichern (7 Bit) }
     (LongInt(Month) shl 21)       or  { Monat (4 Bit) }
     (LongInt(Day) shl 16)         or  { Tag (5 Bit) }
     (LongInt(Hour) shl 11)        or  { Stunde (5 Bit) }
     (LongInt(Min) shl 5)          or  { Minute (6 Bit) }
     (LongInt(Sec div 2));             { Sekunde/2 (5 Bit) }
end;

function GetTimestamp: TDosTime;
var
   Year, Month, Day, Dummy, Hour, Min, Sec: Word;
begin
   GetDate(Year, Month, Day, Dummy);
   GetTime(Hour, Min, Sec, Dummy);
   GetTimestamp := DTValues2Timestamp(Year, Month, Day, Hour, Min, Sec);
end;

procedure Timestamp2DTValues(DT: TDosTime; var Year, Month, Day, Hour, Min, Sec: Word);
begin
   Year := 1980 + (DT shr 25) and $7F;
   Month := (DT shr 21) and $0F;
   Day := (DT shr 16) and $1F;
   Hour := (DT shr 11) and $1F;
   Min := (DT shr 5) and $3F;
   Sec := (DT and $1F) * 2;
end;

function FormatTimestamp(DT: TDosTime): string;
var
   Hour, Min, Sec, Year, Month, Day: Word;
begin
   Timestamp2DTValues(DT, Year, Month, Day, Hour, Min, Sec);
   FormatTimestamp := FormatDTValues(Year, Month, Day, Hour, Min, Sec, 0);
end;

function TimeUnx2Timestamp(TS: TUnxTime): TDosTime;
var
   Year, Month, Day, Hour, Min, Sec, MSec: Word;
begin
   TimeUnx2DTValues(TS, Year, Month, Day, Hour, Min, Sec, MSec);
   TimeUnx2Timestamp := DTValues2Timestamp(Year, Month, Day, Hour, Min, Sec);
end;

function Timestamp2TimeUnx(DT: TDosTime): TUnxTime;
var
   Year, Month, Day, Hour, Min, Sec: Word;
begin
   Timestamp2DTValues(DT, Year, Month, Day, Hour, Min, Sec);
   Timestamp2TimeUnx := DTValues2TimeUnx(Year, Month, Day, Hour, Min, Sec, 0);
end;

type StringArray = array[0..5] of string;

function SplitString(S: string; Delim: Char; var Parts: StringArray): Integer;
var
  PCount, I, Start, Len: Integer;
begin
  PCount := 0;
  Start := 1;
  Len := Length(S);
  I := 1;
  while I <= len do begin
     if (S[I] = Delim) or (I = Len) then begin
        if I = Len then Inc(I);
        if PCount < High(Parts) then begin
           Parts[PCount] := Copy(S, Start, I - Start);
           Inc(PCount);
        end;
        Start := I + 1;
     end;
     Inc(I);
  end;
  SplitString := PCount;
end;

procedure ParseDateTime(DateTimeStr: string; var DT: TDosTime; var UT: TUnxTime);
var
   Year, Month, Day, Hour, Minute, Second, Sec1000: Integer;
   Parts, DateParts, TimeParts: StringArray;
   CountP, CountD, CountT, HSPos: Integer;
   HSStr: string;
begin
   UT := -1;
   Year := 0; Month := 0; Day := 0; Hour := 0; Minute := 0; Second := 0; Sec1000 := 0;
   if Length(DateTimeStr) = 14 then begin  // JJJJMMTTHHMMSS ohne Trennzeichen
      Year := Str2Card(Copy(DateTimeStr, 1, 4));
      Month := Str2Card(Copy(DateTimeStr, 5, 2));
      Day := Str2Card(Copy(DateTimeStr, 7, 2));
      Hour := Str2Card(Copy(DateTimeStr, 9, 2));
      Minute := Str2Card(Copy(DateTimeStr, 11, 2));
      Second := Str2Card(Copy(DateTimeStr, 13, 2));
      DT := 0; UT := 0;
   end
   else begin
      CountP := SplitString(DateTimeStr, ' ', Parts);
      if (CountP > 0) and (CountP <= 2) then begin
         CountD := SplitString(Parts[0], '.', DateParts);
         if CountD = 3 then begin
            Day := Str2Card(DateParts[0]);
            Month := Str2Card(DateParts[1]);
            Year := Str2Card(DateParts[2]);
            if Year < 100 then Inc(Year, 2000);
         end;
         if CountP = 2 then begin
            HSPos := Pos(',', Parts[1]);
            if HSPos > 0 then begin
               HSStr := Copy(Parts[1], HSPos + 1, 3);
               case Length(HSStr) of
                  1: HSStr := HSStr + '00';
                  2: HSStr := HSStr + '0';
               end;
               Sec1000 := Str2Card(HSStr);
               Parts[1] := Copy(Parts[1], 1, HSPos - 1);
            end;
            CountT := SplitString(Parts[1], ':', TimeParts);
            if CountT >= 2 then begin
               Hour := Str2Card(TimeParts[0]);
               Minute := Str2Card(TimeParts[1]);
               if CountT > 2
                  then Second := Str2Card(TimeParts[2])
                  else Second := 0;
            end;
         end;
         DT := 0; UT := 0;
      end;
   end;

   if (Year < 1980) or (Month < 1) or (Month > 12) or (Day < 1) or (Day > 31) then UT := -1;
   if Month > DaysInMonth(Year, Month) then UT := -1;
   if (Hour < 0) or (Hour > 23) or (Minute < 0) or (Minute > 59) or (Second < 0) or (Second > 59) or (Sec1000 < 0) or (Sec1000 > 999) then UT := -1;

   if UT = 0 then begin
      DT := DTValues2Timestamp(Year, Month, Day, Hour, Minute, Second);
      UT := DTValues2TimeUnx(Year, Month, Day, Hour, Minute, Second, Sec1000);
   end;
end;

function GetCurrentYear: Word;
var
   Year, Dummy: Word;
begin
   GetDate(Year, Dummy, Dummy, Dummy);
   GetCurrentYear := Year;
end;

begin
end.

[greye]

Gesagt getan, in Python und Java hat ChatGPT das für mich gemacht, in Lazarus habe ich dann selber. Dann wollte ich es portieren von Lazarus auf Turbo-Pascal und auch schauen, ob es Linux-fähig wäre.

Ich lese hier begeistert mit, lerne gerade sehr viel und stelle dann auch mal komische Fragen wie die:

Wieso Turbo-Pascal? Ich verstehe es so, daß Du für Windows, Linux und DOS entwickeln willst. Das geht IMHO doch alles mit Lazarus/FPC, von daher verstehe ich den Klimmzug mit Turbo-Pascal nicht. Wo liegt mein Denkfehler, das Missverständnis?

42m

[alfware17]

Gesagt getan, in Python und Java hat ChatGPT das für mich gemacht, in Lazarus habe ich dann selber. Dann wollte ich es portieren von Lazarus auf Turbo-Pascal und auch schauen, ob es Linux-fähig wäre.

Ich lese hier begeistert mit, lerne gerade sehr viel und stelle dann auch mal komische Fragen wie die:

Wieso Turbo-Pascal? Ich verstehe es so, daß Du für Windows, Linux und DOS entwickeln willst. Das geht IMHO doch alles mit Lazarus/FPC, von daher verstehe ich den Klimmzug mit Turbo-Pascal nicht. Wo liegt mein Denkfehler, das Missverständnis?

42m

Ich weiß daß es einen FPC Crosscompile für 16bit gibt, ich habe mich auch mal damit beschäftigt. Nur war das Ergebnis (die EXE) dann doch nicht nach meinen Wünsche, sprich entweder gar nicht lauffähig in MSDOS oder ich mußte inhaltlich Kompromisse eingehen, hatte weniger Speicher usw... (ich weiß die ganzen Symptome jetzt nicht mehr, nur daß ich irgendwann mal beschlossen hatte, dann doch lieber beim Turbo zu bleiben, was ich nebenbei sogar noch original compilieren kann in einer MSDOS Virtualbox eben oder unter Win XP). Und ja, weil hier die Frage kam, warum mache ich einen Quelltext für verschiedene Systeme und quäle mich dann an den unterschiedlichen Stellen mit bedingter Compilierung herum anstatt 4 oder 5 Quelltexte für jedes System eins zu machen? Nun einfach weil ich es schon immer so mache und weil ich ein alter Mann und IT-Dino bin. Vielleicht ist mein Weg ja auch leichter (oder schwerer? keine Ahnung, wenn mir das mal jemand beweisen möchte stelle ich gerne ein Beispiel zur Verfügung wie meinen generischen Stack/Deque, bei dem ich für Turbo ganz schöne Klimmzüge gebraucht habe). Mit dem Auswechseln einer ganzen Unit ist es aber nicht getan, denn die bedingte Compilierung ist ja auch mitten drin im Programm. Und, bisher finde ich es ehrlich gesagt einfacher, das Gemeinsame (was je nach Thema 50 bis 100% sein kann) auch gemeinsam im File zu lassen und nur die Unterschiede dann bedingt compiliert zu bauen. Ich habe wie angedeutet Unterscheidungen nach 16/32/64 Bit, DOS/Windows und Linux, je nachdem. Nur an i-apple will/muß ich zum Glück keinen Gedanken verschwenden.