[Back to DIRS SWAG index]  [Back to Main SWAG index]  [Original]

{$M 65520,0,655360}

Uses DOS;

Type
 String12 = string[12];

Const
 FAttr : word = $23; { readonly-, hidden-, archive attributen }

Var
 CurDir : PathStr;
 StartDir: DirStr;
 FMask  : String12;
 subdirs : boolean;


Function UpStr(const s:string):string; assembler;
{ by Brain Pape, found in the SWAG collection }
asm
 push ds
 lds si,s
 les di,@result
 lodsb{ load and store length of string }
 stosb
 xor ch,ch
 mov cl,al
 @upperLoop:
 lodsb
 cmp al,'a'
 jb  @cont
 cmp al,'z'
 ja  @cont
 sub al,' '
 @cont:
 stosb
 loop @UpperLoop
 pop ds
end; { UpStr }


Procedure ParseCmdLine;
var
 t : byte;
 cmd: string;
begin
 for t := 2 to ParamCount do begin
cmd := UpStr(Copy(ParamStr(t),1,2));
if cmd = '/S' then subdirs := true;
 end;
end;


Function NoTrailingBackslash (path : String) : String;
begin
 if (length(path) > 3) and (path[length(path)] = '\') then
  path[0] := chr(length(path) - 1);
 NoTrailingBackslash := path;
end;


Procedure PathAnalyze (P: PathStr; Var D: DirStr; Var Name: String12);
Var
 N: NameStr;
 E: ExtStr;

begin
 FSplit(P, D, N, E);
 Name := N + E;
end;


Procedure Process (var SR: SearchRec);
{ here you can put anything you want to do in each directory with each file }
begin
 writeln(FExpand(SR.Name));
end;


Procedure FindFiles;
var
 FR : SearchRec;

begin
 FindFirst(FMask, FAttr, FR);
 while DosError = 0 do
 begin
Process(FR);
FindNext(FR);
 end;
end;


{$S+}
Procedure AllDirs;
{ recursively roam through subdirectories }
var
 DR : SearchRec;

begin
 FindFirst('*.*', Directory, DR);
 while DosError = 0 do begin
if DR.Attr and Directory = Directory then begin
 if ((DR.Name <> '.') and (DR.Name <> '..')) then begin
ChDir(DR.Name);
AllDirs;  { Recursion!!! }
ChDir('..');
 end
end;
FindNext(DR);
 end;
 FindFiles;
end;
{$S-}


begin

 subdirs := false;
 GetDir (0, CurDir);
 if ParamCount > 1 then ParseCmdLine;

 PathAnalyze (FExpand(ParamStr(1)), StartDir, FMask);
 if Length (StartDir) > 0 then ChDir (NoTrailingBackslash(StartDir));
 if IOResult <> 0 then
 begin
Writeln('Cannot find directory.');
Halt(1);
 end;
 if Length (FMask) = 0 then FMask := '*.*';
 if subdirs then AllDirs else FindFiles;
 ChDir (CurDir);
end.

[Back to DIRS SWAG index]  [Back to Main SWAG index]  [Original]