program CHK_XIST { www.merlyn.demon.co.uk >= 1997/02/22 } ; uses {$IFDEF WINDOWS} Strings, WinDos, WinCrt {$ELSE} Dos {$ENDIF} ; type Atts = (RdO, Hid, Sys, Vol, Dir, Arc, Unk, Net) ; AttSet = set of Atts ; const Sp = #32 ; procedure WrAtts(const Attr : word) ; const AttChs : array [Atts] of char = 'RHSVDA%#' ; var Att : Atts ; begin Write('Attribute = ', Attr, '':2); for Att := Low(Atts) to High(Atts) do if Att in AttSet(Lo(Attr)) then Write(AttChs[Att]) else Write(Sp) ; Writeln end {WrAtts} ; function AttStr(const Attr : word) : string ; type Atts = (RdO, Hid, Sys, Vol, Dir, Arc, Unk, Net) ; AttSet = set of Atts ; const Sp = #32 ; var Att : Atts ; begin AttStr := 'RHSVDA%#' ; for Att := Low(Atts) to High(Atts) do if not (Att in AttSet(Lo(Attr))) then AttStr[Succ(Ord(Att))] := Sp ; end {AttStr} ; function NameUsed (const St : string ; const Chat : boolean ; var Attr : word) : boolean ; var F : file ; begin if Chat then Write(' NameUsed : "', St, '" : ') ; Assign(F, St) ; GetFAttr(F, Attr) ; NameUsed := DosError=0 ; if Chat then if DosError<>0 then Writeln('DOS error, code = ', DosError) else Writeln('Attributes : ', AttStr(Attr):10) ; end {NameUsed} ; {$IFDEF WINDOWS} const Directory = faDirectory ; VolumeID = faVolumeID ; AnyFile = faAnyFile ; type SearchRec = TSearchRec ; {$ENDIF} function FileExists_4 (const St : string ; const Chat : boolean ; var Attr : word) : boolean ; var B : boolean ; begin if Chat then Write(' FileExists_4 : ') ; B := NameUsed(St, Chat, Attr) ; FileExists_4 := B and ((Attr and (Directory+VolumeID))=0) ; end {FileExists_4} ; function DiryExists_4 (const St : string ; const Chat : boolean ; var Attr : word) : boolean ; var B : boolean ; begin if Chat then Write(' DiryExists_4 : ') ; B := NameUsed(St, Chat, Attr) ; DiryExists_4 := B and ((Attr and Directory)<>0) ; end {DiryExists_4} ; type BooFn = function (const SR : SearchRec) : boolean ; function OKfunc(const SR : SearchRec) : boolean ; FAR ; begin OKfunc := true { or a function of SR } end {OKfunc} ; function NameNumber_4 (const St : {$IFDEF WINDOWS} PChar {$ELSE} string {$ENDIF} ; const Chat : boolean ; Fn : BooFn) : word ; var Sr : SearchRec ; Count : word ; begin if Chat then Writeln(' NameNumber_4 : "', St, '" : ') ; Count := 0 ; FindFirst(St, AnyFile, SR) ; while DosError=0 do begin if Fn(SR) then begin if Chat then with SR do Writeln(Name:15, AttStr(Attr):10) ; Inc(Count) end {Fn} ; FindNext(SR) end {while} ; NameNumber_4 := Count end {NameNumber_4} ; var Attrib : word ; {$IFDEF WINDOWS} PStr : array [0..130] of char ; {$ENDIF} const NL = ^M^J ; BEGIN ; Writeln('CHK_XIST file') ; { Get file name from command line } Writeln( NL, FileExists_4(ParamStr(1), true, Attrib):6, Attrib:6, NL, DiryExists_4(ParamStr(1), true, Attrib):6, Attrib:6, {$IFDEF WINDOWS} NL, NameNumber_4(StrPCopy(PStr, ParamStr(1)), true, OKfunc):6, {$ELSE} NL, NameNumber_4(ParamStr(1), true, OKfunc):6, {$ENDIF} '') ; {$IFNDEF WINDOWS} Readln ; {$ENDIF} END. Note - the usual File-Exists does not clearly discriminate between "Does a file of that name exist?" and "Is that file-name free?". In NameNumber_4, Fn(SR) can be any boolean function of SR; but the most useful may be attribute selection size selection date/time selection non-DOS wildcarding, perhaps with a RegExp. NOTE - DOS "C:\>copy file name" fails, without warning, if name==VolumeID. The adaptation for Windows is possibly not the best, but was chosen to maximise commonality of source code. WrAtts was tested, but is not used here. See also Prof Timo Salmi's Turbo Pascal FAQ, item 47. It is reported that this works correctly in a Win95 DOS box, but another technique ( {$i-} Reset(F) ; Write(IOResult) {$i+} does not. www.merlyn.demon.co.uk (* function FExist(const fname : string) : boolean; begin FExist := FSearch(fname, '') <> '' end {FExist} ; Sheldon C. Shallon Los Angeles, CA USA Internet: ad363@lafn.org *) What happens if the file is already open (a) by this program (b) by another?