DP Tool Club 15/CD_ASCQ_15_070894.iso/maj/swag/dirs.swg

Text File | 1994-05-27 | 119KB | 2 lines

SWAGOLX.EXE (c) 1993 GDSOFT  ALL RIGHTS RESERVED 00031         DIRECTORY HANDLING ROUTINES                                       1      05-28-9313:37ALL                      SWAG SUPPORT TEAM        ForEachFile Procedure    IMPORT              35     ª╢ä {π Can any one tell me a way to make pascal (TP 6.0) search aπ complete drive, including all subdirectories, even onesπ that are not in the path, looking For a specific Fileπ extension?  I.E., having the Program search For *.DOC andπ saving that to a Text File?ππ Here's part of a package I'm putting together.  You'd use it like this:ππ}ππ{File Test.Pas}ππUsesπ  Dos, Foreach;ππProcedure PrintAllDocs;ππ  Procedure PrintFile(Var Dir: DirStr; Var S : SearchRec); Far;π  beginπ    Writeln('Found File ',Dir,S.Name);π  end;ππbeginπ  ForEachFile('c:\*.doc',  { Give the mask where you want to start looking }π              0, 0,        { Specify File attributes here; you'll just getπ                             normal Files With 0 }π              True,        { Search recursively }π              @PrintFile); { Routine to call For each File }πend;ππbeginπ  PrintAllDocs;πend.πππ{Unit ForEach}ππUnit ForEach;ππ{ Unit With a few different "foreach" Functions. }π{ This extract contains only ForEachFile. }ππInterfaceππUsesπ  Dos;ππTypeπ  FileStr = String[12];π  TFileAction = Procedure(Var Dir : DirStr;π                          Var S : SearchRec; ConText : Word);ππProcedure ForEachFile(Mask : PathStr; { File wildcard mask, including path }π                      Attr : Byte; { File attributes }π                      Match : Byte; { File attributes whichπ                                             must match attr exactly }π                      Subdirs : Boolean; { Whether to search recursively }π                      Action : Pointer);π{ Calls the Far local Procedure Action^ For each File found.π  Action^ should be a local Procedure With declarationπ    Procedure Action(Var Path : String; Var S : SearchRec); Far;π  or, if not a local Procedure,π    Procedure Action(Var Path : String; Var S : SearchRec; Dummy : Word); Far;π  Each time Action is called S will be filled in For a File matchingπ  the search criterion.π}ππImplementationππFunction CallerFrame : Word;π{ Returns the BP value of the caller's stack frame; used For passingπ  local Procedures and Functions around. Taken from Borland's Outlineπ  Unit. }π  Inline(π    $8B/$46/$00                   { MOV   AX,[BP] }π    );πππ  { ******** File routines ********* }ππProcedure ForEachFile(Mask    : PathStr; { File wildcard mask }π                      Attr    : Byte;    { File attributes }π                      Match   : Byte;    { Attributes which must match }π                      Subdirs : Boolean; { Whether to search recursively }π                      Action  : Pointer);{ Action; should point toπ                                           a TFileAction local Far Procedure }πVarπ  CurrentDir : DirStr;π  Doit       : TFileAction Absolute Action;π  Frame      : Word;ππ  Procedure DoDir;π  { Tests all Files in current directory.  Assumes currentdir has trailingπ    backslash }π  Varπ    S : SearchRec;π  beginπ    FindFirst(CurrentDir + Mask, Attr, S);π    While DosError = 0 doπ    beginπ      if (S.Attr and Match) = (Attr and Match) thenπ        Doit(CurrentDir, S, Frame);π      FindNext(S);π    end;π  end;ππ  Function RealDir(Name : FileStr) : Boolean;π  beginπ    RealDir := (Name <> '.') and (Name <> '..');π  end;ππ  Procedure AddBackslash;π  beginπ    CurrentDir := CurrentDir + '\';π  end;ππ  Procedure DoAllDirs;π  Varπ    S         : SearchRec;π    OldLength : Byte;ππ    Procedure AddSuffix(Suffix : FileStr); { Separate proc to save stack space }π    beginπ      CurrentDir := Copy(CurrentDir, 1, OldLength) + Suffix;π    end;ππ  beginπ    OldLength := Length(CurrentDir);π    DoDir;π    AddSuffix('*.*');π    FindFirst(CurrentDir, Directory, S);π    While DosError = 0 doπ    beginπ      if S.Attr = Directory thenπ      beginπ        if RealDir(S.Name) thenπ        beginπ          AddSuffix(S.Name);π          AddBackslash;π          DoAllDirs;            { do directory recursively }π        end;π      end;π      FindNext(S);π    end;π  end;ππVarπ  Name : NameStr;π  Ext  : ExtStr;ππbegin                           { ForEachFile }π  FSplit(Mask, CurrentDir, Name, Ext);π  Mask := Name+Ext;π  Frame := CallerFrame;π  if CurrentDir[Length(CurrentDir)] <> '\' thenπ    AddBackslash;π  if Subdirs thenπ    DoAllDirsπ  elseπ    DoDir;πend;ππend.π                                                                                                             2      05-28-9313:37ALL                      SWAG SUPPORT TEAM        Search ALL Dirs & Subs   IMPORT              7      ª╢1~ Uses Crt, Dos, WinDos;πProcedure SearchSubDirs(Dir:PathStr;Target:SearchRec);πVarπ  FoundDir: TSearchRec;π  FileSpec: PathStr;π  Path : DirStr;π  DummyName: NameStr;π  DummyExt : ExtStr;πbeginπ If KeyPressed then Repeat Until KeyPressed;π FileSpec:= Dir + '*.';π FindFirst('*.*', AnyFile, FoundDir);π While (DosError = 0) doπ   beginπ     With FoundDir doπ       beginπ         If Name[1] <> '.' thenπ           if Directory and Attr <> 0 thenπ             beginπ               FSplit(FileSpec,Path,DummyName,DummyExt);π               FindFirst(Path + Name + '\' ,Target);π             end;π       end; {with FoundDir}π     if KeyPressed then Pause;π     FindNext(FoundDir);π   end; {read loop}π   If DosError <> 18 then DosErrorExit;πend;π                            3      05-28-9313:37ALL                      SWAG SUPPORT TEAM        Search All Dirs & Subs #2IMPORT              24     ª╢┐▀ AH>>Hi everyone.  I have a small problem.  How does one go about accessingπ  >>EVERY File in every directory, sub-directory on a drive? I guess this isπ  >>part of the last question, but how do you access every sub-directory?ππUnit FindFile;π{$R-}πInterfaceππUses Dos;ππTypeπ  FileProc = Procedure ( x : PathStr );ππProcedure FindFiles (DirPath : PathStr;      (* initial path           *)π                     Mask : String;          (* mask to look For       *)π                     Recurse : Boolean;      (* recurse into sub-dirs? *)π                     FileDoer : FileProc);   (* what to do With found  *)ππ(* Starting at <DirPath>, FindFiles will pass the path of all the Filesπ   it finds that match <Mask> to the <FileDoer> Procedure.  if <Recurse>π   is True, all such Files in subdirectories beneath <DirPath> will beπ   visited as well.  if <Recurse> is False, the names of subdirectoriesπ   in <DirPath> will be passed as well. *)ππImplementationππProcedure FindFiles (DirPath : PathStr;      (* initial path           *)π                     Mask : String;          (* mask to look For       *)π                     Recurse : Boolean;      (* recurse into sub-dirs? *)π                     FileDoer : FileProc);   (* what to do With found  *)ππ  Procedure SubVisit ( DirPath : PathStr );π  Varπ    Looking4 : SearchRec;ππ  beginπ    FindFirst ( Concat ( DirPath, Mask ), AnyFile, looking4);π    While ( DosError = 0 ) Do beginπ      if ( looking4.attr and ( VolumeID + Directory ) ) = 0π       then FileDoer ( Concat ( DirPath, looking4.name ) );π      FindNext ( Looking4 );π      end;   (* While *)π    if Recurseπ     then beginπ      FindFirst ( Concat ( DirPath, '*.*' ), AnyFile, looking4);π      While ( DosError = 0 ) and ( looking4.name [1] = '.' ) Doπ        FindNext (looking4);   (* skip . and .. directories *)π      While ( DosError = 0 ) Do beginπ        if ( ( looking4.attr and Directory ) = Directory )π         then SubVisit ( Concat ( DirPath, looking4.name, '\' ) );π        FindNext ( Looking4 );π        end;   (* While *)π      end;   (* if recursing *)π  end;   (* SubVisit *)πππbegin   (* FindFiles *)π  SubVisit ( DirPath );πend;   (* FindFiles *)ππend.ππ   --------------------------------------------------------------------ππProgram Visit;ππUses Dos, FindFile;ππ{$F+}πProcedure FoundOne ( Path : PathStr );  (* MUST be Compiled With $F+ *)π{$F-}πbeginπ  WriteLn ( Path );πend;ππbeginπ  WriteLn ( '-------------------------------------------------------------');π  FindFiles ( '\', '*.*', True, FoundOne );π  WriteLn ( '-------------------------------------------------------------');πend.ππ   -----------------------------------------------------------------------ππFoundOne will be passed every File & subdirectory.  if you just want theπsubdirectories, ignore any name that doesn't end in a '\' Character!π                                                                                            4      05-28-9313:37ALL                      SWAG SUPPORT TEAM        Directory With FileSpec  IMPORT              19     ª╢D┐ {π>Is there any easy way do turn *.* wildcards into a bunch of Filenames?π>This may be confusing, so here's what I want to do:π>I know C, basic, pascal, and batch.  (but not too well)π>I want to make a Program to read Files from c:\ece\ and, according to myπ>Filespecs ( *.* *.dwg plot???.plt hw1-1.c) I want the Program to takeπ>each File individually, and Compress it and put it on b:.  I also wantπ>the Program to work in reverse.  I.E.:  unpack Filespecs from b: andπ>into c:.  I want this because I take so many disks to school, and Iπ>don't like packing and unpacking each File individually.  I also don'tπ>want one big archive.  Any suggestions as to how to do it, or what Iπ>could do is appreciated.ππThe easiest way would be to use the findfirst() and findnext()πProcedures. Here's a stub Program in TP. You'll need to put code inπthe main routine to handle command line arguments, and call fsplit()πto split up the Filenames to pass to searchDir() or searchAllDirs().πthen just put whatever processing you want to do With each File inπthe process() Procedure.π}ππUsesπ  Dos, Crt;ππVarπ  Path      : PathStr;π  Dir       : DirStr;π  Name      : NameStr;π  Ext       : ExtStr;π  FullName  : PathStr;π  F         : SearchRec;π  Ch        : Char;π  I         : Integer;ππProcedure Process(dir : DirStr; s : SearchRec);πbeginπ  Writeln(dir, s.name);πend;πππ{π Both searchDir and searchAllDirs require the following parametersπ path  - the path to the File, which must end With a backslash.π         if there is no ending backslash these won't work.π fspec - the File specification.π}ππProcedure SearchDir(Path : PathStr; fspec : String);πVarπ  f : SearchRec;πbeginπ  Findfirst(Path + fspec, AnyFile, f);π  While DosError = 0 doπ  beginπ    Process(path, f);π    Findnext(f);π  end;πend;ππProcedure searchAllDirs(path : pathStr; fspec : String);πVarπ  d : SearchRec;πbeginπ  SearchDir(Path, fspec);π  FindFirst(Path + '*.*', Directory, d);π  While DosError = 0 doπ  beginπ    if (d.Attr and Directory = Directory) and (d.name[1] <> '.') thenπ    beginπ      SearchAllDirs(Path + d.name + '\', fspec);π    end;π    Findnext(d);π  end;πend;ππbeginπ  SearchAllDirs( '\', '*.*' );πend.π                                                                                                                      5      05-28-9313:37ALL                      SWAG SUPPORT TEAM        Searching a Complete Drv IMPORT              11     ª╢ƒ {π> Can any one tell me a way to make pascal (TP 6.0) search a Completeπ> drive, including all subdirectories, even ones that are not in theπ> path, looking For a specific File extension?  I.E., having the Programπ> search For *.doC and saving that to a Text File?ππOk, here goes nothing.π}ππ{$M 65000 0 655360}π{Assign enough stack space For recursion}ππProgram FindAllFiles;ππUses Dos;ππVarπ  FileName : Text;ππProcedure ScanDir(path : PathStr);ππVarπ  SearchFile : SearchRec;πbeginπ  if Path[Length(Path)] <> '\' thenπ    Path := Path + '\';π  FindFirst(Path + '*.*', $37, SearchFile); { Find Files and Directories }π  While DosError = 0 do { While There are more Files }π  beginπ    if ((SearchFile.Attr and $10) = $10) and (SearchFile.Name[1] <> '.') thenπ      ScanDir(Path + SearchFile.Name)π      { Found a directory Make sure it's not . or .. Scan this dir also }π    elseπ    if Pos('.doC',SearchFile.Name)>0 thenπ      Writeln(FileName, Path + SearchFile.Name);π      { if the .doC appears in the File name, Write path to File. }π    FindNext(SearchFile);π  end;πend;ππbeginπ  Assign(FileName,'doCS'); { File to contain list of .doCs }π  ReWrite(FileName);π  ScanDir('C:\'); { Drive to scan. }π  Close(FileName);πend.π                                                   6      05-28-9313:37ALL                      SWAG SUPPORT TEAM        Delete Tree              IMPORT              8      ª╢e% Procedure ClrDir ( path : pathStr );ππVar FileInfo : searchRec;π    f        : File;π    path2    : pathStr;π    s        : String;ππbegin FindFirst ( path + '\*.*', AnyFile, FileInfo );π      While DosError = 0 Doπ      begin if (FileInfo.Name[1] <> '.') and (FileInfo.attr <> VolumeId) thenπ              if ( (FileInfo.Attr and Directory) = Directory ) thenπ                begin Path2 := Path + '\' + FileInfo.Name;π                      ClrDir ( path2 );π                endπ            elseπ              if ((FileInfo.Attr and VolumeID) <> VolumeID) then beginπ                Assign ( f, path + '\' + FileInfo.Name );π                Erase ( f );π              end;ππ            FindNext ( FileInfo );π      end;ππ      if (DosError = 18) and not ((Length(path) = 2)π                                   and ( path[2] = ':')) thenπ        RmDir ( path );ππend;π                             7      05-28-9313:37ALL                      TREVOR J. CARLSEN        Disply DIR on screen     IMPORT              54     ª╢▄∞ { DIRDEMO.PASπ  Author: Trevor Carlsen. Released into the public domain 1989π                          Last modification 1992.π  Demonstrates in a very simple way how to display a directory in a screenπ  Window and scroll backwards or Forwards.  }ππUsesπ  Dos,π  Crt,π  keyinput;ππTypeπ  str3    = String[3];π  str6    = String[6];π  str16   = String[16];π  sType   = (_name,_ext,_date,_size);π  DirRec  = Recordπ              name  : NameStr;π              ext   : ExtStr;π              size  : str6;π              date  : str16;π              Lsize,π              Ldate : LongInt;π              dir   : Boolean;π            end;ππConstπ  maxdir       = 1000;     { maximum number of directory entries }π  months : Array[1..12] of str3 =π           ('Jan','Feb','Mar','Apr','May','Jun',π            'Jul','Aug','Sep','Oct','Nov','Dec');π  WinX1 = 14; WinX2 = 1;π  WinY1 = 65; WinY2 = 23;π  LtGrayOnBlue      = $17;π  BlueOnLtGray      = $71;π  page              = 22;π  maxlines : Word   = page;ππTypeπ  DataArr           = Array[1..maxdir] of DirRec;ππVarπ  DirEntry          : DataArr;π  x, numb           : Integer;π  path              : DirStr;π  key               : Byte;π  finished          : Boolean;π  OldAttr           : Byte;ππProcedure quicksort(Var s; left,right : Word; SortType: sType);π  Varπ    data      : DataArr Absolute s;π    pivotStr,π    tempStr   : String;π    pivotLong,π    tempLong  : LongInt;π    lower,π    upper,π    middle    : Word;ππ  Procedure swap(Var a,b);π    Var x : DirRec Absolute a;π        y : DirRec Absolute b;π        t : DirRec;π    beginπ      t := x;π      x := y;π      y := t;π    end;ππ  beginπ    lower := left;π    upper := right;π    middle:= (left + right) div 2;π    Case SortType ofπ      _name: pivotStr   := data[middle].name;π      _ext : pivotStr   := data[middle].ext;π      _size: pivotLong  := data[middle].Lsize;π      _date: pivotLong  := data[middle].Ldate;π    end; { Case SortType }π    Repeatπ      Case SortType ofπ        _name: beginπ                 While data[lower].name < pivotStr do inc(lower);π                 While pivotStr < data[upper].name do dec(upper);π               end;π        _ext : beginπ                 While data[lower].ext < pivotStr do inc(lower);π                 While pivotStr < data[upper].ext do dec(upper);π               end;π        _size: beginπ                 While data[lower].Lsize < pivotLong do inc(lower);π                 While pivotLong < data[upper].Lsize do dec(upper);π               end;π        _date: beginπ                 While data[lower].Ldate < pivotLong do inc(lower);π                 While pivotLong < data[upper].Ldate do dec(upper);π               end;π      end; { Case SortType }π      if lower <= upper then beginπ        swap(data[lower],data[upper]);π        inc(lower);π        dec(upper);π       end;π    Until lower > upper;π    if left < upper then quicksort(data,left,upper,SortType);π    if lower < right then quicksort(data,lower,right,SortType);π  end; { quicksort }ππFunction Form(st : String; len : Byte): String;π  { Replaces spaces in a numeric String With zeroes  }π  Varπ    x : Byte ;π  beginπ    Form := st;π    For x := 1 to len doπ      if st[x] = ' ' thenπ        Form[x] := '0'π  end;ππProcedure ReadDir(Var count : Integer);π  { Reads the current directory and places in the main Array }π  Varπ    DirInfo    : SearchRec;ππ  Procedure CreateRecord;π    Varπ      Dt : DateTime;π      st : str6;π    beginπ      With DirEntry[count] do beginπ        FSplit(DirInfo.name,path,name,ext);             { Split File name up }π        if ext[1] = '.' then                                { get rid of dot }π          ext := copy(ext,2,3);π        name[0] := #8;  ext[0] := #3; { Force to a set length For Formatting }π        Lsize := DirInfo.size;π        Ldate := DirInfo.time;π        str(DirInfo.size:6,size);π        UnPackTime(DirInfo.time,Dt);π        date := '';π        str(Dt.day:2,st);π        date := st + '-' + months[Dt.month] + '-';π        str((Dt.year-1900):2,st);π        date := date + st + #255#255;π        str(Dt.hour:2,st);π        date := date + st + ':';π        str(Dt.Min:2,st);π        date := date + st;π        date := Form(date,length(date));π        dir := DirInfo.attr and Directory = Directory;π      end; { With }π    end; { CreateRecord }ππ  begin { ReadDir }π    count := 0;         { For keeping a Record of the number of entries read }π    FillChar(DirEntry,sizeof(DirEntry),32);           { initialize the Array }π    FindFirst('*.*',AnyFile,DirInfo);π    While (DosError = 0) and (count < maxdir) do beginπ      inc(count);π      CreateRecord;π      FindNext(DirInfo);π    end; { While }π    if count < page thenπ      maxlines := count;π    quicksort(DirEntry,1,count,_name);π  end; { ReadDir }ππProcedure DisplayDirectory(n : Integer);π  Varπ    x,y : Integer;π  beginπ    y := 1;π    For x := n to n + maxlines doπ      With DirEntry[x] do beginπ        GotoXY(4,y);inc(y);π        Write(name,'  ');π        Write(ext,' ');π        if dir then Write('<DIR>')π        else Write('     ');π        Write(size:8,date:18);π      end; { With }π  end; { DisplayDirectory }ππbegin { main }π  ClrScr;π  GotoXY(5,24);π  OldAttr  := TextAttr;π  TextAttr := BlueOnLtGray;π  Write(' F1=Sort by name F2=Sort by extension F3=Sort by size F4=Sort by date ');π  GotoXY(5,25);π  Write('   Use arrow keys to scroll through directory display - <ESC> quits   ');π  TextAttr := LtGrayOnBlue;π  Window(WinX1,WinX2,WinY1,WinY2);  { make the Window }π  ClrScr;π  HiddenCursor;π  ReadDir(numb);π  x := 1; finished := False;π  Repeatπ    DisplayDirectory(x); { display maxlines Files }π      Case KeyWord ofπ      F1 {name} : beginπ                    x := 1;π                    quicksort(DirEntry,1,numb,_name);π                  end;π      F2 {ext}  : beginπ                    x := 1;π                    quicksort(DirEntry,1,numb,_ext);π                  end;π      F3 {size} : beginπ                    x := 1;π                    quicksort(DirEntry,1,numb,_size);π                  end;π      F4 {date} : beginπ                    x := 1;π                    quicksort(DirEntry,1,numb,_date);π                  end;π      home      : x := 1;π      endKey    : x := numb - maxlines;π      UpArrow   : if x > 1 thenπ                    dec(x);π      DownArrow : if x < (numb - maxlines) thenπ                    inc(x);π      PageDn    : if (x + page) > (numb - maxlines) thenπ                    x := numb - maxlinesπ                  else inc(x,page);π      PageUp    : if (x - page) > 0 thenπ                    dec(x,page)π                  else x := 1;π      escape    : finished := Trueπ      end; { Case }π  Until finished;π  NormalCursor;π  TextAttr := OldAttr;π  ClrScr;πend.ππ                         8      05-28-9313:37ALL                      SWAG SUPPORT TEAM        Does DIR Exist ?         IMPORT              7      ª╢5_ {π  re: Finding a directoryππ>Obviously that's not the quickest routine in the world, and thoughπ>it works, I was wondering if you have anything easier/faster?ππ  ...I don't know how much better this routine is, but you mayπ  want to give it a try:π}ππ{ Determine if a directory exists. }ππFunction DirExist(st_Dir : DirStr) : Boolean;πVarπ  wo_Fattr : Word;π  fi_Temp  : File;πbeginπ  assign(fi_Temp, (st_Dir + '.'));π  getfattr(fi_Temp, wo_Fattr);π  if (Doserror <> 0) thenπ    DirExist := Falseπ  elseπ    DirExist := ((wo_Fattr and directory) <> 0)πend; { DirExist. }ππ{πnotE: The "DirStr" Type definition is found in the standard TPπ      Dos Unit. Add this Unit to your Program's "Uses" statementπ      to use this routine.π}π                                    9      05-28-9313:37ALL                      SWAG SUPPORT TEAM        Another DIR Tree         IMPORT              105    ª╢:W Program Vtree2;ππ{$B-,D+,R-,S-,V-}π{π   ┌────────────────────────────────────────────────────┐π   │ Uses and GLOBAL VarIABLES & ConstANTS              │π   └────────────────────────────────────────────────────┘π}ππUsesπ  Crt, Dos;ππConstπ  NL        = #13#10;π  NonVLabel = ReadOnly + Hidden + SysFile + Directory + Archive;ππTypeππ  FPtr      = ^Dir_Rec;ππ  Dir_Rec   = Record                             { Double Pointer Record    }π    DirName : String[12];π    DirNum  : Integer;π    Next    : Fptr;π  end;ππ  Str_Type  = String[65];ππVarπ  Version   : String;π  Dir       : str_Type;π  Loop      : Boolean;π  Level     : Integer;π  Flag      : Array[1..5] of String[20];π  TreeOnly  : Boolean;π  Filetotal : LongInt;π  Bytetotal : LongInt;π  Dirstotal : LongInt;π  tooDeep   : Boolean;π  ColorCnt  : Byte;ππ{π   ┌────────────────────────────────────────────────────┐π   │ Procedure Beepit                                   │π   └────────────────────────────────────────────────────┘π}ππProcedure Beepit;ππbeginπ  Sound (760);                                          { Beep the speaker }π  Delay (80);π  NoSound;πend;ππ{π   ┌────────────────────────────────────────────────────┐π   │ Procedure Usage                                    │π   └────────────────────────────────────────────────────┘π}ππProcedure Usage;ππbeginπ  BEEPIT;π  Write (NL,π    'Like the Dos TREE command, and similar to PC Magazine''s VTREE, but gives',NL,π    'you a Graphic representation of your disk hierarchical tree structure and',NL,π    'the number of Files and total Bytes in each tree node (optionally can be',NL,π    'omitted).  Also allows starting at a particular subdirectory rather than',NL,π    'displaying the entire drive''s tree structure.  Redirection of output and',NL,π    'input is an option.',NL,NL, 'USAGE:     VTREE2 {path} {/t} {/r}',NL,NL,π    '/t or /T omits the number of Files and total Bytes inFormation.',NL,π    '/r or /R activates redirection of input and output.',NL,NL, Version);π  Halt;πend;ππ{π┌────────────────────────────────────────────────────┐π│ Function Format                                    │π└────────────────────────────────────────────────────┘π}ππFunction Format (Num : LongInt) : String;   {converts Integer to String}π                                            {with commas inserted      }πVarπ  NumStr : String[12];π  Place  : Byte;ππbeginπ  Place := 3;π  STR (Num, NumStr);π  Num := Length (NumStr);                  {re-use Num For Length value }ππ  While Num > Place do                     {insert comma every 3rd place}π  beginπ    inSERT (',',NumStr, Num - (Place -1));π    inC (Place, 3);π  end;ππ  Format := NumStr;πend;ππ{π   ┌────────────────────────────────────────────────────┐π   │ Procedure DisplayDir                               │π   └────────────────────────────────────────────────────┘π}ππProcedure DisplayDir (DirP : str_Type; DirN : str_Type; Levl : Integer;π                     NumSubsVar2 : Integer; SubNumVar2 : Integer;π                     NumSubsVar3 : Integer;π                     NmbrFil : Integer; FilLen : LongInt);ππ{NumSubsVar2 is the # of subdirs. in previous level;π NumSumsVar3 is the # of subdirs. in the current level.π DirN is the current subdir.; DirP is the previous path}ππConstπ  LevelMax = 5;πVarπ  BegLine : String;π  MidLine : String;π  Blank   : String;π  WrtStr  : String;ππbeginππ  if Levl > 5 thenπ  beginπ    BEEPIT;π    tooDeep := True;π    Exit;π  end;ππ  Blank   := '               ';                  { Init. Variables          }π  BegLine := '';π  MidLine := ' ──────────────────';ππ  if Levl = 0 then                               { Special handling For     }π    if Dir = '' then                             { initial (0) dir. level   }π      if not TreeOnly thenπ        WrtStr := 'ROOT ──'π      elseπ        WrtStr := 'ROOT'π    elseπ      if not TreeOnly thenπ        WrtStr := DirP + ' ──'π      elseπ        WrtStr := DirPπ  elseπ  begin                                        { Level 1+ routines        }π    if SubNumVar2 = NumSubsVar2 then           { if last node in subtree, }π    begin                                    { use └─ symbol & set flag }π      BegLine  := '└─';                      { padded With blanks       }π      Flag[Levl] := ' ' + Blank;π    endπ    else                                       { otherwise, use ├─ symbol }π    begin                                    { & set flag padded With   }π      BegLine    := '├─';                    { blanks                   }π      Flag[Levl] := '│' + Blank;π    end;ππ    Case Levl of                               { Insert │ & blanks as     }π      1: BegLine := BegLine;                  { needed, based on level   }π      2: Begline := Flag[1] + BegLine;π      3: Begline := Flag[1] + Flag[2] + BegLine;π      4: Begline := Flag[1] + Flag[2] + Flag[3] + BegLine;π      5: Begline := Flag[1] + Flag[2] + Flag[3] + Flag[4] + BegLine;π    end; {end Case}ππ    if (NumSubsVar3 = 0) then                  { if cur. level has no     }π      WrtStr := BegLine + DirN                 { subdirs., leave end blank}π    elseπ    beginπ      WrtStr := BegLine + DirN + COPY(Midline,1,(13-Length(DirN)));π      if Levl < LevelMax thenπ        WrtStr := WrtStr + '─┐'π      else                                   { if level 5, special      }π      begin                                { end to indicate more     }π        DELETE (WrtStr,Length(WrtStr),1);  { levels                   }π        WrtStr := WrtStr + '»';π      end;π    end;π  end;                                         { end level 1+ routines    }ππ  if ODD(ColorCnt) thenπ    TextColor (3)π  elseπ    TextColor (11);π  inC (ColorCnt);ππ  if ((Levl < 4) or ((Levl = 4) and (NumSubsVar3=0))) and not TreeOnly thenπ    WriteLn (WrtStr,'':(65-Length(WrtStr)), Format(NmbrFil):3,π             Format(FilLen):11)π  elseπ    WriteLn (WrtStr);                            { Write # of Files & Bytes  }π                                                 { only if it fits, else     }πend;                                             { Write only tree outline   }πππ{π   ┌────────────────────────────────────────────────────┐π   │ Procedure DisplayHeader                            │π   └────────────────────────────────────────────────────┘π}ππProcedure DisplayHeader;ππbeginπ  WriteLn ('DIRECtoRIES','':52,'FileS','      ByteS');π  WriteLn ('═══════════════════════════════════════════════════════════════════════════════');πend;ππ{π   ┌────────────────────────────────────────────────────┐π   │ Procedure DisplayTally                             │π   └────────────────────────────────────────────────────┘π}ππProcedure DisplayTally;ππbeginπ  WriteLn('':63,'════════════════');π  WriteLn('NUMBER of DIRECtoRIES: ', Dirstotal:3, '':29,π          'toTALS: ', Format (Filetotal):5, Format (Bytetotal):11);πend;ππ{π   ┌────────────────────────────────────────────────────┐π   │ Procedure ReadFiles                                │π   └────────────────────────────────────────────────────┘π}ππProcedure ReadFiles (DirPrev : str_Type; DirNext : str_Type;π                     SubNumVar1 : Integer; NumSubsVar1 : Integer);ππVarπ  FileInfo  : SearchRec;π  FileBytes : LongInt;π  NumFiles  : Integer;π  NumSubs   : Integer;π  Dir_Ptr   : FPtr;π  CurPtr    : FPtr;π  FirstPtr  : FPtr;ππbeginπ  FileBytes := 0;π  NumFiles  := 0;π  NumSubs   := 0;π  Dir_Ptr   := nil;π  CurPtr    := nil;π  FirstPtr  := nil;ππ  if Loop thenπ    FindFirst (DirPrev + DirNext + '\*.*', NonVLabel, FileInfo);π  Loop      := False;                            { Get 1st File             }ππ  While DosError = 0 do                          { Loop Until no more Files }π  beginπ    if (FileInfo.Name <> '.') and (FileInfo.Name <> '..') thenπ    beginπ      if (FileInfo.attr = directory) then    { if fetched File is dir., }π      begin                                { store a Record With dir. }π        NEW (Dir_Ptr);                     { name & occurence number, }π        Dir_Ptr^.DirName  := FileInfo.name;{ and set links to         }π        inC (NumSubs);                     { other Records if any     }π        Dir_Ptr^.DirNum   := NumSubs;π        if CurPtr = nil thenπ        beginπ          Dir_Ptr^.Next := nil;π          CurPtr        := Dir_Ptr;π          FirstPtr      := Dir_Ptr;π        endπ        elseπ        beginπ          Dir_Ptr^.Next := nil;π          CurPtr^.Next  := Dir_Ptr;π          CurPtr        := Dir_Ptr;π        end;π      endπ      elseπ      begin                                { Tally # of Bytes in File }π        FileBytes := FileBytes + FileInfo.size;π        inC (NumFiles);                    { Increment # of Files,    }π      end;                                 { excluding # of subdirs.  }π    end;π    FindNext (FileInfo);                       { Get next File            }π  end;    {end While}ππ  Bytetotal := Bytetotal + FileBytes;π  Filetotal := Filetotal + NumFiles;π  Dirstotal := Dirstotal + NumSubs;ππ  DisplayDir (DirPrev, DirNext, Level, NumSubsVar1, SubNumVar1, NumSubs,π              NumFiles, FileBytes);            { Pass info to & call      }π  inC (Level);                                 { display routine, & inc.  }π                                               { level number             }πππ  While (FirstPtr <> nil) do                   { if any subdirs., then    }π  begin                                      { recursively loop thru    }π    Loop     := True;                        { ReadFiles proc. til done }π    ReadFiles ((DirPrev + DirNext + '\'),FirstPtr^.DirName,π                FirstPtr^.DirNum, NumSubs);π    FirstPtr := FirstPtr^.Next;π  end;ππ  DEC (Level);                                 { Decrement level when     }π                                               { finish a recursive loop  }π                                               { call to lower level of   }π                                               { subdir.                  }πend;ππ{π   ┌────────────────────────────────────────────────────┐π   │ Procedure Read_Parm                                │π   └────────────────────────────────────────────────────┘π}ππProcedure Read_Parm;ππVarπ  Cur_Dir : String;π  Param   : String;π  i       : Integer;ππbeginππ  if ParamCount > 3 thenπ    Usage;π  Param := '';ππ  For i := 1 to ParamCount do                    { if either param. is a T, }π  begin                                        { set TreeOnly flag            }π    Param := ParamStr(i);π    if Param[1] = '/' thenπ      Case Param[2] ofπ        't','T': beginπ                   TreeOnly := True;π                   if ParamCount = 1 thenπ                     Exit;π                 end;                          { Exit if only one param   }ππ        'r','R': beginπ                   ASSIGN (Input,'');          { Override Crt Unit, &     }π                   RESET (Input);              { make input & output      }π                   ASSIGN (Output,'');         { redirectable             }π                   REWrite (Output);π                   if ParamCount = 1 thenπ                     Exit;π                 end;                          { Exit if only one param   }π        '?'    : Usage;ππ        elseπ          Usage;π      end; {Case}π  end;ππ  GETDIR (0,Cur_Dir);                            { Save current dir         }π  For i := 1 to ParamCount doπ  beginπ    Param := ParamStr(i);                      { Set Var to param. String }π    if (POS ('/',Param) = 0) thenπ    beginπ      Dir := Param;π{$I-} CHDIR (Dir);                           { Try to change to input   }π      if Ioresult = 0 then                   { dir.; if it exists, go   }π      begin                                { back to orig. dir.       }π{$I+}   CHDIR (Cur_Dir);π        if (POS ('\',Dir) = Length (Dir)) thenπ          DELETE (Dir,Length(Dir),1);       { Change root symbol back  }π        Exit;                                { to null, 'cause \ added  }π      end                                  { in later                 }π      elseπ      beginπ        BEEPIT;π        WriteLn ('No such directory -- please try again.');π        HALT;π      end;π    end;π  end;πend;ππ{π   ┌────────────────────────────────────────────────────┐π   │ MAin Program                                       │π   └────────────────────────────────────────────────────┘π}ππbeginππ  Version   := 'Version 1.6, 7-16-90 -- Public Domain by John Land';π                                                 { Sticks in EXE File      }ππ  Dir       := '';                               { Init. global Vars.      }π  Loop      := True;π  Level     := 0;π  TreeOnly  := False;π  tooDeep   := False;π  Filetotal := 0;π  Bytetotal := 0;π  Dirstotal := 1;                                { Always have a root dir. }π  ColorCnt  := 1;ππ  ClrScr;ππ  if ParamCount > 0 thenπ    Read_Parm;              { Deal With any params.   }ππ  if not TreeOnly thenπ    DisplayHeader;ππ  ReadFiles (Dir,'',0,0);                        { do main read routine    }ππ  TextColor(Yellow);ππ  if not TreeOnly thenπ    DisplayTally;             { Display totals          }ππ  if tooDeep thenπ    WriteLn (NL,NL,'':22,'» CANnot DISPLAY MorE THAN 5 LEVELS «',NL);π                                                 { if ReadFiles detects >5 }π                                                 { levels, tooDeep flag set}ππend.π        10     05-28-9313:37ALL                      SWAG SUPPORT TEAM        Directory Viewer         IMPORT              16     ª╢╠3 {πWell, here goes...a directory viewer, sorry it has no box but theπcommand that i used to create the box was from a Unit. Weel, the Programπis very "raw" but i think it's enough to give you an idea...π}ππProgram ListBox;ππUsesπ  Crt, Dos;ππConstπ  S = '           ';ππVarπ  List         : Array[1..150] of String[12];π  AttrList     : Array[1..150] of String[15];π  Pos, First   : Integer;π  C            : Char;π  Cont         : Integer;π  DirInfo      : SearchRec;π  NumFiles     : Integer;ππbeginπ  TextBackground(Black);π  TextColor(LightGray);π  ClrScr;ππ  For Cont := 1 to 15 doπ  beginπ    List[Cont] := '';π    AttrList[Cont] := '';π  end;ππ  NumFiles := 0;π  FindFirst('C:\*.*', AnyFile, DirInfo);ππ  While DosError = 0 doπ  beginπ    Inc(NumFiles, 1);π    List[NumFiles] := Concat(DirInfo.Name,π                      Copy(S, 1, 12 - Length(DirInfo.Name)));π    If (DirInfo.Attr = $10) Thenπ      AttrList[NumFiles] := '<DIR>'π    Elseπ      Str(DirInfo.Size, AttrList[NumFiles]);π    AttrList[NumFiles] := Concat(AttrList[NumFiles],π                          Copy(S, 1, 9 - Length(AttrList[NumFiles])));π    FindNext(DirInfo);π  end;ππ  First := 1;π  Pos   := 1;ππ  Repeatπ    For Cont := First To First + 15 doπ    beginπ      If (Cont - First + 1 = Pos) Thenπ      beginπ        TextBackground(Blue);π        TextColor(Yellow);π      endπ      Elseπ      beginπ        TextBackGround(Black);π        TextColor(LightGray);π      end;π      GotoXY(30, Cont - First + 3);π      Write(' ', List[Cont], '  ', AttrList[Cont]);π    end;π    C := ReadKey;π    If (C = #72) Thenπ      If (Pos > 1) Thenπ        Dec(Pos, 1)π      Elseπ      If (First > 1) Thenπ        Dec(First,1);ππ    If (C = #80) Thenπ      If (Pos < 15) Thenπ        Inc(Pos, 1)π      Elseπ      If (First + 15 < NumFiles) Thenπ        Inc(First,1);π  Until (Ord(c) = 13);πend.π                                                                   11     05-28-9313:37ALL                      SWAG SUPPORT TEAM        FAST Delete Directory    IMPORT              8      ª╢└╨ { DR> DEL/ERASE command is able to erase an entire directory by using DEL *.*π DR> With such speed.  It clearly has a method other than deleting File byπ DR> File.ππ  Function $41 of Int $21 will do what you want.  You'll need toπmake an ASCIIZ Filename of the path and File(s), and set a Pointerπto it in DS:DX.  When it returns, if the carry flag (CF) is set,πthen AX holds the Dos error code.π}πFunction DosDelete (FileName : PathStr) : Word; {returns error if any}πVar Regs : Registers;πbeginπ  FileName[65] := 0;             {make asciiz- maybe, not sure}π  Regs.DS := Seg(FileName);      {segment to String}π  Regs.DX := offset(FileName)+1; {add one since f[0] is length}π  Regs.AH := $41;π  Regs.AL := 0;                  {Initialize}π  Intr ($21, Regs);π  if Regs.AL <> 0 {error} then DosDelete := Regs.AX else DosDelete := 0;πend;π                                                        12     05-28-9313:37ALL                      SWAG SUPPORT TEAM        Make/Change DIR          IMPORT              19     ª╢ε+ Program MakeChangeDir;ππ{ Purpose:      - Make directories where they don't exist               }π{                                                                       }π{ Useful for:   - Installation Type Programs                            }π{                                                                       }π{ Useful notes: - seems to handles even directories With extentions     }π{                 (i.e. DIRDIR.YYY)                                     }π{               - there are some defaults that have been set up :-      }π{                 change if needed                                      }π{               - doesn't check to see how legal the required directory }π{                 is (i.e. spaces, colon in the wrong place, etc.)      }π{                                                                       }π{ Legal junk:   - this has been released to the public as public domain }π{               - if you use it, give me some credit!                   }π{                                                                       }ππVarπ  Slash : Array[1..20] of Integer;ππProcedure MkDirCDir(Target : String);πVarπ  i,π  count   : Integer;π  dir,π  home,π  tempdir : String;ππbeginπ  { sample directory below to make }π  Dir := Target;π  { add slash at end if not given }π  if Dir[Length(Dir)] <> '\' thenπ    Dir := Dir + '\';π  { if colon where normally is change to that drive }π  if Dir[2] = ':' thenπ    ChDir(Copy(Dir, 1, 2))π  elseπ  { assume current drive (and directory) }π  beginπ    GetDir(0, Home);π    if Dir[1] <> '\' thenπ      Dir := Home + '\' + Dirπ    elseπ      Dir := Home + Dir;π  end;ππ  Count := 0;π  { search directory For slashed and Record them }π  For i := 1 to Length(Dir) doπ  beginπ    if Dir[i] = '\' thenπ    beginπ      Inc(Count);π      Slash[Count] := i;π    end;π  end;π  { For each step of the way, change to the directory }π  { if get error, assume it doesn't exist - make it }π  { then change to it }π  For i := 2 to Count doπ  beginπ    TempDir := Copy(Dir, 1, Slash[i] - 1);π    {$I-}π    ChDir(TempDir);π    if IOResult <> 0 thenπ    beginπ      MkDir(TempDir);π      ChDir(TempDir);π    end;π  end;πend;ππbeginπ  MkDirCDir('D:\HI.ZZZ\GEEKS\2JKD98');πend.π                                                                            13     05-28-9313:37ALL                      SWAG SUPPORT TEAM        FAST Make Directory      IMPORT              7      ª╢╒ù {π    Hi Mark, there is a Procedure in Turbo Pascal called MkDir that allowsπyou to create a subdirectory. However if you want source code For a similarπroutine try the following. I just whipped it up so it doesn't contain anyπerror checking, but you could add a simple if else after the Dos call toπcheck the register flags. Anyhow, I hope that this helps ya out.π}πProcedure Make_Directory (Directory: String);π{ parameters:  Directory - name of the new directoryπ  sample-call: Make_Directory('\tools') }πVarπ    Regs: Registers;πbeginπ  With Regs doπ  beginπ    Directory := Directory + chr(0);π    AX := $3900;π    DS := Seg(Directory[1]);π    DX := ofs(Directory[1]);π    MSDos(Dos.Registers(Regs));π  end;πend;π                                                  14     08-18-9312:22ALL                      JOSE ALMEIDA             Get a programs directory IMPORT              9      ª╢@ { Gets the program directory.π  Part of the Heartware Toolkit v2.00 (HTfile.PAS) for Turbo Pascal.π  Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π          I can also be reached at RIME network, site ->TIB or #5314.π  Feel completely free to use this source code in any way you want, and, ifπ  you do, please don't forget to mention my name, and, give me and Swag theπ  proper credits. }ππFUNCTION Get_Prg_Dir : string;ππ{ DESCRIPTION:π    Gets the program directory.π  SAMPLE CALL:π    St := Get_Prg_Dir;π RETURNS:π    The program directory, e.g., E:\TP\π NOTES:π    The program directory is always where the program .EXE file is located.π    This function add a backslash at the end of string. }ππvarπ  Tmp : string;ππBEGIN { Get_Prg_Dir }π  Tmp := ParamStr(0);π  while (Tmp[Length(Tmp)] <> '\') and (Length(Tmp) <> 0) doπ    Delete(Tmp,Length(Tmp),1);π  if Tmp = '' thenπ    Tmp := Get_Cur_Dir;π  Get_Prg_Dir := Tmp;πEND; { Get_Prg_Dir }π                                                               15     08-27-9319:58ALL                      LAWRENCE JOHNSTONE       Every Dir in Pascal      IMPORT              11     ª╢ⁿ└ {πLAWRENCE JOHNSTONEππ│Can someone give me some code (in TP) that recognizes all Sub-dirsπ│and Sub-sub-dirs, etc. in drive C and changes into every single oneπ│of them one at a time?π}ππPROGRAM EveryDir;ππUSESπ  DOSππPROCEDURE ProcessDirs( Path: DOS.PathStr );πVARπ  SR : SearchRec;πBEGINπ  IF Path[Length(Path)] <> '\' THEN { Make sure last char is '\' }π    Path := Path + '\';ππ  { Change to directory specified by Path.  Handle root as special case }π  {$I-}π  IF (Length(Path) = 3) AND (Copy(Path, 2, 2) = ':\') THENπ    ChDir(Path)π  ELSEπ    ChDir(Copy(Path, 1, Length(Path) - 1);π  IF IOResult <> 0 THENπ    EXIT; { Quit if we get a DOS error }π  {$I-}ππ  { Process all subdirectories of that directory, except for }π  { the '.' and '..' aliases                                 }π  FindFirst(Path + '*.*', Directory, SR);π  WHILE DosError = 0 DOπ  BEGINπ    IF ((SR.Attr AND Directory) <> 0) ANDπ        (SR.Name <> '.') AND (SR.Name <> '..') THENπ      ProcessDirs( Path + SR.Name );π    FindNext(SR);π  END; { while }πEND; {ProcessDirs}ππVARπ  CurDir : DOS.PathStr;ππBEGINπ  GetDir(3, CurDir);  { Get default directory on C }π  ProcessDirs('C:\'); { Process all directories on C }π  ChDir(CurDir);      { Restore default directory on C }πEND.π                           16     08-27-9319:59ALL                      PER-ERIC LARSSON         Find a file anywhere     IMPORT              18     ª╢Vv {πPER-ERIC LARSSONππ> I've seen some posts asking how to search through directories or how toπ> find a File anywhere on the disk, so here's a little Procedure I wroteπ> to do it...  Give it a whirl and feel free to ask questions...ππThere is a built in trap in the method you describe. I've fallen into it manyπtimes myself so here's a clue. The problem:πif Your Procedure (that is called once per File) does some processing of theπFile you SHOULD first make a backup copy. personally I rename the originalπFile to .BAK and then take that File as input, writing to a new File With theπoriginal name, perhaps deleting the .bak File if everything works out fine.πFor most purposes this works fine. But if you do this using findnext to findπthe next File to work With it will Repeat itself til the end of time orπdiskspace.ππTherefore i recommend :πFirst get all Filenames to work With,πThen start processing the Files.π}ππProcedure runFile(ft : String);πbeginπ  { Process File here}πend;ππProcedure RUNALLFileS(FT : String);πTypeπ  plista = ^tlista;π  tlista = Recordπ    namn : String;π    prev : plista;π  end;πVarπ S    : SearchRec;π Dir  : DirStr;π Name : NameStr;π Ext  : ExtStr;π pp   : plista;ππFunction insertbefore(before : plista) : plista;πVarπ  p : plista;πbeginπ  getmem(p, sizeof(tlista));π  p^.prev := before;π  insertbefore := p;πend;ππFunction deleteafter(before : plista) : plista;πbeginπ  deleteafter := before^.prev;π  freemem(before, sizeof(tlista));πend;ππbeginπ  pp := nil;π  FSplit(fT, Dir, Name, Ext);π  FINDFIRST(ft, $3f, S);π  While DosERROR = 0 DOπ  beginπ    if (S.ATTR and $18) = 0 thenπ    beginπ      pp := insertbefore(pp);π      pp^.namn := dir + s.name;π   end;π   FINDNEXT(S);π  end;π  if pp <> nil thenπ  Repeatπ    runFile(pp^.namn);π    pp := deleteafter(pp);π  Until pp = nil;πend;ππbeginπ  if paramcount > 0 thenπ  beginπ    For filaa := 1 to paramcount doπ      runALLFileS(paramstr(filaa));π  end;π  Writeln('Klar')πend.ππ{πThis is a cutout example from a Program i wroteπIt won't compile but it'll show a way to do it !π}π                                                                                                                17     08-27-9321:21ALL                      JON KENT                 Setting a files path     IMPORT              11     ª╢╔Y {πJON KENTππHere's one way to set a File's path "on the fly" using Typed Constants.π}ππUsesπ  Dos;ππConstπ  TestFile1 : String = 'TEST1.DAT';π  TestFile2 : String = 'DATA\TEST2.DAT';πVarπ  CurrentPath : String;ππFunction FileStretch(SType : Byte; FileFullName : String) : String;πVarπ  P : PathStr;π  D : DirStr;π  N : NameStr;π  E : ExtStr;πbeginπ  P := FExpand(FileFullName);π  FSplit(P, D, N, E);π  if D[LENGTH(D)] = '\' thenπ    D[0] := CHR(PRED(LENGTH(D)));π  Case SType OFπ    1 :  FileStretch := D;π    2 :  FileStretch := N + E;π    3 :  FileStretch := D + '\' + N;π    4 :  FileStretch := N;π    else FileStretch := '';π  end;πend;ππbeginπ  CurrentPath := FileStretch(1,ParamStr(0));    { Get EXE's Path  }π  TestFile1   := CurrentPath + '\' + TestFile1; { Set DAT Paths   }π  TestFile2   := CurrentPath + '\' + TestFile2;ππ  {...}ππend.π{-----------------------------}ππ{  if CurrentPath = C:\WORK thenππ       TestFile1 = C:\WORK\TEST1.DATπ       TestFile2 = C:\WORK\DATA\TEST2.DATππ  This works Really well when you want to store a Program's configurationπ  File or data Files in the same directory as the Program regardless itsπ  location.π}                                                                                                                              18     09-26-9309:10ALL                      MARTIN RICHARDSON        Check for Directory      IMPORT              7      ª╢íë π{*****************************************************************************π * Function ...... IsDir()π * Purpose ....... To check for the existance of a directoryπ * Parameters .... Dir        Dir to check forπ * Returns ....... TRUE if Dir existsπ * Notes ......... Noneπ * Author ........ Martin Richardsonπ * Date .......... May 13, 1992π *****************************************************************************}πFUNCTION IsDir( Dir: STRING ) : BOOLEAN;πVARπ   fHandle: FILE;π   wAttr: WORD;πBEGINπ     WHILE Dir[LENGTH(Dir)] = '\' DO DEC( Dir[0] );π     Dir := Dir + '\.';π     ASSIGN( fHandle, Dir );π     GETFATTR( fHandle, wAttr );π     IsDir := ( (wAttr AND DIRECTORY) = DIRECTORY );πEND;ππ                                                            19     11-02-9306:08ALL                      HERBERT ZARB             Change File Attr         IMPORT              7      ª╢╨Θ { Updated FILES.SWG on November 2, 1993 }ππ{πHerbert Zarb <panther!jaguar![e-mail]>ππ  This simple Program changes the attribute of the File or directory fromπ   hidden to archive or vice-versa...π}ππProgram hide_unhide;π{ Accepts two command line parameters :π        1st parameter can be either +h (hide) or -h(unhide).π        2nd parameter must be the full path }πUsesπ  Dos;ππConstπ  bell    = #07;π  hidden  = $02;π  archive = $20;ππVarπ  f : File;ππbeginπ  if paramcount >= 2 thenπ  beginπ    Assign(f, paramstr(2));π    if paramstr(1) = '+h' thenπ      SetFAttr(f, hidden)π    elseπ    if paramstr(1) = '-h' thenπ      SetFAttr(f, Archive)π    elseπ      Write(bell);π  endπ  elseπ    Write(bell);πend.π                                             20     11-02-9306:08ALL                      TIMO SALMI               Another Change File Attr IMPORT              11     ª╢╧¿ { Updated FILES.SWG on November 2, 1993 }ππ{π[e-mail] (Timo Salmi)ππ Q: How can one hide (or unhide) a directory using a TP Program?ππ A: SetFAttr which first comes to mind cannot be used For this.πInstead interrupt Programming is required.  Here is the code.πIncidentally, since MsDos 5.0 the attrib command can be used to hideπand unhide directories.π(* Hide a directory. Before using it would be prudent to checkπ   that the directory exists, and that it is a directory.π   With a contribution from Jan Nielsen [e-mail]π   Based on information from Duncan (1986), p. 410 *)π}πProcedure HIDE(dirname : String);πVarπ  regs : Registers;πbeginπ  FillChar(regs, SizeOf(regs), 0);    { standard precaution }π  dirname := dirname + #0;           { requires ASCII Strings }π  regs.ah := $43;                    { Function }π  regs.al := $01;                    { subFunction }π  regs.ds := Seg(dirname[1]);        { point to the name }π  regs.dx := Ofs(dirname[1]);π  regs.cx := 2; { set bit 1 on }     { to unhide set regs.cx := 0 }π  Intr ($21, regs);                  { call the interrupt }π  if regs.Flags and FCarry <> 0 then { were we successful }π    Writeln('Failed to hide');πend;π                                                                                      21     11-02-9310:27ALL                      DAVID DRZYZGA            Multiple Dir Picks       IMPORT              22     ª╢≥└ {πDAVID DRZYZGAππ> And I can't seem to get the OpDir system to work With multiple Files, orπ> at least I can't get the "tagging" Function to work.ππHere's a somewhat stripped snipit of code from one of my apps that will giveπyou a clear example of how to use the multiple pick Function of the DirListπObject:π}ππProgram DirTest;ππ{$I OPDEFINE.INC}ππUsesπ  Dos,π  OpRoot,π  OpConst,π  OpString,π  OpCrt,π  OpCmd,π  OpFrame,π  OpWindow,π  OpPick,π  OpDir,π  OpColor;ππConstπ  SliderChar    = '▓';π  ScrollBarChar = '░';π  Frame1        : FrameArray = '┌└┐┘──││';π  Counter       : Word = 1;ππVarπ  Dir          : DirList;π  Finished     : Boolean;π  SelectedItem : Word;π  DirWinOpts   : LongInt;π  I            : Integer;ππProcedure ProcessFile(FileName : String);πbeginπ  {This is where you would process each of the tagged Files}πend;ππbeginπ  DirWinOpts := DefWindowOptions+wBordered;π  if not Dir.InitCustom(20, 4, 50, 19, {Window coordinates}π                        DefaultColorSet,  {ColorSet}π                        DirWinOpts,    {Window options}π                        MaxAvail,      {Heap space For Files}π                        PickVertical,  {Pick orientation}π                        MultipleFile)  {Command handler}π  thenπ  beginπ    WriteLn('Failed to Init DirList,  Status = ', InitStatus);π    Halt;π  end;ππ  {Set desired DirList features}π  With Dir doπ  beginπ    wFrame.AddShadow(shBR, shSeeThru);π    wFrame.AddCustomScrollBar(frRR, 0, MaxLongInt, 1, 1, SliderChar,π                              ScrollBarChar, DefaultColorSet);ππ    SetSelectMarker(#251' ', '');π    SetPosLimits(1, 1, ScreenWidth, ScreenHeight-1);π    SetPadSize(1, 1);π    diOptionsOn(diOptimizeSize);π    AddMaskHeader(True, 1, 30, heTC);π    SetSortOrder(SortDirName);π    SetNameSizeTimeFormat('<dir>', 'Mm/dd/yy', 'Hh:mmt');π    SetMask('*.*', AnyFile);π  end;ππ  {<AltP>: process selected list}π  PickCommands.AddCommand(ccUser0, 1, $1900, 0);ππ  {Pick Files}π  Finished := False;π  Repeatπ    Dir.Process;π    Case Dir.GetLastCommand ofπ      ccSelect : ;π      ccError  : ;π      ccUser0  :π      beginπ        Counter := 1;π        if Dir.GetSelectedCount > 0 thenπ        beginπ          Dir.InitSequence(SelectedItem);π          While Dir.HaveSelected(SelectedItem) doπ          beginπ            ProcessFile(Dir.GetMultiPath(SelectedItem));π            Inc(Counter);π            Dir.NextSelected(SelectedItem);π            Dir.ResetList;π          end;π        endπ      end;ππ      ccQuit : Finished := True;π    end;π  Until Finished;ππ  Dir.Erase;π  ClrScr;π  Dir.Done;πend.π                                                                                                       22     01-27-9413:32ALL                      ROBERT ROTHENBURG        Files Wildcard Matching  IMPORT              99     ª╢¡╝ (* -------------------------------------------------------------- *)π(* FileSpec.PAS v1.0a by Robert Walking-Owl November 1993         *)π(* -------------------------------------------------------------- *)ππ{ Things to add...                                                 }π{ - have # and $ be symbols for ASCII chars in dec/hex?            }ππ(* Buggie Things:                                                 *)π(* - anti-sets don't work with variable lenght sets, since they   *)π(*   end with the first character NOT in the set...               *)ππ{$F+}ππunit FileSpec;ππinterfaceππuses Dos;ππconstπ  DosNameLen  = 12;     (* Maximum Length of DOS filenames        *)π  UnixNameLen = 32;     (* Maximum Length of Unix Filenames       *)ππ  MaxWildArgs = 32;     (* Maximum number of wildcard arguments   *)π  MaxNameLen  = 127;ππ  fCaseSensitive = $01; (* Case Sensitive Flag                    *)π  fExtendedWilds = $02; (* Use extented wildcard forms (not,sets  *)π  fUndocumented  = $80; (* Use DOS 'undocumented' filespecs       *)ππtypeπ  SpecList   = array [1..MaxWildArgs] of recordπ                   Name:  string[ MaxNameLen ];  (* or use DOS ParamStr?  *)π                   Truth: Booleanπ                   end;π  PWildCard  = ^TWildCard;π  TWildCard  = objectπ                 privateπ                   FileSpecs: SpecList;     (* List of filespecs      *)π                   NumNegs,                 (* Number of "not" specs  *)π                   FSpCount:  word;         (* Total number of specs  *)π                   function StripQuotes( x: string ): string;π                   procedure   FileSplit(Path: string;π                                   var Dir,Name,Ext: string);π                 publicπ                   PathChar,                (* path seperation char   *)π                   NotChar,                 (* "not" char - init '~'  *)π                   QuoteChar:     Char;     (* quote char - init '"'  *)π                   Flags,                   (* Mode flags ...         *)π                   FileNameLen:   Byte;     (* MaxLength of FileNames *)π                   constructor Init;π                   procedure   AddSpec( name: string);π                   function    FitSpec( name: string): Boolean;π                   destructor  Done;π               (* Methods to RemoveSpec() or ChangeSpec() aren't added *)π               (* since for most applications they seem unnecessary.   *)π               (* An IsValid() spec to see if a specification is valid *)π               (* syntax is also unnecessary, since no harm is done,   *)π               (* and DOS and Unix ignore them anyway ....             *)π               end;πππimplementationππprocedure UpCaseStr( var S: string); assembler;πasmπ                PUSH    DSπ                LDS     SI,Sπ                MOV     AL,BYTE PTR DS:[SI]π                XOR     CX,CXπ                MOV     CL,ALπ@STRINGLOOP:    INC     SIπ                MOV     AL,BYTE PTR DS:[SI]π                CMP     AL,'a'π                JB      @NOTLOCASEπ                CMP     AL,'z'π                JA      @NOTLOCASEπ                SUB     AL,32π                MOV     BYTE PTR DS:[SI],ALπ@NOTLOCASE:     LOOP    @STRINGLOOPπ                POP     DSπend;πππconstructor TWildCard.Init;πbeginπ  FSpCount  := 0;π  NumNegs   := 0;π  NotChar   := '~';π  QuoteChar := '"';π  Flags := fExtendedWilds or fUndocumented;π  FileNameLen := DosNameLen;π  PathChar := '\';πend;ππdestructor TWildCard.Done;πbeginπ  FSpCount := 0πend;ππfunction TWildCard.StripQuotes( x: string ): string;πbeginπ  if x<>''π    then if (x[1]=QuoteChar) and (x[length(x)]=QuoteChar)π      then StripQuotes := Copy(x,2,Length(x)-2)π      else StripQuotes := xπend;ππprocedure TWildCard.AddSpec( Name: string);πvarπ  Truth: Boolean;πbeginπ  if Name <> '' then beginπ  Truth := True;π  if (Flags and fExtendedWilds)<>0π    then beginπ      if Name[1]=NotCharπ        then beginπ          inc(NumNegs);π          Truth := False;π          Name  := Copy( Name , 2, Pred(Length(Name)) );π         end;π      Name := StripQuotes( Name );π    end;π  if (FSpCount<>MaxWildArgs) and (Name<>'')π    then beginπ      inc( FSpCount );π      FileSpecs[ FSpCount ].Name := Name;π      FileSpecs[ FSpCount ].Truth := Truthπ      end;π  endπend;ππprocedure TWildCard.FileSplit(Path: string; var Dir,Name,Ext: string);πvarπ  i,p,e: byte;π  InSet: Boolean;πbeginπ  p:=0;π  if (Flags and fCaseSensitive)=0π    then UpCaseStr(Path);π  for i:=1 to length(Path) do if Path[i]=PathChar then p:=i;π  i:=Length(Path);π  InSet := False;π  e := succ(length(Path));π  repeatπ    if not Insetπ       then case Path[i] ofπ              '.': e := i;π              ']',π              '}',π              ')': InSet := True;π            endπ       else if Path[i] in ['[','{','('] then InSet := False;π    dec(i);π  until i=0;π  if p=0π    then Dir := ''π    else Dir := Copy(Path,1,p);π  Name := Copy(Path,Succ(p),pred(e-p));π  if e<=length(Path)π    then Ext := Copy(Path,e,succ(Length(Path)-e))π    else Ext := '';πend;ππfunction TWildCard.FitSpec( name: string): Boolean;ππprocedure Puff(var x: string); (* Pad filename with spaces *)πbeginπ  while length(x)<FileNameLen do x:=x+' ';πend;πππvar x,b: set of char;πprocedure GetSet(s: string; EndSet: char; var k: byte);πvarπ    c: char;π    u: string;π    i: byte;π    A: Boolean;πbeginπ  A := False;π  if s[k]=',' then repeatπ      inc(k)π    until (k>=FileNameLen) or (s[k]=EndSet) or (s[k]<>',');π  u := '';π  if (k<FileNameLen) and (s[k]<>EndSet) then beginπ    repeatπ      u := u + s[k];π      inc(k);π    until (k>=FileNameLen) or (s[k]=EndSet) or (s[k]=',');π    if u<>'' then beginπ      if u[1]=NotCharπ        then beginπ          A := True;π          u := Copy(u,2,pred(length(u)));π          end;π      u := StripQuotes(u);π      if (length(u)=3) and (u[2]='-')π        then beginπ           for c := u[1] to u[3]π             do if A then b := b+[ c ]π                   else x := x+[ c ]π           endπ        else beginπ           for i:=1 to length(u)π             do if A then b := b+[ u[i] ]π                   else x:=x+[ u[i] ];π           endπ    end;π  end;πend;ππfunction Match(n,s: string): Boolean;  (* Does a field match? *)πvar i,j,k: byte;π    c: char;π    T: Boolean;π    Scrap: string;πbeginπ  i := 1; (* index of filespec *)π  j := 1; (* index of name     *)π  T := True;π  Puff(n);π  Puff(s);π  repeatπ    if s[i]='*' then i:=FileNameLen (* Abort *)π      elseπ         case s[i] ofπ         '(' : if ((Flags and fExtendedWilds)<>0) then beginπ                 Scrap := '';π                 inc(i);π                 repeatπ                   Scrap := Scrap + s[i];π                   inc(i);π                 until (i>=FileNameLen) or (s[i]=')');π                 Scrap := StripQuotes(Scrap);π                 if Pos(Scrap,Copy(n,j,Length(n)))=0π                   then T := False;π               end;π         '[' : if ((Flags and fExtendedWilds)<>0) then beginπ                x := [];  b := [];π                k:=succ(i);π                repeatπ                  GetSet(s,']',k);π                until (k>=FileNameLen) or (s[k]=']');π                i := k;π                if x=[] then FillChar(x,SizeOf(x),#255);π                x := x-b;π                if not (n[j] in x) then T := False;π               end;π          '{' : if ((Flags and fExtendedWilds)<>0) then beginπ                  x := [];  b := [];π                  k:=succ(i);π                  repeatπ                   GetSet(s,'}',k);π                  until (k>=FileNameLen) or (s[k]='}');π                  i := succ(k);π                  if x=[] then FillChar(x,SizeOf(x),#255);π                  x := x-b;π                  while (n[j] in x) and (j<=FileNameLen)π                    do inc(j);π               end;π       else if T and (s[i]<>'?')π          then if s[i]<>n[j] then  T := False;π       end;π    inc(i);π    inc(j);π  until (not T) or (s[i]='*') or (i>FileNameLen) or (j>FileNameLen);π  Match := T;πend;ππvar i,π    NumMatches : byte;π    dn,de,nn,ne,sn,se: string;π    Negate : Boolean;πbeginπ  Negate := False;π  if FSpCount=0 then NumMatches := 1π    else beginπ      NumMatches := 0;π      for i:=1 to FSpCountπ        do beginπ          FileSplit(name,dn,nn,ne);π          FileSplit(FileSpecs[i].Name,de,sn,se);π            if ne='' then ne:='.   ';π          if (Flags and fUnDocumented)<>0 then beginπ            if sn='' then sn:='*';π            if se='' then se:='.*';π            if dn='' then dn:='*';π            if de='' then de:='*';π          end;π          if (Match(dn,de) and Match(nn,sn) and Match(ne,se))π             then beginπ               inc(NumMatches);π               if not FileSpecs[i].Truthπ                  then Negate := True;π               end;π          end;π      end;π  if (NumNegs=FSpCount) and (NumMatches=0)π    then FitSpec := Trueπ    else FitSpec := (NumMatches<>0) xor Negate;πend;πππend.ππ{---------------------  DEMO ------------------------- }ππ(* Demo program to "test" the FileSpec unit                             *)π(* Checks to see if file matches filespec... good for testing/debugging *)π(* the FileSpec object/unit, as well as learning the syntax of FileSpec *)ππprogram FileSpec_Test(input, output);π  uses FileSpec;πvar p,                                       (* User-entered "filespec"  *)π    d:  String;                              (* Filename to "test"       *)π    FS: TWildCard;                           (* FileSpec Object          *)πbeginπ  FS.Init;                                   (* Initialize               *)π  WriteLn;π  Write('Enter filespec -> '); ReadLN(p);    (* Get filespec...          *)π  FS.AddSpec(p);                             (* ... Add Spec to list ... *)π  Write('Enter file -----> '); ReadLN(d);    (* ... Get Filename ...     *)π  if FS.FitSpec(d)                           (* Is the file in the list? *)π    then WriteLN('The files match.')π    else WriteLN('The files don''t match.');π  FS.Done;                                   (* Done... clean up etc.    *)πend.πππFileSpec v1.0aπ--------------ππ"FileSpec" is a public domain Turbo Pascal unit that gives you advanced,πUnix-like filespecs and wildcard-matching capabilities for your software.πThis version should be compatible with Turbo Pascal v5.5 upwards (sinceπit uses OOP).ππThe advantage is that you can check to see if a filename is within theπspecs a user has given--even multiple filespecs; thus utilities likeπfile-finders or archive-viewers can have multiple file-search specif-πications.ππTo use, first initialize the TWildCard object (.Init).ππYou then use .AddSpec() to add the wildcards (e.g. user-specified) to theπlist; and use .FitSpec() to see if a filename "fits" in that list.ππWhen done, use the .Done destructor. (Check your TPascal manual if you doπnot understand how to use objects).ππ"FileSpec" supports standard DOS wilcards (* and ?); also supported are theπundocumented DOS wildcards (eg. FILENAME = FILENAME.* and .EXT = *.EXT).ππHowever, "FileSpec" supports many extended features which can make a programπmany times more powerful.  Filenames or wildcards can be in quotes (eg. "*.*"πis equivalent to *.*).ππAlso supported are "not" (or "but") wildcards using the ~ character.  Thusπa hypothetical directory-lister with the argument ~*.TXT would list allπfiles _except_ those that match *.TXT.ππFixed and variable length "sets" are also supported:ππ[a-m]*.*           <- Any files beginning with letters A-Mπ[a-z,~ux]*.*       <- Any files beginning with a any letter except X or Uπ*.?[~q]?           <- Any files except those that match *.?Q?πfoo[abc]*.*        <- Files of FOO?*.* where '?' is A,B or Cπfoo["abc"]*.*      <- Same as above.πfoo[a-c]*.*        <- Same as above.πtest{0-9}.*        <- Files of TEST0.* through TEST9999.*πx{}z.*             <- Filenames beginning with X and ending with Zπx{0123456789}z.*   <- Same as above, only with numbers between X and Z.π("read")*.*        <- Filenames that contain the text "READ"ππIf this seems confusing, use the FS-TEST.PAS program included with thisπarchive to experiment and learn the syntax used by "FileSpec".ππPlaying around with the included demos (LS.PAS, a directory lister; andπXFIND, a file-finder) will also give you an idea how to use the FileSpecsπunit.ππOne Note: if you use the FileSpec unit with your software, please let usersπknow about it in the documentation, so that they know they can take fullπadvantage of the added features.ππ                                                 23     01-27-9413:32ALL                      ROBERT ROTHENBURG        DOS Files Listing        IMPORT              8      ª╢Γ program ListFiles(input,output);π  uses Dos,π       FileSpec;ππvarπ  FS: TWildCard;ππprocedure WriteName(Name: string; Attr: word);πvar T: String;πbeginπ  if Attr=Directoryπ    then Name := '['+Name+']';π  Name := Name + '                ';     (* 16 spaces *)π  Write( Copy(Name,1,16) );πend;ππprocedure ListFiles;πvarπ  Search:  SearchRec;πbeginπ    FindFirst('*.*',AnyFile,Search);π    if DosError<>18 then beginπ       if FS.FitSpec(Search.Name)π             then WriteName(Search.Name,Search.Attr);π         repeatπ           FindNext(Search);π           if DosError<>18π             then if FS.FitSpec(Search.Name)π                  then WriteName(Search.Name,Search.Attr);π         until DosError = 18;π       end;πend;ππvarπ  i:      Byte;πbeginπ  FS.Init;π  for i := 1 to ParamCount do FS.AddSpec(ParamStr(i));π  ListFiles;π  FS.Done;π  WriteLn;πend.π                                    24     01-27-9413:34ALL                      ROBERT ROTHENBURG        File Finder              IMPORT              13     ª╢á# πprogram XFind(input,output);π  uses Dos,π       FileSpec;ππvarπ  FS: TWildCard;πππprocedure WriteSpec(Name: string);πbeginπ   Name := FExpand(Name);π   WriteLn(Name);πend;ππprocedure FindFiles(Dir: String);πvarπ  Search:  SearchRec;π  CurDir:  String;π  DirList: array [1..128] of string[12];π  i,π  DirNum:  Byte;πbeginπ  CurDir := FExpand('.');π  if (Dir<>'.') and (Dir<>'..') then beginπ    ChDir(FExpand(Dir));π    DirNum := 0;π    FindFirst('*.*',AnyFile,Search);π    if DosError<>18 then beginπ         if Search.Attr=Directoryπ           then beginπ               inc(DirNum);π               DirList[ DirNum ] := Search.Name;π             endπ           else if FS.FitSpec(Search.Name)π             then WriteSpec(Search.Name);π         repeatπ           FindNext(Search);π           if DosError<>18π             then if Search.Attr=Directoryπ               then beginπ                  inc(DirNum);π                  DirList[ DirNum ] := Search.Name;π                 endπ               else if FS.FitSpec(Search.Name)π                  then WriteSpec(Search.Name);π         until DosError = 18;π       end;π    if DirNum<>0π      then for i := 1 to DirNum do FindFiles(DirList[i]);π    ChDir(CurDir);π  end;πend;ππvarπ  i:      Byte;πbeginπ  if ParamCount = 0π    then WriteLn('Usage: XFIND file1 [file2 file3 ... ]')π    else beginπ       FS.Init;π       for i := 1 to ParamCount do FS.AddSpec(ParamStr(i));π       FindFiles('\');π       FS.Done;π      end;πend.π                                                              25     02-03-9416:18ALL                      EDDY THILLEMAN           Recursive Directory Roam IMPORT              21     ª╢≡▓ π{$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.ππ{--------------- cut here -------------------}ππyou can give an optional filemask to see only files which meet thisπfilemask.π                                                                                                                  26     02-15-9408:40ALL                      DANIEL BRONSTEIN         Qualified path/file      IMPORT              20     ª╢
 {******************************************************************π * Create a function for returning a fully qualified path/file    *π * string, with the *'s replaced by the appropriate number of ?'s.*π *                                                                *π * (C) Daniel A. Bronstein, Michigan State University, 1991.      *π *     May be used freely with acknowledgement.                   *π *****************************************************************}ππunit qualify;ππInterfaceπuses dos;                    {for pathstr definition}ππfunction fqualify(var ps:pathstr):pathstr;ππImplementationππ{$F+} {Far call so loading of the variable is simplified for asm.}πfunction fqualify(var ps:pathstr):pathstr;πbeginπ  asmπ    push  ds                 {Save DS, else will crash after exit}π    push  si                 {and just to be safe, save SI too.}π    lds   si,ps              {Load address of pathstring,}π    xor   ax,ax              {clear AX,}π    cld                      {set direction flag and}π    lodsb                    {get length byte, incrementing SI.}π    mov   bx,ax              {Move length to BX and add}π    mov   byte ptr[si+bx],0  {a #0 to end to create ASCIIZ string.}π    les   di,@result         {Load address of the output string}π    mov   bx,di              {and save it in BX.}π    inc   di                 {Point past length byte of result}π    mov   ah,60h             {and call DOS function 60h.}π    int   21hπ    jnc   @ok                {If no carry then ok, else return}π    mov   byte ptr[es:bx],0  {a 0 length string.}π    jmp   @xitπ@ok:π    xor   cx,cx              {Clear CX and}π@0loop:π    inc   di                 {loop until find end of returned}π    inc   cx                 {ASCIIZ string.}π    cmp   byte ptr[es:di],0  {**Note that on 286 & 386 inc/cmp is faster}π    jne   @0loop             {**than CMPSB, so used here.}π    mov   byte ptr[es:bx],cl {Set the length byte of the result.}π@xit:π    pop   si                 {Restore SI and}π    pop   ds                 {DS, then}π  end;                       {exit.}πend;π{$F-}ππbeginπend.ππ{ ==================================  DEMO    ============================}ππPROGRAM Qualtest;ππUSES DOS, Qualify;ππVARπ  MyString, YourString : PathStr;ππBEGINπ  MyString := 'Foo*.*';π  YourString := FQualify(MyString);π  Writeln(YourString);π  Readln;ππEND.                                                            27     02-15-9408:40ALL                      MATTHEW PALCIC           DOS Directory Routines   IMPORT              90     ª╢X■ π{ Updated DIRS.SWG on February 15, 1994 }ππUnit PDir;ππ(*ππ   Palcic Directory Routinesπ   Copyright (C) 1989, Matthew J. Palcicπ   Requires Turbo Pascal 5.5 or higherππ   v1.0, 18 Aug 89 - Original release.ππ*)πππINTERFACEππuses Dos,Objects;ππ(*------------------------------------------------------------------------*)ππTYPEππ  AttrType = Byte;π  FileStr = String[12];ππ  BaseEntryPtr = ^BaseEntry;π  BaseEntry = object(Node)π    Attr: AttrType;π    Time: Longint;π    Size: Longint;π    Name: FileStr;π    constructor Init;π    destructor Done; virtual;π    procedure ConvertRec(S:SearchRec);π    function FileName: FileStr; virtual;π    function FileExt: ExtStr; virtual;π    function FullName: PathStr; virtual;π    function FileTime: Longint; virtual;π    function FileAttr: AttrType; virtual;π    function FileSize: Longint; virtual;π    function IsDirectory: Boolean;π    constructor Load(var S: Stream);π    procedure Store(var S: Stream); virtual;π    end;ππ  FileEntryPtr = ^FileEntry;π  FileEntry = object(BaseEntry)π    constructor Init;π    destructor Done; virtual;π    procedure ForceExt(E:ExtStr);π    procedure ChangeName(P:PathStr); virtual;π     (* Change the name in memory *)π    procedure ChangePath(P:PathStr); virtual;π    procedure ChangeTime(T:Longint); virtual;π    procedure ChangeAttr(A:AttrType); virtual;π    procedure Erase; virtual;π    function Rename(NewName:PathStr): Boolean; virtual;π     (* Physically rename file on disk, returns False if Rename fails *)π    function ResetTime: Boolean;π    function ResetAttr: Boolean;π    function SetTime(T:Longint): Boolean; virtual;π    function SetAttr(A:AttrType): Boolean; virtual;π    constructor Load(var S: Stream);π    procedure Store(var S: Stream); virtual;π    end;ππ  DirEntryPtr = ^DirEntry;π  DirEntry = object(FileEntry)π    DirEntries: List;π    constructor Init;π    constructor Clear;π    destructor Done; virtual;π    procedure FindFiles(FileSpec: FileStr; Attrib: AttrType);π    procedure FindDirectories(FileSpec: FileStr; Attrib: AttrType);π    constructor Load(var S: Stream);π    procedure Store(var S: Stream); virtual;π    end;ππ  DirStream = object(DosStream)π    procedure RegisterTypes; virtual;π    end;ππfunction ExtensionPos(FName : PathStr): Word;πfunction CurDir: PathStr;πfunction ReadString(var S: Stream): String;πprocedure WriteString(var S: Stream; Str: String);ππ(*------------------------------------------------------------------------*)ππIMPLEMENTATIONππ  (*--------------------------------------------------------------------*)π  (* Methods for BaseEntry                                               *)π  (*--------------------------------------------------------------------*)ππ  constructor BaseEntry.Init;π    beginπ    end;ππ  destructor BaseEntry.Done;π    beginπ    end;ππ  procedure BaseEntry.ConvertRec;π    beginπ    Name := S.Name;π    Size := S.Size;π    Time := S.Time;π    Attr := S.Attr;π    end;ππ  function BaseEntry.FileName;π    beginπ    FileName := Name;π    end;ππ  function BaseEntry.FullName;π    beginπ    FullName := Name;π    end;ππ  function BaseEntry.FileExt;π    varπ      ep: word;π    beginπ    ep := ExtensionPos(Name);π    if ep > 0 thenπ      FileExt := Copy(Name, Succ(ep), 3)π    elseπ      FileExt[0] := #0;π  end;πππ  function BaseEntry.FileAttr;π    beginπ    FileAttr := Attr;π    end;ππ  function BaseEntry.FileSize;π    beginπ    FileSize := Size;π    end;ππ  function BaseEntry.FileTime;π    beginπ    FileTime := Time;π    end;ππ  function BaseEntry.IsDirectory;π    beginπ    IsDirectory := (FileAttr and Dos.Directory) = Dos.Directory;π    end;ππ  constructor BaseEntry.Load;π    beginπ    S.Read(Attr,SizeOf(Attr));π    S.Read(Time,SizeOf(Time));π    S.Read(Size,SizeOf(Size));π    Name := ReadString(S);π    end;ππ  procedure BaseEntry.Store;π    beginπ    S.Write(Attr,SizeOf(Attr));π    S.Write(Time,SizeOf(Time));π    S.Write(Size,SizeOf(Size));π    WriteString(S,Name);π    end;ππ  (*--------------------------------------------------------------------*)π  (* Methods for FileEntry                                              *)π  (*--------------------------------------------------------------------*)ππ  constructor FileEntry.Init;π    beginπ    BaseEntry.Init; (* Call ancestor's Init *)π    Name := '';π    Size := 0;π    Time := $210000; (* Jan. 1 1980, 12:00a *)π    Attr := $00;  (* ReadOnly  = $01;π                     Hidden    = $02;π                     SysFile   = $04;π                     VolumeID  = $08;π                     Directory = $10;π                     Archive   = $20;π                     AnyFile   = $3F; *)π    end;ππ  destructor FileEntry.Done;π    beginπ    BaseEntry.Done;π    end;ππ  function FileEntry.Rename;π    varπ      F: File;π    beginπ    Assign(F,FullName);π    System.Rename(F,NewName); (* Explicit call to 'System.Rename' avoidπ                                 calling method 'FileEntry.Rename' *)π    if IOResult = 0 thenπ      beginπ      ChangePath(NewName);π      Rename := True;π      endπ    elseπ      Rename := False;π    end;ππ  procedure FileEntry.ForceExt;π    varπ      ep: Word;π      TempBool: Boolean;π    beginπ    ep := ExtensionPos(FullName);π    if ep > 0 thenπ      TempBool := Rename(Concat(Copy(FullName, 1, ep),FileExt))π    elseπ      TempBool := Rename(Concat(FullName,'.',FileExt));π    end;ππ  procedure FileEntry.ChangeName;π    beginπ    Name := P;π    end;ππ  procedure FileEntry.ChangePath;π    beginπ    Name := P;  (* FileEntry object does not handle path *)π    end;ππ  procedure FileEntry.ChangeTime;π    beginπ    Time := T;π    end;ππ  procedure FileEntry.ChangeAttr;π    beginπ    Attr := A;π    end;ππ  procedure FileEntry.Erase;π    varπ      F:File;π    beginπ    Assign(F,FullName);π    Reset(F);π    System.Erase(F); (* Remove ambiguity about 'Erase' call *)π    Close(F);π    end;ππ  function FileEntry.ResetTime;π    varπ      F:File;π    beginπ    Assign(F,FullName);π    Reset(F);π    SetFTime(F,FileTime);π    ResetTime := IOResult = 0;π    Close(F);π    end;ππ  function FileEntry.SetTime;π    varπ      F:File;π    beginπ    Assign(F,FullName);π    Reset(F);π    SetFTime(F,T);π    SetTime := IOResult = 0;π    Close(F);π    end;ππ  function FileEntry.ResetAttr;π    varπ      F:File;π    beginπ    Assign(F,FullName);π    SetFAttr(F,FileAttr);π    ResetAttr := IOResult = 0;π    end;ππ  function FileEntry.SetAttr;π    varπ      F:File;π    beginπ    ChangeAttr(A);π    SetAttr := ResetAttr;π    end;ππ  constructor FileEntry.Load;π    beginπ    BaseEntry.Load(S);π    end;ππ  procedure FileEntry.Store;π    beginπ    BaseEntry.Store(S);π    end;ππ  (*--------------------------------------------------------------------*)π  (* Methods for DirEntry                                               *)π  (*--------------------------------------------------------------------*)ππ  constructor DirEntry.Init;π    varπ      TempNode: Node;π    beginπ    FileEntry.Init;π    DirEntries.Delete;π    end;ππ  destructor DirEntry.Done;π    beginπ    DirEntries.Delete;π    FileEntry.Done;π    end;ππ  constructor DirEntry.Clear;π    beginπ    DirEntries.Clear;π    Init;π    end;ππ  procedure DirEntry.FindFiles;π    varπ      DirInfo: SearchRec;π      TempFile: FileEntryPtr;π    beginπ    FindFirst(FileSpec,Attrib,DirInfo);π    while (DosError = 0) doπ      beginπ      TempFile := New(FileEntryPtr,Init);π      TempFile^.ConvertRec(DirInfo);π      DirEntries.Append(TempFile);π      FindNext(DirInfo);π      end;π    end;ππ  procedure DirEntry.FindDirectories;π    varπ      DirInfo: SearchRec;π      TempDir: DirEntryPtr;π    beginππ    if FileSpec <> '' thenπ      FindFiles(FileSpec,Attrib and not Dos.Directory);ππ    FindFirst('*.*',Dos.Directory,DirInfo);π    while (DosError = 0) doπ      beginπ      if (DirInfo.Name[1] <> '.') andπ         ((DirInfo.Attr and Dos.Directory) = Dos.Directory) thenπ         { if first character is '.' then name is either '.' or '..' }π        beginπ        TempDir := New(DirEntryPtr,Clear);π        TempDir^.ConvertRec(DirInfo);π        DirEntries.Append(TempDir);π        end;π      FindNext(DirInfo);π      end;ππ    TempDir := DirEntryPtr(DirEntries.First);π    while TempDir <> nil doπ      beginπ      if TempDir^.IsDirectory thenπ        beginπ        ChDir(TempDir^.FileName);π        TempDir^.FindDirectories(FileSpec,Attrib);π        ChDir('..');π        end;π      TempDir := DirEntryPtr(DirEntries.Next(TempDir));π      end;π    end;ππ  constructor DirEntry.Load;π    beginπ    FileEntry.Load(S);π    DirEntries.Load(S);π    end;ππ  procedure DirEntry.Store;π    beginπ    FileEntry.Store(S);π    DirEntries.Store(S);π    end;ππ  (*--------------------------------------------------------------------*)π  (* Methods for DirStream                                               *)π  (*--------------------------------------------------------------------*)ππ  procedure DirStream.RegisterTypes;π    beginπ    DosStream.RegisterTypes;π    Register(TypeOf(BaseEntry),@BaseEntry.Store,@BaseEntry.Load);π    Register(TypeOf(FileEntry),@FileEntry.Store,@FileEntry.Load);π    Register(TypeOf(DirEntry),@DirEntry.Store,@DirEntry.Load);π    end;ππ(*---------------------------------------------------------------------*)π(*  Miscellaneous Unit procedures and functions                        *)π(*---------------------------------------------------------------------*)ππfunction ExtensionPos;π  varπ    Index: Word;π  beginπ  Index := Length(FName)+1;π  repeatπ    dec(Index);π    until (FName[Index] = '.') OR (Index = 0);π  IF (Pos('\', Copy(FName, Succ(Index), SizeOf(FName))) <> 0) THEN Index := 0;π  ExtensionPos := Index;π  end;ππfunction CurDir;π  varπ    P: PathStr;π  beginπ  GetDir(0,P); { 0 = Current drive }π  CurDir := P;π  end;ππfunction ReadString;π  varπ    T: String;π    L: Byte;ππ  beginπ  S.Read(L, 1);π  T[0] := Chr(L);π  S.Read(T[1], L);π  IF S.Status = 0 thenπ    ReadString := Tπ  elseπ    ReadString := '';π  end;ππprocedure WriteString;π  beginπ  S.Write(Str, Length(Str) + 1);π  end;ππ(* No initialization code *)πend.ππ{===============================    DEMO ============================ }ππprogram PDTest;ππuses Objects,PDir,Dos;ππvarπ  DP: DirEntryPtr;π  St: DirStream;π  Orig: PathStr;ππprocedure ProcessDir(D: DirEntryPtr; DirName: PathStr);π  varπ    DirPtr : DirEntryPtr;π  beginπ  DirPtr := DirEntryPtr(D^.DirEntries.First);π  while DirPtr <> nil doπ    beginπ    if DirPtr^.IsDirectory thenπ      ProcessDir(DirPtr,DirName+'\'+DirPtr^.FileName)π      {recursively process subdirectories}π    elseπ      WriteLn(DirName+'\'+DirPtr^.FileName);π    DirPtr := DirEntryPtr(D^.DirEntries.Next(DirPtr));π    end;π  end;ππππbeginπOrig := CurDir;πWriteLn('Palcic''s File Finder v1.0');ππif ParamCount = 0 then { Syntax is incorrect }π  beginπ  WriteLn;π  WriteLn('Syntax: PFF filespec');π  WriteLn;π  WriteLn('Directory names can not be passed.');π  WriteLn;π  WriteLn('Example: PFF *.ZIP');π  WriteLn;π  Halt;π  end;ππChDir('C:\');πNew(DP,Clear);ππWriteLn;πWrite('Scanning for ',ParamStr(1),'...');πDP^.FindDirectories(ParamStr(1),Archive);πWriteLn;πWriteLn;ππProcessDir(DP,'C:');ππWriteLn;πWriteLn('Back to original directory ',Orig);πChDir(Orig);ππSt.Init('PFF.DAT',SCreate);πDP^.Store(St);πSt.Done;ππDispose(DP,Done);ππend.π                                                                                                                             28     02-15-9408:41ALL                      SWAG SUPPORT TEAM        DOS Search Engine        IMPORT              40     ª╢k UNIT Engine;ππ{$V-}ππ(**************************************************************************)π(* SEARCH ENGINE                                                          *)π(*        Input Parameters:                                               *)π(*              Mask  : The file specification to search for              *)π(*                      May contain wildcards                             *)π(*              Attr  : File attribute to search for                      *)π(*              Proc  : Procedure to process each found file              *)π(*                                                                        *)π(*        Output Parameters:                                              *)π(*              ErrorCode  : Contains the final error code.               *)π(**************************************************************************)ππ(************************)π(**)   INTERFACE      (**)π(************************)ππUSES DOS;ππTYPEπ    ProcType     = PROCEDURE (VAR S : SearchRec; P : PathStr);π    FullNameStr  = STRING[12];ππ    PROCEDURE SearchEngine(Mask : PathStr; Attr : Byte; Proc : ProcType; VAR ErrorCode : Byte);ππ    FUNCTION GoodDirectory(S : SearchRec) : Boolean;π    PROCEDURE ShrinkPath(VAR path   : PathStr);π    PROCEDURE ErrorMessage(ErrCode  : Byte);π    PROCEDURE SearchEngineAll(path  : PathStr; Mask : FullNameStr; Attr : Byte; Proc : ProcType; VAR ErrorCode : Byte);ππ    (************************)π    (**) IMPLEMENTATION   (**)π    (************************)ππVARπ    EngineMask : FullNameStr;π    EngineAttr : Byte;π    EngineProc : ProcType;π    EngineCode : Byte;ππ    PROCEDURE SearchEngine(Mask : PathStr; Attr : Byte; Proc : ProcType; VAR ErrorCode : Byte);ππ    VARπ       S : SearchRec;π       P : PathStr;π       Ext : ExtStr;ππ    BEGINπ       FSplit(Mask, P, Mask, Ext);π       Mask := Mask + Ext;π       FindFirst(P + Mask, Attr, S);π       IF DosError <> 0 THENπ          BEGINπ               ErrorCode := DosError;π               Exit;π          END;ππ    WHILE DosError = 0 DOπ          BEGINπ               Proc(S, P);π               FindNext(S);π          END;π    IF DosError = 18 THEN ErrorCode := 0π    ELSE ErrorCode := DosError;πEND;ππFUNCTION GoodDirectory(S : SearchRec) : Boolean;πBEGINπ    GoodDirectory := (S.name <> '.') AND (S.name <> '..') AND (S.Attr AND Directory = Directory);πEND;ππPROCEDURE ShrinkPath(VAR path : PathStr);πVAR P : Byte;π    Dummy : NameStr;πBEGINπ    FSplit(path, path, Dummy, Dummy);π    Dec(path[0]);πEND;ππ{$F+} PROCEDURE SearchOneDir(VAR S : SearchRec; P : PathStr); {$F-}π      {Recursive procedure to search one directory}πBEGINπ    IF GoodDirectory(S) THENπ       BEGINπ            P := P + S.name;π            SearchEngine(P + '\' + EngineMask, EngineAttr, EngineProc, EngineCode);π            SearchEngine(P + '\*.*',Directory OR Archive, SearchOneDir, EngineCode);π       END;πEND;ππPROCEDURE SearchEngineAll(path : PathStr; Mask : FullNameStr; Attr : Byte; Proc : ProcType; VAR ErrorCode : Byte);ππBEGINπ    (* Set up Unit global variables for use in recursive directory search procedure *)π    EngineMask := Mask;π    EngineProc := Proc;π    EngineAttr := Attr;π    SearchEngine(path + Mask, Attr, Proc, ErrorCode);π    SearchEngine(path + '*.*', Directory OR Attr, SearchOneDir, ErrorCode);π    ErrorCode := EngineCode;πEND;ππPROCEDURE ErrorMessage(ErrCode : Byte);πBEGINπ    CASE ErrCode OFπ         0 : ;                              {OK -- no error}π         2 : WriteLn('File not found');π         3 : WriteLn('Path not found');π         5 : WriteLn('Access denied');π         6 : WriteLn('Invalid handle');π         8 : WriteLn('Not enough memory');π         10 : WriteLn('Invalid environment');π         11 : WriteLn('Invalid format');π         18 : ;                    {OK -- merely no more files}π    ELSE WriteLN('ERROR #', ErrCode);π    END;πEND;πππEND.πππ{ ===============================   DEMO     ==============================}ππ{$R-,S+,I+,D+,F-,V-,B-,N-,L+ }π{$M 2048,0,0 }πPROGRAM DirSum;π        (*******************************************************)π        (* Uses SearchEngine to write the names of all files   *)π        (* in the current directory and display the total disk *)π        (* space that they occupy.                             *)π        (*******************************************************)πUSES DOS,ENGINE;ππVARπ   Template  : PathStr;π   ErrorCode : Byte;π   Total     : LongInt;ππ{$F+} PROCEDURE WriteIt(VAR S : SearchRec; P : PathStr);  {$F-}πBEGIN   WriteLn(S.name); Total := Total + S.Size END;ππBEGINπ     Total := 0;π     GetDir(0, Template);π     IF Length(Template) = 3 THEN Dec(Template[0]);π     {^Avoid ending up with "C:\\*.*"!}π     Template := Template + '\*.*';π     SearchEngine(Template, AnyFile, WriteIt, ErrorCode);π     IF ErrorCode <> 0 THEN ErrorMessage(ErrorCode) ELSEπ        WriteLn('Total size of displayed files: ', Total : 8);πEND.π                                                           29     02-22-9411:40ALL                      SWAG SUPPORT TEAM        Directory Select FunctionIMPORT              116    ª╢ûY Program DIRSEL;πUsesπ   Crt,Dos;  { ** needed for DIRSELECT functions ** }ππ{ ** The following Type & Var declarations are for the main program only  ** }π{ ** However, the string length of the returned parameter from DIRSELECT  ** }π{ ** must be a least 12 characters.                                       ** }ππTypeπ   strtype = String[12];πVarπ   spec,fname : strtype;ππ{ ************************************************************************** }π{ ** List of Procedures/Functions needed for DIRSELECT                    ** }π{ ** Procedure CURSOR     - turns cursor on or off                        ** }π{ ** Procedure FRAME      - draws single or double frame                  ** }π{ ** Function ISCOLOR     - returns the current video mode                ** }π{ ** Procedure SAVESCR    - saves current video screen                    ** }π{ ** Procedure RESTORESCR - restores old video screen                     ** }π{ ** Procedure SCRGET     - get character/attribute                       ** }π{ ** Procedure SCRPUT     - put character/attribute                       ** }π{ ** Procedure FNAMEPOS   - finds proper screen position                  ** }π{ ** Procedure HILITE     - highlights proper name                        ** }π{ ** Function DIRSELECT   - directory selector                            ** }π{ ************************************************************************** }ππProcedure CURSOR( attrib : Boolean );πVarπ   regs : Registers;πBeginπ   If NOT attrib Then { turn cursor off }π   Beginπ      regs.ah := 1;π      regs.cl := 7;π      regs.ch := 32;π      Intr($10,regs)π   Endπ   Else { turn cursor on }π   Beginπ      Intr($11,regs);π      regs.cx := $0607;π      If regs.al AND $10 <> 0 Then regs.cx := $0B0C;π      regs.ah := 1;π      Intr($10,regs)π   EndπEnd;ππProcedure FRAME(t,l,b,r,ftype : Integer);πVarπ   i : Integer;πBeginπ   GoToXY(l,t);π   If ftype = 2 Thenπ      Write(Chr(201))π   Elseπ      Write(Chr(218));π   GoToXY(r,t);π   If ftype = 2 Thenπ      Write(Chr(187))π   Elseπ      Write(Chr(191));π   GoToXY(l+1,t);π   For i := 1 To (r - (l + 1)) Doπ      If ftype = 2 Thenπ         Write(Chr(205))π      Elseπ         Write(Chr(196));π   GoToXY(l+1,b);π   For i := 1 To (r - (l + 1)) Doπ      If ftype = 2 Thenπ         Write(Chr(205))π      Elseπ         Write(Chr(196));π   GoToXY(l,b);π   If ftype = 2 Thenπ      Write(Chr(200))π   Elseπ      Write(Chr(192));π   GoToXY(r,b);π   If ftype = 2 Thenπ      Write(Chr(188))π   Elseπ      Write(Chr(217));π   For i := (t+1) To (b-1) Doπ   Beginπ      GoToXY(l,i);π      If ftype = 2 Thenπ         Write(Chr(186))π      Elseπ         Write(Chr(179))π   End;π   For i := (t+1) To (b-1) Doπ   Beginπ      GoToXY(r,i);π      If ftype = 2 Thenπ         Write(Chr(186))π      Elseπ         Write(Chr(179))π   EndπEnd;ππFunction ISCOLOR : Boolean;  { returns FALSE for MONO or TRUE for COLOR }πVarπ   regs       : Registers;π   video_mode : Integer;π   equ_lo     : Byte;πBeginπ   Intr($11,regs);π   video_mode := regs.al and $30;π   video_mode := video_mode shr 4;π   Case video_mode ofπ      1 : ISCOLOR := FALSE;  { Monochrome }π      2 : ISCOLOR := TRUE    { Color }π   EndπEnd;ππProcedure SAVESCR( Var screen );πVarπ   vidc : Byte Absolute $B800:0000;π   vidm : Byte Absolute $B000:0000;πBeginπ   If NOT ISCOLOR Then  { if MONO }π      Move(vidm,screen,4000)π   Else                 { else COLOR }π      Move(vidc,screen,4000)πEnd;ππProcedure RESTORESCR( Var screen );πVarπ   vidc : Byte Absolute $B800:0000;π   vidm : Byte Absolute $B000:0000;πBeginπ   If NOT ISCOLOR Then  { if MONO }π      Move(screen,vidm,4000)π   Else                 { else COLOR }π      Move(screen,vidc,4000)πEnd;ππProcedure SCRGET( Var ch,attr : Byte );πVarπ   regs : Registers;πBeginπ   regs.bh := 0;π   regs.ah := 8;π   Intr($10,regs);π   ch := regs.al;π   attr := regs.ahπEnd;ππProcedure SCRPUT( ch,attr : Byte );πVarπ   regs : Registers;πBeginπ   regs.al := ch;π   regs.bl := attr;π   regs.ch := 0;π   regs.cl := 1;π   regs.bh := 0;π   regs.ah := 9;π   Intr($10,regs);πEnd;ππProcedure FNAMEPOS(Var arypos,x,y : Integer);π{ determine position on screen of filename }πConstπ   FPOS1 =  2;π   FPOS2 = 15;π   FPOS3 = 28;π   FPOS4 = 41;π   FPOS5 = 54;π   FPOS6 = 67;πBeginπ   Case arypos ofπ        1: Begin x := FPOS1; y :=  2 End;π        2: Begin x := FPOS2; y :=  2 End;π        3: Begin x := FPOS3; y :=  2 End;π        4: Begin x := FPOS4; y :=  2 End;π        5: Begin x := FPOS5; y :=  2 End;π        6: Begin x := FPOS6; y :=  2 End;π        7: Begin x := FPOS1; y :=  3 End;π        8: Begin x := FPOS2; y :=  3 End;π        9: Begin x := FPOS3; y :=  3 End;π       10: Begin x := FPOS4; y :=  3 End;π       11: Begin x := FPOS5; y :=  3 End;π       12: Begin x := FPOS6; y :=  3 End;π       13: Begin x := FPOS1; y :=  4 End;π       14: Begin x := FPOS2; y :=  4 End;π       15: Begin x := FPOS3; y :=  4 End;π       16: Begin x := FPOS4; y :=  4 End;π       17: Begin x := FPOS5; y :=  4 End;π       18: Begin x := FPOS6; y :=  4 End;π       19: Begin x := FPOS1; y :=  5 End;π       20: Begin x := FPOS2; y :=  5 End;π       21: Begin x := FPOS3; y :=  5 End;π       22: Begin x := FPOS4; y :=  5 End;π       23: Begin x := FPOS5; y :=  5 End;π       24: Begin x := FPOS6; y :=  5 End;π       25: Begin x := FPOS1; y :=  6 End;π       26: Begin x := FPOS2; y :=  6 End;π       27: Begin x := FPOS3; y :=  6 End;π       28: Begin x := FPOS4; y :=  6 End;π       29: Begin x := FPOS5; y :=  6 End;π       30: Begin x := FPOS6; y :=  6 End;π       31: Begin x := FPOS1; y :=  7 End;π       32: Begin x := FPOS2; y :=  7 End;π       33: Begin x := FPOS3; y :=  7 End;π       34: Begin x := FPOS4; y :=  7 End;π       35: Begin x := FPOS5; y :=  7 End;π       36: Begin x := FPOS6; y :=  7 End;π       37: Begin x := FPOS1; y :=  8 End;π       38: Begin x := FPOS2; y :=  8 End;π       39: Begin x := FPOS3; y :=  8 End;π       40: Begin x := FPOS4; y :=  8 End;π       41: Begin x := FPOS5; y :=  8 End;π       42: Begin x := FPOS6; y :=  8 End;π       43: Begin x := FPOS1; y :=  9 End;π       44: Begin x := FPOS2; y :=  9 End;π       45: Begin x := FPOS3; y :=  9 End;π       46: Begin x := FPOS4; y :=  9 End;π       47: Begin x := FPOS5; y :=  9 End;π       48: Begin x := FPOS6; y :=  9 End;π       49: Begin x := FPOS1; y := 10 End;π       50: Begin x := FPOS2; y := 10 End;π       51: Begin x := FPOS3; y := 10 End;π       52: Begin x := FPOS4; y := 10 End;π       53: Begin x := FPOS5; y := 10 End;π       54: Begin x := FPOS6; y := 10 End;π       55: Begin x := FPOS1; y := 11 End;π       56: Begin x := FPOS2; y := 11 End;π       57: Begin x := FPOS3; y := 11 End;π       58: Begin x := FPOS4; y := 11 End;π       59: Begin x := FPOS5; y := 11 End;π       60: Begin x := FPOS6; y := 11 End;π       61: Begin x := FPOS1; y := 12 End;π       62: Begin x := FPOS2; y := 12 End;π       63: Begin x := FPOS3; y := 12 End;π       64: Begin x := FPOS4; y := 12 End;π       65: Begin x := FPOS5; y := 12 End;π       66: Begin x := FPOS6; y := 12 End;π       67: Begin x := FPOS1; y := 13 End;π       68: Begin x := FPOS2; y := 13 End;π       69: Begin x := FPOS3; y := 13 End;π       70: Begin x := FPOS4; y := 13 End;π       71: Begin x := FPOS5; y := 13 End;π       72: Begin x := FPOS6; y := 13 End;π       73: Begin x := FPOS1; y := 14 End;π       74: Begin x := FPOS2; y := 14 End;π       75: Begin x := FPOS3; y := 14 End;π       76: Begin x := FPOS4; y := 14 End;π       77: Begin x := FPOS5; y := 14 End;π       78: Begin x := FPOS6; y := 14 End;π       79: Begin x := FPOS1; y := 15 End;π       80: Begin x := FPOS2; y := 15 End;π       81: Begin x := FPOS3; y := 15 End;π       82: Begin x := FPOS4; y := 15 End;π       83: Begin x := FPOS5; y := 15 End;π       84: Begin x := FPOS6; y := 15 End;π       85: Begin x := FPOS1; y := 16 End;π       86: Begin x := FPOS2; y := 16 End;π       87: Begin x := FPOS3; y := 16 End;π       88: Begin x := FPOS4; y := 16 End;π       89: Begin x := FPOS5; y := 16 End;π       90: Begin x := FPOS6; y := 16 End;π       91: Begin x := FPOS1; y := 17 End;π       92: Begin x := FPOS2; y := 17 End;π       93: Begin x := FPOS3; y := 17 End;π       94: Begin x := FPOS4; y := 17 End;π       95: Begin x := FPOS5; y := 17 End;π       96: Begin x := FPOS6; y := 17 End;π       97: Begin x := FPOS1; y := 18 End;π       98: Begin x := FPOS2; y := 18 End;π       99: Begin x := FPOS3; y := 18 End;π      100: Begin x := FPOS4; y := 18 End;π      101: Begin x := FPOS5; y := 18 End;π      102: Begin x := FPOS6; y := 18 End;π      103: Begin x := FPOS1; y := 19 End;π      104: Begin x := FPOS2; y := 19 End;π      105: Begin x := FPOS3; y := 19 End;π      106: Begin x := FPOS4; y := 19 End;π      107: Begin x := FPOS5; y := 19 End;π      108: Begin x := FPOS6; y := 19 End;π      109: Begin x := FPOS1; y := 20 End;π      110: Begin x := FPOS2; y := 20 End;π      111: Begin x := FPOS3; y := 20 End;π      112: Begin x := FPOS4; y := 20 End;π      113: Begin x := FPOS5; y := 20 End;π      114: Begin x := FPOS6; y := 20 End;π      115: Begin x := FPOS1; y := 21 End;π      116: Begin x := FPOS2; y := 21 End;π      117: Begin x := FPOS3; y := 21 End;π      118: Begin x := FPOS4; y := 21 End;π      119: Begin x := FPOS5; y := 21 End;π      120: Begin x := FPOS6; y := 21 Endπ      Elseπ      Beginπ         x := 0;π         y := 0;π      Endπ   EndπEnd;ππProcedure HILITE(old,new : Integer);  { highlight a filename on the screen }πVarπ   i,oldx,oldy,newx,newy : Integer;π   ccolor,locolor,hicolor,cchar : Byte;πBeginπ   FNAMEPOS(old,oldx,oldy); { get position in the array of the filename }π   FNAMEPOS(new,newx,newy); { get position in the array of the filename }π   For i := 0 To 11 Doπ   Beginπ      If old < 121 Then  { if valid position, reverse video, old selection }π      Beginπ         GoToXY((oldx + i),oldy);π         SCRGET(cchar,ccolor);π         locolor := ccolor AND $0F;π         locolor := locolor shl 4;π         hicolor := ccolor AND $F0;π         hicolor := hicolor shr 4;π         ccolor  := locolor + hicolor;π         SCRPUT(cchar,ccolor)π      End;π      GoToXY((newx + i),newy);         { reverse video, new selection }π      SCRGET(cchar,ccolor);π      locolor := ccolor AND $0F;π      locolor := locolor shl 4;π      hicolor := ccolor AND $F0;π      hicolor := hicolor shr 4;π      ccolor  := locolor + hicolor;π      SCRPUT(cchar,ccolor)π   EndπEnd;ππFunction DIRSELECT(mask : strtype; attr : Integer) : strtype;πConstπ   OFF   = FALSE;π   ON    = TRUE;πVarπ   i,oldcurx,oldcury,π   newcurx,newcury,π   oldpos,newpos,π   scrrows,fncnt        : Integer;π   ch                   : Char;π   dos_dir              : Array[1..120] of String[12];π   fileinfo             : SearchRec;π   screen               : Array[1..4000] of Byte;πBeginπ   fncnt := 0;π   FindFirst(mask,attr,fileinfo);π   If DosError <> 0 Then   { if not found, return NULL }π   Beginπ      DIRSELECT := '';π      Exitπ   End;π   While (DosError = 0) AND (fncnt <> 120) Do   { else, collect filenames }π   Beginπ      Inc(fncnt);π      dos_dir[fncnt] := fileinfo.Name;π      FindNext(fileinfo)π   End;π   oldcurx := WhereX;     { store old CURSOR position }π   oldcury := WhereY;π   SAVESCR(screen);π   CURSOR(OFF);π   scrrows := (fncnt DIV 6) + 3;π   Window(1,1,80,scrrows + 1);π   ClrScr;π   GoToXY(1,1);π   i := 1;π   While (i <= fncnt) AND (i <= 120) Do     { display all filenames }π   Beginπ      FNAMEPOS(i,newcurx,newcury);π      GoToXY(newcurx,newcury);π      Write(dos_dir[i]);π      Inc(i)π   End;π   FRAME(1,1,scrrows,80,1);  { draw the frame }π   HILITE(255,1);            { highlight the first filename }π   oldpos := 1;π   newpos := 1;π   While TRUE Do             { get keypress and do appropriate action }π   Beginπ      ch := ReadKey;π      Case ch ofπ         #27:  { Esc  }π         Beginπ            Window(1,1,80,25);π            RESTORESCR(screen);π            GoToXY(oldcurx,oldcury);π            CURSOR(ON);π            DIRSELECT := '';π            Exit                       { return NULL }π         End;π         #71:  { Home }                { goto first filename }π         Beginπ            oldpos := newpos;π            newpos := 1;π            HILITE(oldpos,newpos)π         End;π         #79:  { End  }                { goto last filename }π         Beginπ            oldpos := newpos;π            newpos := fncnt;π            HILITE(oldpos,newpos)π         End;π         #72:  { Up   }                { move up one filename }π         Beginπ            i := newpos;π            i := i - 6;π            If i >= 1 Thenπ            Beginπ               oldpos := newpos;π               newpos := i;π               HILITE(oldpos,newpos)π            Endπ         End;π         #80:  { Down }                { move down one filename }π         Beginπ            i := newpos;π            i := i + 6;π            If i <= fncnt Thenπ            Beginπ               oldpos := newpos;π               newpos := i;π               HILITE(oldpos,newpos)π            Endπ         End;π         #75:  { Left }                { move left one filename }π         Beginπ            i := newpos;π            Dec(i);π            If i >= 1 Thenπ            Beginπ               oldpos := newpos;π               newpos := i;π               HILITE(oldpos,newpos)π            Endπ         End;π         #77:  { Right }               { move right one filename }π         Beginπ            i := newpos;π            Inc(i);π            If i <= fncnt Thenπ            Beginπ               oldpos := newpos;π               newpos := i;π               HILITE(oldpos,newpos)π            Endπ         End;π         #13:  { CR }π         Beginπ            Window(1,1,80,25);π            RESTORESCR(screen);π            GoToXY(oldcurx,oldcury);    { return old CURSOR position }π            CURSOR(ON);π            DIRSELECT := dos_dir[newpos];π            Exit                        { return with filename }π         Endπ      Endπ   EndπEnd;ππ{ ************************************************************************** }π{ ** Main Program : NOTE that the following is a demo program only.       ** }π{ **                It is not needed to use the DIRSELECT function.       ** }π{ ************************************************************************** }ππBeginπ   While TRUE Doπ   Beginπ      Writeln;π      Write('Enter a filespec => ');π      Readln(spec);π      fname := DIRSELECT(spec,0);π      If Length(fname) = 0 Thenπ      Beginπ         Writeln('Filespec not found.');π         Haltπ      End;π      Writeln('The file you have chosen is ',fname,'.')π   EndπEnd.ππ{ ** EOF( DIRSEL.PAS )  ** }π                                                                                              30     05-25-9408:09ALL                      LARRY HADLEY             Directory Object         SWAG9405            97     ª╢Ç {π  Next in this continuing series of code: the actual directryπ  object.π}ππUnit Dirs;π{π  A directory management object from a concept originally by Allanπ  Holub, as discussed in Byte Dec/93 (Vol 18, No 13, page 213)ππ  Turbo Pascal code by Larry Hadley, tested using BP7.π}πINTERFACEππUses Sort, DOS;ππTYPEπ   pSortSR = ^oSortSR;π   oSortSR = OBJECT(oSortTree)π      procedure   DeleteNode(var Node); virtual;π   end;ππ   callbackproc = procedure(name :string; lev :integer);ππ   prec  = ^searchrec;ππ   pentry = ^entry;π   entry  = recordπ      fil          :prec;π      next, last   :pentry;π   end;ππ   pdir  = ^dir;π   dir   = recordπ      flist  :pentry;π      count  :word;π      path   :string[80];π   end;ππ   pDirectry = ^Directry;π   Directry  = OBJECTπ      dirroot   :pdir;ππ      constructor Init(path, filespec :string; attribute :byte);π      destructor  Done;ππ      procedure   Load(path, filespec :string; attribute :byte);π      procedure   Sort;π      procedure   Print;π   END;ππCONSTπ   NotDir  = ReadOnly+Hidden+SysFile+VolumeID+Archive;π   dosattr : array[0..8] of char = '.rhsvdaxx';ππprocedure TraverseTree(root :string; pcallproc :pointer; do_depth :boolean);ππIMPLEMENTATIONππvarπ   treeroot :pSortSR; { sorting tree object }ππprocedure disposelist(ls :pentry);πvarπ   lso :pentry;πbeginπ   while ls<>NIL doπ   beginπ      dispose(ls^.fil);π      lso := ls;π      ls := ls^.next;π      dispose(lso);π   end;πend;ππ{ Define oSortSR.DeleteNode method so object knows how to dispose ofπ  individual data pointers in the event that "Done" is called beforeπ  tree is empty. }πprocedure   oSortSR.DeleteNode(var Node);πvarπ   pNode :pRec ABSOLUTE Node;πbeginπ   dispose(pNode);πend;ππconstructor Directry.Init(path, filespec :string; attribute :byte);πvarπ   pathspec :string;π   node     :pentry;π   i        :word;πBEGINπ   FillChar(Self, SizeOf(Self), #0);π   Load(path, filespec, attribute); { scan specified directory }π   if dirroot^.count=0 then         { if no files were found, abort }π   beginπ      if dirroot<>NIL thenπ      beginπ         disposelist(dirroot^.flist);π         dispose(dirroot);π      end;π      FAIL;π   end;π { the following code expands the pathspec to a full qualified path }π   pathspec := dirroot^.path+'\';π   node := dirroot^.flist;π   while ((node^.fil^.name='.') or (node^.fil^.name='..')) andπ         (node^.next<>NIL) doπ      node := node^.next;π   if node^.fil^.name='..' thenπ      pathspec := pathspec+'.'π   elseπ      pathspec := pathspec+node^.fil^.name;π   pathspec := FExpand(pathspec);π   i := Length(pathspec);π   repeatπ      Dec(i);π   until (i=0) or (pathspec[i]='\');π   if i>0 thenπ   beginπ      Delete(pathspec, i, Length(pathspec));π      dirroot^.path := pathspec;π   end;πEND;ππdestructor  Directry.Done;πbeginπ   if dirroot<>NIL thenπ   beginπ      disposelist(dirroot^.flist);π      dispose(dirroot);π   end;πend;ππprocedure   Directry.Load(path, filespec :string; attribute :byte);π{ scan a specified directory with a specified wildcard and attributeπ  byte }πvarπ   count   : word;π   pstr    : pathstr;π   dstr    : dirstr;π   srec    : SearchRec;π   dirx    : pdir;π   firstfl, thisfl, lastfl  : pentry;πbeginπ   count := 0;π   New(firstfl);π   with firstfl^ doπ   beginπ      next := NIL; last := NIL; New(fil);π   end;π   thisfl := firstfl; lastfl := firstfl;π   dstr  := path;π   if path = '' then dstr := '.';π   if dstr[Length(dstr)]<>'\' then dstr := dstr+'\';π   if filespec = '' then filespec := '*.*';π   pstr := dstr+filespec;ππ   FindFirst(pstr, attribute, srec);π   while DosError=0 do { while new files are found... }π   beginπ      if srec.attr = (srec.attr and attribute) thenπ { make sure the attribute byte matches our required atttribute mask }π      beginπ         if count>0 thenπ { if this is NOT first file found, link in new node }π         beginπ            New(thisfl);π            lastfl^.next := thisfl;π            thisfl^.last := lastfl;π            thisfl^.next := NIL;π            New(thisfl^.fil);π            lastfl := thisfl;π         end;π         thisfl^.fil^ := srec;π         Inc(count);π      end;π      FindNext(srec);π   end;π { construct root node }π   New(dirx);π   with dirx^ doπ      flist := firstfl;π   dirx^.path  := path;  { path specifier for directory list }π   dirx^.count := count; { number of files in the list }ππ   if dirroot=NIL thenπ      dirroot := dirxπ   elseπ   beginπ      disposelist(dirroot^.flist);π      dispose(dirroot);π      dirroot := dirx;π   end;πend;ππ{ The following function is the far-local function needed for theπ  SORT method (which uses the sort unit posted earlier)π  Note that this is hard-coded to sort by filename, then extension.π  I plan to rewrite this later to allow user-selectable sortπ  parameters and ordering. }πfunction Comp(d1, d2 :pointer):integer; far;π   varπ      data1 :pRec ABSOLUTE d1;π      data2 :pRec ABSOLUTE d2;π      name1, name2, ext1, ext2  :string;π   beginπ { This assures that the '.' and '..' dirs will always be the firstπ   listed. }π      if (data1^.name='.') or (data1^.name='..') thenπ      beginπ         Comp := -1;π         EXIT;π      end;π      if (data2^.name='.') or (data2^.name='..') thenπ      beginπ         Comp := 1;π         EXIT;π      end;π      with data1^ doπ      beginπ         name1 := Copy(name, 1, Pos('.', name)-1);π         ext1  := Copy(name, Pos('.', name)+1, 3);π      end;π      with data2^ doπ      beginπ         name2 := Copy(name, 1, Pos('.', name)-1);π         ext2  := Copy(name, Pos('.', name)+1, 3);π      end;π      if name1=name2 thenπ { If filename portion is equal, use extension to resolve tie }π      beginπ         if ext1=ext2 thenπ { There should be NO equal filenames, but handle anyways forπ   completeness... }π            Comp := 0π         elseπ            if ext1>ext2 thenπ               Comp := 1π            elseπ               Comp := -1;π      endπ      elseπ         if name1>name2 thenπ            Comp := 1π         elseπ            Comp := -1;π   end;ππ{ Sort method uses the sort unit to sort the collected directoryπ  entries. }πprocedure   Directry.Sort;πvarπ   s1, s2 :string;π   p1     :pentry;ππ { This local procedure keeps code more readable }π   procedure UpdatePtr(var prev :pentry; NewEntry :pointer);π   beginπ      if NewEntry<>NIL then { check to see if tree is empty }π      beginπ         New(prev^.next);π         prev^.next^.fil  := NewEntry;π         prev^.next^.last := prev;π         prev := prev^.next;π         prev^.next := NIL;π      endπ      elseπ         prev := prev^.next;π       { tree is empty, flag "done" with NIL pointer }π   end;ππbeginπ   p1 := dirroot^.flist;π   New(treeroot, Init(Comp));π{ Create a sort tree, point to our COMP function }π   while p1<>NIL doπ{ Go through our linked list and insert the items into the sortingπ  tree, dispose of original nodes as we go. }π   beginπ      if p1^.last<>NIL thenπ         dispose(p1^.last);π      treeroot^.InsertNode(p1^.fil);π      if p1^.next=NIL thenπ      beginπ         dispose(p1);π         p1 := NIL;π      endπ      elseπ         p1 := p1^.next;π   end;π{ Reconstruct directory list from sorted tree }π   New(dirroot^.flist);π   with dirroot^ doπ   beginπ      flist^.next := NIL;π      flist^.last := NIL;π      flist^.fil := treeroot^.ReadLeftNode;π   end;π   if dirroot^.flist^.fil<>NIL thenπ   beginπ      p1 := dirroot^.flist;π      while p1<>NIL doπ         UpdatePtr(p1, treeroot^.ReadLeftNode);π   end;π{ We're done with sorting tree... }π   dispose(treeroot, Done);πend;ππprocedure   Directry.Print;π{ currently prints the entire list, may modify this later to allowπ  selective printing }πvarπ   s, s1 :string;π   e     :pentry;π   dt    :DateTime;π   dbg   :byte;ππ   procedure DoDateEle(var sb :string; de :word);π   beginπ      Str(de, sb);π      if Length(sb)=1 then { Add leading 0's}π         sb := '0'+sb;π   end;ππbeginπ   if dirroot=NIL then EXIT; { make sure empty dirs aren't attempted }π   e := dirroot^.flist;π   while e<>NIL doπ   beginπ      s := '';π      with e^.fil^ doπ      beginπ         dbg := 1;π         repeatπ            case dbg of { parse attribute bits }π              1: s := s+dosattr[(attr and $01)];π              2: s := s+dosattr[(attr and $02)];π              3: if (attr and $04) = $04 thenπ                    s := s+dosattr[3]π                 elseπ                    s := s+dosattr[0];π              4: if (attr and $08) = $08 thenπ                    s := s+dosattr[4]π                 elseπ                    s := s+dosattr[0];π              5: if (attr and $10) = $10 thenπ                    s := s+dosattr[5]π                 elseπ                    s := s+dosattr[0];π              6: if (attr and $20) = $20 thenπ                    s := s+dosattr[6]π                 elseπ                    s := s+dosattr[0];π              elseπ                 s := s+dosattr[0];π            end;π            Inc(dbg);π         until dbg>8;π         s := s+' ';π   { Kludge to make sure that extremely large files (>=100MB) don'tπ     overflow size field... }π         if size<100000000 thenπ            Str(size:8, s1)π         elseπ         beginπ            Str((size div 1000):7, s1); { decimal kilobytes }π            s1 := s1+'k';π         end;π         s := s+s1+' ';π   { Format date/time fields }π         UnpackTime(Time, dt);π         {month}π         DoDateEle(s1, dt.month); s := s+s1+'/';π         {day}π         DoDateEle(s1, dt.day);   s := s+s1+'/';π         {year}π         DoDateEle(s1, dt.year);  s := s+s1+' ';π         {hour}π         DoDateEle(s1, dt.hour);  s := s+s1+':';π         {minutes}π         DoDateEle(s1, dt.min);   s := s+s1+':';π         {seconds}π         DoDateEle(s1, dt.sec);   s := s+s1+' - ';π         s := s+dirroot^.path+'\'+name;π      end;π      Writeln(s); s := '';π      e := e^.next;π   end;π   Writeln; Writeln('  ', dirroot^.count, ' files found.'); Writeln;πend;ππ{ If TraverseTree is not given a callback procedure, this one isπ  used. }πprocedure   DefaultCallback(name :string; lev :integer); far;πvarπ   s :string;πconstπ   spaces = '                                               ';πbeginπ   s := Copy(spaces, 1, lev*4); s := s+name;π   Writeln(s);πend;ππ{ TraverseTree is untested as yet, rest of code (above) works fine.π  Note that TraverseTree is NOT a member method of DIRECTRY. Readπ  the BYTE Dec/93 article for a clarification of why it is goodπ  that it not be a member.}πprocedure TraverseTree(root :string; pcallproc :pointer; do_depth :boolean);πvarπ   level    :integer;π   fullpath :string;π   rootdir  :pdir;πconstπ   callproc : callbackproc = DefaultCallBack;ππ { Actual recursive procedure to scan down directory structureπ   using the DIRECTRY object. }π   procedure Tree(newroot :string; callee :callbackproc; do_last :boolean);π   varπ      subdirs  :pdirectry;π      direntry :pentry;ππ      Procedure DoDir;π      beginπ         New(subdirs, Init(newroot, '*.*', NotDir));π         if subdirs<>NIL thenπ         beginπ            subdirs^.sort;π            direntry := subdirs^.dirroot^.flist;π            while direntry<>NIL doπ            beginπ               fullpath := newroot+'\'+direntry^.fil^.name;π               callee(newroot, level);π               direntry := direntry^.next;π            end;π            dispose(subdirs, done);π         end;π      end;ππ   beginπ      if not(do_last) thenπ         DoDir;ππ      New(subdirs, Init(newroot, '*.*', directory));ππ      if subdirs<>NIL thenπ      beginπ         subdirs^.sort;π         direntry := subdirs^.dirroot^.flist;π         while direntry<>NIL doπ         beginπ            Inc(level);π            fullpath := newroot+'\'+direntry^.fil^.name;π            Tree(fullpath, callee, do_last);π            dec(level);π            direntry := direntry^.next;π         end;π         dispose(subdirs, done);π      end;ππ      if do_last thenπ         DoDir;π   end;ππbeginπ   level := 0;ππ   if pcallproc<>NIL thenπ      callproc := callbackproc(pcallproc^);ππ   root := fexpand(root);π   if root[Length(root)]='\' thenπ      Delete(root, Length(root), 1);ππ   if not(do_depth) thenπ      callproc(root, level);ππ   Tree(root, callproc, do_depth);ππ   if do_depth thenπ      callproc(root, level);πend;ππEND.π                      31     05-26-9406:20ALL                      TIMO SALMI               Hiding a Directory       IMPORT              8      ª╢─▒ {π> browsing. Q59 (How do you hide a directory?) leapt out at me as it'sπsomethingππQ53 actually.ππ> I have been trying to do for ages. However on closer examination theπ'solution'π> proved to be calling the SETFATTR function (either directly or through it'sπ> DOS interrupt.) This worried me- I am SURE I tried this, and withoutπsuccess.π> It worked fine for ordinary files, but NOT directories. In fact I have aππThat's very strange since I have no problems when I testπ}ππuses Dos;ππprocedure HIDE (dirname : string);πvar regs : registers;πbeginπ  FillChar (regs, SizeOf(regs), 0);π  dirname := dirname + #0;π  regs.ah := $43;π  regs.al := $01;π  regs.ds := Seg(dirname[1]);π  regs.dx := Ofs(dirname[1]);π  regs.cx := 2; { set bit 1 on }π  Intr ($21, regs);π  if regs.Flags and FCarry <> 0 thenπ    writeln ('Failed to hide');πend;  (* hide *)ππbeginπ  HIDE ('r:\tmpdir');πend.π