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 führte 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 Hinzufügung der ausführlichen 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 {gültig 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 {gültig 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 für 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 {für 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 für Sektoren pro Cluster}
DosType: Byte; {Schalter für 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 für <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 für 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 für 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 Stückel Directory!}
{Gelesenes Clusterstück 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 für DOS}
je @@l
@@2: pop ds
end;
DosError:=35; {"FCB nicht verfügbar"}
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 rückschreiben}
DosError:=WriteSec; {denselben Sektor rückschreiben}
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 für 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 hierfür keine anderen Möglichkeiten. 01/03: mit LFN-Unterstützung');
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 berührt.');
WriteLn;
WriteLn('>dirtouch /v7.01 *.exe *.dll - setzt das Datum von heute, aber als');
WriteLn(' Uhrzeit die "Versionsnummer" 7.01, für 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 Unterstützung für die unter Windows95 verwendeten Zeiten "Erstellung"');
WriteLn(' und "Letzter Zugriff" (bei Dateien).');
WriteLn('- Unterstützung für Verzeichnisse auf FAT unter DOS und alles unter Windows9x');
WriteLn('- unter DOS ist DOSLFN notwendig für 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 erwünscht, 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 für 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 für 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; {für 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 für 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. ".." führt 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: OEM (CP437) | 1
|
|
|