Source file: /~heha/hsn/dos/dirtouch.zip/DIRTOUCH.PAS

program dirtouch;
{henrik.haftmann@e-technik.tu-chemnitz.de}
{http://www.tu-chemnitz.de/~heha/hs_freeware/dirtouch.zip}
{Wieder mal ein TOUCH, diesmal MIT VERZEICHNISSEN
 17.03.98:	fehlender LongInt-Typecast fhrte zu teilw. Nichtfunktion
		Erweiterte und korrigierte Usage
 12.05.98:	Korrigierte Usage, Funktion "Datum von Datei bernehmen",
		Funktion "Nur Uhrzeit" (z.B. als Versionsnummer)
 03.09.98:	Bugfix: šbernahme des aktuellen Jahres
		Touch von Dateien via Handle-Funktion (um Fehlfunktion
		auf Netzlaufwerk und FAT32-Partitionen auszugleichen)
		Angleich aller .- und ..-Verweise beim Verzeichnis-Touch
		Umverlegung von globalen Variablen
 15.02.99:	Bugfix (katastrophaler Fehler in der Hauptschleifen-
		Konstruktion) sowie Hinzufgung der ausfhrlichen Hilfe
 05.10.00:	FAT32-Erweiterung
 02.11.00:	automatisches LOCK/UNLOCK, Dok-Fehler-Beseitigung
 25.01.03:	Verwendung der DOSLFN/Win9x-Funktionen ohne Direktzugriff
		Lange Dateinamen, DBCS-sicher (ohne FileSplit)
}
{$M $4000,0,0}
{$X+,T+,B-,P+,V+,I-,S-}
uses WinDos,Strings,Parser,Lfn;

type
 PFill=^TFill;
 TFill=record	{Undokumentierter Teil des SearchRec}
  Drive: Byte;	{Bit7 gesetzt bei Netzlaufwerk und FAT32}
  NameExt:Array[0..10] of Char;
  Attr:  Byte;
  DirNo: Word;
  case integer of
   1:( Clus:	Word;
       Res:	LongInt);
   7:( Clus32:	LongInt;	{bei FAT32}
       Res32:	Word);		{vielleicht der High-Teil von DirNo?}
 end;

 pDPB=^tDPB;	{Drive Parameter Block}
 tDPB=record	{gltig ab DOS 4.0}
  Drive:  Byte;	{0=A}
  UnitNo: Byte;	{Nummer im Einheitentreiber}
  SecLen: Word;	{Bytes pro Sektor}
  HiSec:  Byte;	{Anzahl Sektoren pro Cluster -1, 2**n-1}
  Shift:  Byte; {Verschiebung n}
  ResSec: Word;	{Reservierte Sektoren am Anfang des Laufwerks}
  FATs:	  Byte;	{Anzahl der FATs}
  RootEn: Word; {Anzahl Wurzelverzeichniseintr„ge}
  UsrSec: Word;	{1. Sektor mit Userdaten}
  HiClus: Word; {Anzahl Cluster -1}
  SecFAT: Word;	{Sektoren pro FAT}
  SecDir: Word;	{Sektornummer 1.Dir}
 end;

 pExDPB=^tExDPB;	{Drive Parameter Block}
 tExDPB=record	{gltig ab DOS 4.0}
  case integer of
  1: (dpb: TDPB);
  2: (
  res: array[0..23] of Byte;
  dpb_flags: Byte;
  next_dpb: Pointer;
  start_search_cluster: Word;
  free_clusters: LongInt;
  mirroring: Word;
  file_system_info_sector: Word;
  backup_boot_sector: Word;
  first_sector: LongInt;
  max_cluster: LongInt;
  sectors_per_fat: LongInt;
  root_cluster: LongInt;
  free_space_cluster: LongInt);
 end;

 pDirEntry=^tDirEntry;	{Verzeichniseintrag auf Platte (FAT12, FAT16, FAT32)}
 tDirEntry=record	{Quelle: Ralf Brown Interruptliste}
  NameExt:array[0..10]of Char;
  Attr:   Byte;
  resv:	  Byte;			{Win98: Null (High-GrӇe fr Dateien >4GB)}
  timec10ms: Byte;		{Win95: 10ms additiv zu Creation_Time [0..199]}
  timec:  LongInt;		{Win95: Erstellungs-Zeit (lokale Zeit)}
  datea:  Word;			{Win95: Letzter Zugriff (nur Datum)}
  ClusHi: Word;			{FAT32: High-Teil des Start-Clusters}
  Time:   LongInt;
  ClusLo: Word;
  Size:   LongInt;
 end;

type
 tRWRec=record			{fr INT25, INT26, INT21/7305}
  Sect: LongInt;		{Sektor-Nummer}
  Numb: Word;			{Anzahl Sektoren}
  Addr: Pointer;		{Speicher-Adresse}
 end;

const
 BigDos	=1;
 Win95	=2;
 FAT32	=4;
var
 DPB_Drive:	Byte;		{Drive Parameter Block: Laufwerk}
 DPB_UsrSec:	LongInt;	{Sektor des 1. Clusters}
 DPB_DirSec:	LongInt;	{Sektor Hauptverzeichnis (nur FAT12/FAT16)}
 DPB_Shift:	Byte;		{Verschiebung fr Sektoren pro Cluster}
 DosType:	Byte;		{Schalter fr Festplatten-Zugriffsart}
 Sektor:	array[0..$1ff]of byte;  {Puffer}

const
 RWRec: tRWRec=(Sect:0;Numb:1;Addr:@Sektor);

function ReadSec:byte; assembler;
{Liest einen Sektor Nummer <RWRec.Sect> nach <Sektor>, PA: Fehlercode}
 asm
  push	bp
   mov	al,[DosType]
   test	al,FAT32
   jnz	@@fat32
   test al,BigDos
   jnz	@@b		{gleich zu BIGDOS}
   mov	al,DPB_Drive
   lea	bx,Sektor
   mov	cx,1
   mov	dx,word ptr RWRec.Sect
   int	25h
   pop	dx		{Stack korrigieren}
   jnc	@@ok
   cmp	ax,0207h	{zu BIGDOS wechseln? lt.RBIL}
   jnz	@@e		{nein, sonstiger Fehler}
   or	DosType,BigDos
@@b:
   mov	al,DPB_Drive
   lea	bx,RWRec
   mov	cx,0ffffh
   int	25h
   pop	dx
   jc	@@e		{bei Fehler}
   jmp	@@ok
@@fat32:
   mov	dl,DPB_Drive
   inc	dl
   mov	cx,0FFFFh
   mov	si,0		{lesen}
   lea	bx,RWRec
   mov	ax,7305h
   int	21h
   jc	@@e
@@ok:
   mov	al,-13h
@@e:
   add	al,13h		{DOS-Fehlernummer}
  pop	bp
 end;

function WriteSec:byte; assembler;
{Schreibt Sektor <Sektor> nach Nummer <RWRec.Sect>, PA: Fehlercode}
 asm
  push	bp
   mov	al,[DosType]
   test	al,FAT32
   jnz	@@fat32
   test	al,BigDos
   jnz	@@b		{gleich zu BIGDOS}
   mov	al,DPB_Drive
   lea	bx,Sektor
   mov	cx,1
   mov	dx,word ptr RWRec.Sect
   int	26h
   pop	dx		{Flags korrigieren}
   jnc	@@ok
   cmp	ax,0207h	{zu BIGDOS wechseln? lt.RBIL}
   jnz	@@e		{nein, sonstiger Fehler}
   or	DosType,BigDos
@@b:
   mov	al,DPB_Drive
   lea	bx,RWRec
   mov	cx,0ffffh
   int	26h
   pop	dx
   jc	@@e		{bei Fehler}
   jmp	@@ok
@@fat32:
   mov	dl,DPB_Drive
   inc	dl
   mov	cx,0FFFFh
   mov	si,4001h	{schreiben: Directory Data}
   lea	bx,RWRec
   mov	ax,7305h
   int	21h
   jc	@@e
@@ok:
   mov	al,-13h
@@e:
   add	al,13h		{DOS-Fehlernummer}
  pop	bp
 end;

function GetDrvParams(Drive:Byte):boolean; assembler;
{Ermittelt Laufwerksparameter fr <Drive> (1=A: usw.)
 und setzt die Variablen DPB_xxx sowie DosType, PA: TRUE wenn OK}
 var
  exdpb:record
   cbsize: Word;
   dpb: TExDpb;
  end;
 asm
  mov	DosType,0
{Abfrage fr FAT12/FAT16}
  push	ds
   mov	dl,[Drive]
   mov	ah,32h
   int	21h		{0=OK, $FF=Fehler}
   mov	dx,ds
  pop	ds
  or	al,al
  jnz	@@test32
  mov	es,dx
  cmp	es:tDPB[bx].SecLen,200h	{Standardm„áige Sektorl„nge?}
  jnz	@@e		{mit 0=Fehler}
  mov	al,es:tDPB[bx].Drive
  mov	[DPB_Drive],al
  mov	ax,es:tDPB[bx].UsrSec
  mov	LongRec[DPB_UsrSec].lo,ax
  mov	LongRec[DPB_UsrSec].hi,0
  mov	ax,es:tDPB[bx].SecDir
  mov	LongRec[DPB_DirSec].lo,ax
  mov	LongRec[DPB_DirSec].hi,0
  mov	al,es:tDPB[bx].Shift
  mov	[DPB_Shift],al
  jmp	@@ok
{Abfrage fr FAT32}
@@test32:
  push	ss
  pop	es
  lea	di,[exdpb]
  mov	word ptr es:[di],3Dh	{61 Bytes}
  mov	cx,3Fh			{63 Bytes}
  mov	dl,[Drive]
  mov	si,0F1A6h
  mov	ax,7302h	{get extended DPB}
  int	21h
  mov	al,FALSE
  jc	@@e		{Fehler: kein FAT32}
  cmp	[exdpb.dpb.dpb.SecLen],200h
  jnz	@@e
  mov	al,[exdpb.dpb.dpb.Drive]
  mov	[DPB_Drive],al
  mov	ax,LongRec[exdpb.dpb.first_sector].lo
  mov	dx,LongRec[exdpb.dpb.first_sector].hi
  mov	LongRec[DPB_UsrSec].lo,ax
  mov	LongRec[DPB_UsrSec].hi,dx
  mov	ax,[exdpb.dpb.dpb.SecDir]	{gibt's eigentlich nicht!}
  mov	LongRec[DPB_DirSec].lo,ax
  mov	LongRec[DPB_DirSec].hi,0
  mov	al,[exdpb.dpb.dpb.Shift]
  mov	[DPB_Shift],al
  or	[DosType],FAT32 or BigDos	{FAT32 ist immer BigDos}
@@ok:
  mov	al,TRUE
@@e:
 end;

function SetLock: boolean; assembler;
 asm	mov	bh,0		{lock level}
	mov	bl,[DPB_Drive]
	inc	bx		{hier 1-basiert}
	mov	cx,084Ah
	mov	dx,1		{Schreiben erlauben}
	mov	ax,440Dh
	int	21h
 end;

procedure ReleaseLock; assembler;
 asm	mov	bl,[DPB_Drive]
	inc	bx		{hier 1-basiert}
	mov	cx,086Ah
	mov	ax,440Dh
	int	21h
 end;

function SetIt(const SR:TSearchRec; FDate:LongInt):Boolean;
{setzt Dateidatum in den Verzeichniseintrag des (undokumentierten Teils von)
 SearchRec}
 label finally;
 var
  XSR: TFill absolute SR;	{Undokumentierten Bereich benamsen}
  i: Integer;
{  D: array[0..fsDirectory] of Char;}
  DirEntry: pDirEntry;
  FCB: record
   drive: Byte;
   NameExt: array[0..10] of Char;
   unused: array[0..11] of Byte;
  end;
 begin
  SetLock;
  SetIt:=false;
  if DosType and FAT32 <>0 then begin
   RWRec.Sect:=DPB_UsrSec+(XSR.Clus32-2)shl DPB_Shift
     +XSR.DirNo div $10;
  end else begin
   if XSR.Clus=0 {Wurzelverzeichnis}
   then RWRec.Sect:=DPB_DirSec+XSR.DirNo div $10
   else RWRec.Sect:=DPB_UsrSec+LongInt(XSR.Clus-2)shl DPB_Shift
     +XSR.DirNo div $10;
  end;

  DosError:=ReadSec;	{den Sektor lesen}
  if DosError<>0 then goto finally;
  DirEntry:=PDirEntry(@Sektor);
  Inc(DirEntry,XSR.DirNo mod $10);
  {Nun zeigt DirEntry endlich auf das Stckel Directory!}

  {Gelesenes Clusterstck verifizieren}
  asm	push	ds
	 mov	ax,2900h
	 lds	si,[SR]
	 lea	si,TSearchRec[si].name	{ADD w„re hier viel besser}
	 push	ss
	 pop	es
	 lea	di,FCB
	 push	si
	  int	21h
	 pop	si
	 inc	di			{auf Dateinamen}
	 cmp	es:byte ptr[di],0E5h
	 jnz	@@1
	 mov	es:byte ptr[di],05h	{=regul„res E5-Zeichen oder LeadByte}
@@1:	 cld
	 db	0B0h			{mov al,XX}
@@l:	 stosb
	 lodsb
	 cmp	al,'.'			{"." oder ".." -> Nachhilfe fr DOS}
	 je	@@l
@@2:	pop	ds
  end;
  DosError:=35;		{"FCB nicht verfgbar"}
  for i:=0 to 10 do
    if FCB.NameExt[i]<>DirEntry^.NameExt[i] then goto finally;
  if SR.Attr<>DirEntry^.Attr then goto finally;
  if SR.Time<>DirEntry^.Time then goto finally;
  if SR.Size<>DirEntry^.Size then goto finally;

  {Uhrzeit patchen (Creation Time usw. auáer Acht lassend)}
  DirEntry^.Time:=FDate;
  {und rckschreiben}
  DosError:=WriteSec;	{denselben Sektor rckschreiben}
  if DosError<>0 then goto finally;
  SetIt:=true;
finally:
  ReleaseLock;
 end;

procedure Usage;
 begin
  WriteLn('Directory Touch (haftmann#software): Dateidatum setzen / aktualisieren');
  WriteLn('Verwendung: dirtouch <optionen> <dateien>');
  WriteLn('Optionen: /? /h (kurze und lange Hilfe)');
  WriteLn('/fquelldatei (Lieferant fr Datum und Uhrzeit)');
  WriteLn('/tMMDD[hhmm[[CC]YY][.ss]] /vhh[.]mm[.ss] /gDD[.]MM[.][[CC]YY] /jYY[-]MM[-]DD');
  WriteLn('  (verschiedene Formate der Zeitangabe, /d=/t, /g=deutsch, /j=japanisch;');
  WriteLn('  MM-Monat, DD-Tag, hh-Stunde, mm-Minute, CC-Jahrhundert, YY-Jahr, ss-Sekunde)');
  WriteLn('/i (zeigt Datum/Uhrzeit im Kommandozeilen-Parse-Vorgang an),');
  WriteLn('/u (wie UNIX Verzeichnis-Datum setzen)');
  WriteLn('Schalterzeichen: ''/'' oder ''-'', Trennzeichen: keins, ''='', '':'' oder Leerzeichen');
  WriteLn('KEINE FUNKTION BEI VERZEICHNISSEN AUF DOS-NETZLAUFWERKEN (01/03)');
  halt(0);
 end;

procedure UsageLong;
 begin
  WriteLn('Directory Touch (haftmann#software): Dateidatum setzen / aktualisieren');
  WriteLn(' Das Besondere daran ist das Besondere darin: das Setzen des Datums von');
  WriteLn(' Verzeichnissen erfolgt durch Sektorzugriff auf die Diskette / Festplatte;');
  WriteLn(' DOS bietet hierfr keine anderen M”glichkeiten. 01/03: mit LFN-Untersttzung');
  WriteLn;
  WriteLn('³ Arbeitsweise:');
  WriteLn('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
  WriteLn(' Das Programm holt sich anfangs die Uhrzeit des Rechners, die mit den');
  WriteLn(' Parametern /d, /t, /g, /j und /v modifiziert werden kann. Diese Zeit kann');
  WriteLn(' mit /i angezeigt werden; die Position in der Kommandozeile bestimmt das');
  WriteLn(' Ergebnis. Alternativ kann eine Datei (mit Option /f) als Quelle von Datum');
  WriteLn(' und Uhrzeit dienen.');
  WriteLn(' Die Kommandozeile wird von links nach rechts abgearbeitet, sodass');
  WriteLn(' >dirtouch autoexec.bat /f config.sys');
  WriteLn(' die AUTOEXEC.BAT auf das aktuelle Datum gesetzt wird und nicht auf dasselbe');
  WriteLn(' wie die CONFIG.SYS. Das Datum der CONFIG.SYS wird erst nach dem TOUCH der');
  WriteLn(' AUTOEXEC.BAT ausgelesen und dann verworfen.');
  WriteLn;
  WriteLn(' Auf diese Weise k”nnen mit einem DIRTOUCH-Aufruf verschiedene Dateien');
  WriteLn(' auf verschiedene Zeiten gesetzt werden, solange die Kommandozeile reicht.');
  WriteLn;
  WriteLn('³ Beispiele:');
  WriteLn('ÀÄÄÄÄÄÄÄÄÄÄÄ');
  WriteLn('>dirtouch .		- setzt das Verzeichnis . und den Eintrag im');
  WriteLn('	bergeordneten Verzeichnis auf aktuelles Datum.');
  WriteLn('	Zu den ..-Eintr„gen siehe unten.');
  WriteLn;
  WriteLn('>dirtouch /f quelle.txt henni	- kopiert die Uhrzeit von quelle.txt nach');
  WriteLn('	henni. Ist henni ein Verzeichnis, wird auch . im Vrz. henni gesetzt.');
  WriteLn;
  WriteLn('>dirtouch *.txt	- setzt alle Dateien mit Endung TXT auf das aktuelle Datum.');
  WriteLn('	Auch wenn DIRTOUCH eine Weile dazu braucht, bekommen alle Dateien');
  WriteLn('	das gleiche Datum. Sollte sich ein Verzeichnis mit dieser Endung');
  WriteLn('	darunter befinden, wird es ebenfalls geTOUCHt. Die Dateien DARIN werden');
  WriteLn('	nicht berhrt.');
  WriteLn;
  WriteLn('>dirtouch /v7.01 *.exe *.dll		- setzt das Datum von heute, aber als');
  WriteLn('	Uhrzeit die "Versionsnummer" 7.01, fr alle Dateien mit .EXE und .DLL');
  WriteLn;
  WriteLn('>dirtouch /f *.dll /v 7.01.22 /i *.dll		- setzt die DLLs auf das');
  WriteLn('	Datum der ersten gefundenen DLL, die Uhrzeiten jedoch mit');
  WriteLn('	"Versionsnummer" 7.01.22. Zur Kontrolle erfolgt die Ausgabe des zu');
  WriteLn('	setzenden Dateidatums.');
  WriteLn;
  WriteLn('³ Interessante Nebenanwendungen:');
  WriteLn('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
  WriteLn('>dirtouch /i			- zeigt aktuelles Datum und Uhrzeit an');
  WriteLn('>dirtouch /f=autoexec.bat /i	- zeigt Dateidatum mit Sekunden(!) an');
  WriteLn('>dirtouch /g01.01.2000 /i	- Das Programm ist Jahr-2000-sicher.');
  WriteLn('	(Wird das Jahrhundert weggelassen, wird stets das aktuelle verwendet.)');
  WriteLn;
  WriteLn('³ Der DOS- und der UNIX-Modus:');
  WriteLn('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
  WriteLn(' DOS und UNIX verwalten Verzeichnisse auf verschiedene Weise.');
  WriteLn(' Unter DOS haben der Verzeichnisname und die darin befindlichen');
  WriteLn(' symbolischen Namen . und .. das gleiche Erstellungsdatum.');
  WriteLn(' Dieses Verhalten wird standardm„áig von DIRTOUCH nachgebildet.');
  WriteLn;
  WriteLn(' Unter UNIX zeigen die Eintr„ge auf einen inode, der die Zeit speichert.');
  WriteLn(' Um dieses Verhalten auf Wunsch nachzubilden, modifiziert DIRTOUCH');
  WriteLn(' den Verzeichnisnamen, den symbolischen Namen . sowie alle .. in den');
  WriteLn(' darin untergeordneten Verzeichnissen.');
  WriteLn;
  WriteLn(' Der Schalter /u schaltet zwischen den beiden Modi hin und her.');
  WriteLn;
  WriteLn('³ Grenzen des Programms:');
  WriteLn('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
  WriteLn('- Im Gegensatz zu UNIX erzeugt dieses Programm niemals neue Dateien');
  WriteLn('- DIRTOUCH arbeitet ausschlieálich mit Lokalzeit; keine Weltzeitumrechnungen');
  WriteLn('- Keine Untersttzung fr die unter Windows95 verwendeten Zeiten "Erstellung"');
  WriteLn('  und "Letzter Zugriff" (bei Dateien).');
  WriteLn('- Untersttzung fr Verzeichnisse auf FAT unter DOS und alles unter Windows9x');
  WriteLn('- unter DOS ist DOSLFN notwendig fr Funktion bei fragmentierten Verzeichnissen');
  WriteLn('- DIRTOUCH arbeitet nicht rekursiv - hier behelfe man sich mit FOREACH.');
  WriteLn('- Das Setzen von Datum und Uhrzeit erfolgt stets komplett pro Datei.');
  WriteLn('  Ist das nicht erwnscht, ist eine FOR-Schleife aufzubauen:');
  WriteLn('	>for %i in (*.exe) do dirtouch /f %i /g 1.1. %i');
  WriteLn('  Von allen EXE-Dateien wird nur Tag und Monat auf 1.1. ver„ndert.');
  WriteLn('  In BATch-Dateien ist das % bekanntermaáen doppelt (%%) zu schreiben!');
  WriteLn;
  WriteLn('- Falls diese Hilfe hoffnungslos ber den Bildschirm hinweggerollt ist, m”ge');
  WriteLn('  man sich doch mal nach MORE oder besser LESS umsehen:');
  WriteLn('	>dirtouch /h | less');
  halt(0);
 end;

procedure ParseError;
 begin
  WriteLn('Parameterfehler');
  halt(255);
 end;

function Nimm2Ziffern(var SP:PChar):Word;
{Bei Fehler sofort Sprung zur Notbremse}
 begin
  if (SP[0]<'0') or (SP[0]>'9') then ParseError;
  if (SP[1]<'0') or (SP[1]>'9') then begin
   Nimm2Ziffern:=Word(SP[0])-48;	{nur eine Ziffer nehmen}
   Inc(SP);
  end else begin
   Nimm2Ziffern:=Word(SP[0])*10-480+Word(SP[1])-48;
   Inc(SP,2);
  end;
 end;

function GetDateTime:LongInt;
{Holt die aktuelle Rechner-Zeit}
 var
  S100,DOW: Word;
  DT:   TDateTime;
  T:    LongInt;
 begin
  with DT do begin
   GetTime(Hour,Min,Sec,S100);
   GetDate(Year,Month,Day,DOW);
   PackTime(DT,T);
   GetDateTime:=T;
  end;
 end;

function ValidDate(const DT:TDateTime):Boolean;
 begin
  with DT do
   ValidDate:=(Sec<60) and (Min<60) and (Hour<24) and
	      (Day>0) and (Day<32) and (Month>0) and (Month<13);
   {ohne Februar und Schaltjahr}
 end;

function ReadTime(SP:PChar;var FDate:LongInt):word;
{liest Datums- und Zeitangabe vom String ein}
 var
  DT: TDateTime;
  Century: Word;
 begin
  UnpackTime(FDate,DT);
  Century:=DT.Year div 100;
  DT.Year:=DT.Year mod 100;	{Jahr auseinandernehmen}
  repeat
   DT.Month:=Nimm2Ziffern(SP);
   DT.Day:=Nimm2Ziffern(SP);
   if SP^=#0 then break;	{Ende mit Datum}
   DT.Hour:=Nimm2Ziffern(SP);
   DT.Min:=Nimm2Ziffern(SP);
   if SP^=#0 then break;	{Ende mit Minuten}
   if SP^<>'.' then begin	{weiter mit Jahr}
    DT.Year:=Nimm2Ziffern(SP);
    if SP^=#0 then break;	{Ende mit Jahrzehnt}
    if SP^<>'.' then begin	{weiter mit Jahr}
     Century:=DT.Year;
     DT.Year:=Nimm2Ziffern(SP);
    end;
   end;
   if SP^='.' then begin
    Inc(SP);			{Punkt bergehen}
    DT.Sec:=Nimm2Ziffern(SP);
   end;
   if SP^<>#0 then ParseError;	{Kette MUSS hier zu Ende sein!}
  until true;			{Nur fr die BREAKs}
  DT.Year:=DT.Year+100*Century;	{das Jahr wieder zusammensetzen}
  if not ValidDate(DT) then begin
   WriteLn('Fehler in der Zeitangabe (Tag/Monat vertauscht?)');
   halt(255);
  end;
  PackTime(DT,FDate)
 end;

function ReadDateG(SP:PChar;var FDate:LongInt):word;
{liest deutsche Datumsangabe DD[.]MM[.][[CC]YY]}
 var
  DT: TDateTime;
  Century: Word;
 begin
  UnpackTime(FDate,DT);
  Century:=DT.Year div 100;
  DT.Year:=DT.Year mod 100;	{Jahr auseinandernehmen}
  DT.Day:=Nimm2Ziffern(SP);
  if SP^='.' then Inc(SP);
  DT.Month:=Nimm2Ziffern(SP);
  if SP^='.' then Inc(SP);
  if SP^<>#0 then begin
   DT.Year:=Nimm2Ziffern(SP);
   if SP^<>#0 then begin;
    Century:=DT.Year;		{als Jahrhundert nehmen}
    DT.Year:=Nimm2Ziffern(SP);
   end;
  end;
  if SP^<>#0 then ParseError;	{Kette MUSS hier zu Ende sein!}
  DT.Year:=DT.Year+100*Century;	{das Jahr wieder zusammensetzen}
  if not ValidDate(DT) then begin
   WriteLn('Fehler in der Zeitangabe');
   halt(255);
  end;
  PackTime(DT,FDate)
 end;

function ReadDateJ(SP:PChar;var FDate:LongInt):word;
{liest japanische Datumsangabe YY[-]MM[-]DD, hier: keine Jahrhundert-Angabe}
 var
  DT: TDateTime;
 begin
  UnpackTime(FDate,DT);
  DT.Year:=(DT.Year div 100)*100+Nimm2Ziffern(SP);
  if SP^='-' then Inc(SP);
  DT.Month:=Nimm2Ziffern(SP);
  if SP^='-' then Inc(SP);
  DT.Day:=Nimm2Ziffern(SP);
  if SP^<>#0 then ParseError;	{Kette MUSS hier zu Ende sein!}
  if not ValidDate(DT) then begin
   WriteLn('Fehler in der Zeitangabe');
   halt(255);
  end;
  PackTime(DT,FDate)
 end;

function ReadVer(SP:PChar;var FDate:LongInt):word;
{liest Zeitangabe wie Versionsnummer und modifiziert nur die Zeit}
 var
  DT: TDateTime;
 begin
  UnpackTime(FDate,DT);
  DT.Hour:=Nimm2Ziffern(SP);
  if SP^='.' then Inc(SP);	{Versions-Punkt bergehen}
  DT.Min:=Nimm2Ziffern(SP);
  if SP^='.' then begin		{Sekunden folgen? (Revisions-Nummer)}
   Inc(SP);
   DT.Sec:=Nimm2Ziffern(SP);	{auch noch Sekunden setzen}
  end;
  if SP^<>#0 then ParseError;	{Kette MUSS hier zu Ende sein!}
  PackTime(DT,FDate)
 end;

function IsWild(S:PChar):Boolean;
 begin
  IsWild:=(StrScan(S,'?')<>nil) or (StrScan(S,'*')<>nil);
 end;

function SetFileTime(FName:PChar; FDate:LongInt):Boolean;
{wie SetIt(), jedoch "gesittet" mittels dokumentierter Funktionen}
 var
  f: File;
 begin
  Assign(f,FName); Reset(f);
  SetFTime(f,FDate);
  Close(f);
  SetFileTime:=(IOResult=0) and (DosError=0);
 end;

type
 TS2=String[2];

function StrZero(W:Word):TS2;
 var S: TS2;
 begin
  Str(W:2,S);
  if S[1]=' ' then S[1]:='0';
  StrZero:=S;
 end;

procedure ShowFDate(FDate:LongInt);
 var
  DT: TDateTime;
 begin
  UnpackTime(FDate,DT);
  WriteLn('Datum=',DT.Day,'.',DT.Month,'.',DT.Year,
    ', Uhrzeit=',StrZero(DT.Hour),':',StrZero(DT.Min),':',StrZero(DT.Sec));
 end;

procedure TransferFindData(const sr:TSearchRec; var fd:TWin32FindData);
 begin
  FillChar(fd,sizeof(fd),0);
  fd.attr:=sr.attr;
  fd.timem.lo:=sr.time;
  fd.sizel:=sr.size;
  StrCopy(fd.name,sr.name);
  Move(sr.fill,fd.name[13],sizeof(sr.fill));	{verstecke Info!}
 end;

function MyFindFirst(s:PChar; var fd:TWin32FindData):Word;
 var
  sr:TSearchRec;
 begin
  MyFindFirst:=FindFirstFile(s,faAnyFile,fd);
  if DosError=$7100 then begin
   FindFirst(s,faAnyFile,sr);
   if DosError=0 then begin
    TransferFindData(sr,fd);
    MyFindFirst:=1;
   end;
  end;
 end;

function MyFindNext(fh:Word; var fd:TWin32FindData):Boolean;
 var
  sr:TSearchRec;
 begin
  MyFindNext:=FindNextFile(fh,fd);
  if DosError=$7100 then begin
   Move(fd.name[13],sr.fill,sizeof(sr.fill));
   FindNext(sr);
   if DosError=0 then begin
    TransferFindData(sr,fd);
    MyFindNext:=true;
   end;
  end;
 end;

procedure GetClosedFTime(S: PChar; var FDate:LongInt);
{liest Zeitangabe einer anderen Datei}
 var
  fh: Word;
  SR: TWin32FindData;
 begin
  fh:=MyFindFirst(S,SR);
  if fh<>0 then begin
   FDate:=SR.timem.lo;
   if IsWild(S) then WriteLn('Datumsquelle=',SR.Name);
   FindClose(fh);
  end else begin
   WriteLn('Fehler ',DosError,': Konnte Datei ',S,' nicht finden!?');
   halt(255);
  end;
 end;

procedure PathCat(s,s2:PChar);
 begin
  if (s2=nil) or (s2^=#0) then exit;
  StrCat(s,'\');
  StrCat(s,s2);
 end;

function SFN_FindFirst(s1,s2,s3:PChar; var SR:TSearchRec):Boolean;
 var
  s: TLfnBuf;
 begin
  StrCopy(s,s1);
  PathCat(s,s2);			{1. sicher zusammensetzen}
  PathCat(s,s3);
  TranslateName(s,s,TN_Shortname);	{2. kurzen Dateinamen ermitteln}
  FindFirst(s,faAnyFile,SR);		{3. Suche starten}
  SFN_FindFirst:=DosError=0;
 end;

function LFN_SetFileTime(s:PChar; FDate:LongInt):Boolean;
 var
  Check:LongInt;
 begin
  LFN_SetFileTime:=FileAttributes(s,FA_SetTimeM,@FDate,nil)
	       and FileAttributes(s,FA_GetTimeM,@Check,nil)
	       and (Check=FDate);
 end;

var
 DbcsLeadByteTable:Pointer;

procedure PrepareDBCS; assembler;
 type
  PtrRec=record
   ofs,sel:Word;
  end;
 var
  info: array[0..4] of Char;
 asm
	mov	ax,6507h
	mov	bx,0FFFFh
	mov	cx,5
	mov	dx,bx
	push	ss
	pop	es
	mov	di,sp
	int	21h
	les	di,es:[di+1]
	scasw
	mov	PtrRec[DbcsLeadByteTable].ofs,di
	mov	PtrRec[DbcsLeadByteTable].sel,es
 end;

function IsDbcsLeadByte(c:Char):Boolean; assembler;
 asm	push	ds
	push	si
	 lds	si,[DbcsLeadByteTable]
 @@l:	 lodsw
	 cmp	ax,1
	 jc	@@e
	 cmp	[c],al
	 jc	@@e
	 cmp	ah,[c]
	 jc	@@l
@@e:	pop	si
	pop	ds
	db	0D6h
	inc	al
 end;

function GetFileNamePtr(s:PChar):PChar; assembler;
 asm	les	si,[s]
	cld
@@ME:	mov	bx,si
@@l:	seges	lodsb
	cmp	al,':'
	je	@@ME
	cmp	al,'\'
	je	@@ME
	cmp	al,'/'
	je	@@ME
	or	al,al
	jz	@@e
	push	ax
	call	IsDbcsLeadByte
	jc	@@l
	inc	si		{Trail-Byte bergehen}
	jmp	@@l
@@e:	mov	dx,es
	xchg	bx,ax
 end;


type
 TCheckState=(not_tested,not_ok,okay);
var
 DrvParamsCheck: TCheckState;
function CheckDrvParams(drive:Byte):Boolean;
{Holt sich neue Laufwerksparameter, falls DrvParamsCheck=not_tested.
 Falls beim (ersten) Test FALSE herauskommt, gibt es eine Fehlermeldung}
 var
  LW: Char;
 begin
  if DrvParamsCheck=not_tested then begin
   if drive>$82 then drive:=drive-$80;
   if GetDrvParams(drive)
    then DrvParamsCheck:=okay
    else begin
     DrvParamsCheck:=not_ok;
     LW:=Char(drive+ord('@'));
     if (LW<'A') or (LW>'Z') then LW:='?';
     WriteLn('Fehler bei Bestimmung der Parameter fr Laufwerk ',LW,': !');
     DosError:=50;	{RalfBrown: Network request not supported}
    end;
   end;
  CheckDrvParams:=DrvParamsCheck=okay;
 end;

label l1;
const
 UNIXlike: Boolean=false;	{UNIX-like . und .. behandeln?}
var
 CmdLine: PChar;
 AnyArg: Boolean;	{=FALSE}
 OK:	Boolean;
{ i:	Integer;
{ Par:	Array[0..127] of Char;	{'was Nullterminiertes zur Abwechslung}
 ParP:	PChar;			{der Parameter, nicht nullterminiert}
 ParN:	TLfnBuf;		{wirklicher Verzeichnis-/Dateiname}
 OptC:	Char;			{Schalter-Zeichen}
 AnyFile:Boolean;
 fh: Word;
 SR: TWin32FindData;
 SR0,SR1,SR2:	TSearchRec;	{fr Verzeichnis, .- und ..-Referenzen}
 FDate:		LongInt;	{das Datum, das gesetzt wird}

begin
 FileMode:=0;
 PrepareDBCS;
 CmdLine:=Ptr(PrefixSeg,$80);
 CmdLine[Ord(CmdLine[0])+1]:=#0;	{ordentlich terminieren}
 Inc(CmdLine);				{L„ngenbyte bergehen}

 FDate:=GetDateTime;
 repeat
  ParP:=NextItem(CmdLine,Word('"'),DELIM_WhiteSpace);
{  GetArgStr(Par,i,sizeof(Par));}
{  ParN:=ParamStr(i);
  StrPCopy(Par,ParN);	{nullterminiert ist besser handhabbar fr Optionen}
  case ParP^ of
   #0: begin
    if not AnyArg then Usage;
    break;
   end;
   '/','-': begin		{Option}
    Inc(ParP);
    OptC:=Upcase(ParP^);
    if OptC=#0 then begin
     ParP:=NextItem(CmdLine,Word('"'),DELIM_WhiteSpace);
     goto l1; {n„chstes: Dateiname}
    end;
    case OptC of		{parameterlose Optionen}
     '?': Usage;
     'H': UsageLong;
     'I': ShowFDate(FDate);
     'U': UNIXlike:=not UNIXlike;	{Ein- und Auschalten m”glich!}
     else begin
      Inc(ParP);
      case ParP^ of
       ':','=': Inc(ParP);
       #0: ParP:=NextItem(CmdLine,Word('"'),DELIM_WhiteSpace);
      end;
      case OptC of		{Optionen mit Parametern}
       'T','D': ReadTime(ParP,FDate);
       'G': ReadDateG(ParP,FDate);
       'J': ReadDateJ(ParP,FDate);
       'F': GetClosedFTime(ParP,FDate);
       'V': ReadVer(ParP,FDate);
      else ParseError;
      end{case};
     end;
    end{case};
   end;
   else begin			{Dateiname}
    AnyArg:=true;
    DrvParamsCheck:=not_tested;
    AnyFile:=false;
l1: fh:=MyFindFirst(ParP,SR);
    if fh<>0 then begin	{mindestens 1 Match}
     repeat		{Nicht die Kommandozeile zerst”ren!}
      if (StrComp(SR.name,'.')<>0)	{falls der User mit "*" arbeitet}
      and(StrComp(SR.name,'..')<>0) then begin
       AnyFile:=true;
       StrCopy(ParN,ParP); StrCopy(GetFileNamePtr(ParN),SR.name);
{Bei Verzeichnissen Direktzugriff verwenden (oder Fehlermeldung)}
       if (SR.Attr and faDirectory <>0) then begin
{Beim ersten auftauchenden Verzeichnis Laufwerksparameter beschaffen}
	if LFN_SetFileTime(ParN,FDate)
	or SFN_FindFirst(ParN,nil,nil,SR0)
	and CheckDrvParams(PFill(@SR0)^.Drive) and SetIt(SR0,FDate)
	then begin
	 Write('Verzeichnis "',SR.Name,'" okay');
	 OK:=true;
{Bei Verzeichnissen sollte "." im untergeordneten Vrz. mit gesetzt werden}
	 SFN_FindFirst(ParN,'*.*',nil,SR1);	{. und .. angleichen}
	 CheckDrvParams(PFill(@SR1)^.Drive);
{Anders geht es mit DOS 6.x nicht;
 die direkte Angabe von "." bzw. ".." fhrt nicht zum Ziel}
	 while DosError=0 do begin
	  if SR1.Attr and faDirectory <>0 then begin
	   if StrComp(SR1.Name,'.')=0 then begin
	    if not SetIt(SR1,FDate) then OK:=false; {. angleichen}
	   end else if StrComp(SR1.Name,'..')=0 then begin
	    if not UNIXlike then begin
	     if not SetIt(SR1,FDate) then OK:=false; {wie DOS: .=..}
	     break;	{raus (in DOS kommt .. immer nach .) - Zeit sparen}
	    end;
	   end else if UNIXlike then begin	{alle .. darunter angleichen}
	    SFN_FindFirst(ParN,SR1.Name,'*.*',SR2);
	    while DosError=0 do begin
	     if (SR2.Attr and faDirectory <>0)
	     and (StrComp(SR2.Name,'..')=0) then begin
	      if not SetIt(SR2,FDate) then OK:=false;	{.. angleichen}
	      break;				{das war's mit diesem Vrz.}
	     end;
	     FindNext(SR2);
	    end{while};
	   end{else};
	  end{if};
	  FindNext(SR1);
	 end{while};
	 if not OK then Write(', aber nicht "." und ".." darunter');
	 WriteLn('.');
	end else WriteLn('Fehler ',DosError,' bei Verzeichnis "',SR.Name,'"!');
       end else begin
{normale Dateien werden ber die DOS-Funktion geTOUCHt; falls das nicht
 gelingt (Schreibschutz u.„.), dann per Direktzugriff}
	if LFN_SetFileTime(ParN,FDate)
	or SetFileTime(ParN,FDate)
	or SFN_FindFirst(ParN,nil,nil,SR0)
	and CheckDrvParams(PFill(@SR0)^.Drive) and SetIt(SR0,FDate)
	then WriteLn('Datei "', SR.Name,'" okay.')
	else WriteLn('Fehler ',DosError,' bei Datei "',SR.Name,'"!');
       end;
      end;
      MyFindNext(fh,SR);
     until DosError<>0;
     FindClose(fh);
    end;
    if not AnyFile
    then WriteLn('Fehler ',DosError,': Konnte "',ParP,'" nicht finden!');
   end{case-else};
  end{case};
 until false;
end.
Detected encoding: UTF-80