SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00013 DIRECTORY HANDLING ROUTINES 1 05-28-9313:37ALL SWAG SUPPORT TEAM ALLDIRS1.PAS 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 ALLDIRS2.PAS IMPORT 7 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 ALLDIRS3.PAS IMPORT 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 ALLDIRS4.PAS IMPORT 19 {π>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 ALLDIRS5.PAS 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 DELTREE.PAS IMPORT 8 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 SWAG SUPPORT TEAM DIRDEMO.PAS 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 DIREXIST.PAS IMPORT 7 {π 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 DIRTREE.PAS IMPORT 105 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 DIRVIEW.PAS IMPORT 16 {π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-DEL.PAS 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 MAKEDIR1.PAS 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 MAKEDIR2.PAS 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;π
