XProfan

Autor: Dieter Zornow
Code zur freien Verwendung
Def FindFirstFile(2) !"KERNEL32","FindFirstFileA"
Def FindNextFile(2) !"KERNEL32","FindNextFileA"
Def FindClose(1) !"KERNEL32","FindClose"
DEF FileTimeToLocalFileTime(2) !"Kernel32","FileTimeToLocalFileTime"
DEF FileTimeToSystemTime(2) !"Kernel32","FileTimeToSystemTime"
Def PathIsDirectory(1) ! "shlwapi","PathIsDirectoryA" gibt 0 für nein und 16 für ja zurück
Def PathIsDirectoryEmpty(1) ! "shlwapi","PathIsDirectoryEmptyA" gibt 1 für leer 0 für nein
Def GetLastError(0) !"KERNEL32","GetLastError"
Declare  filefindhndl& muss global declariert werden

proc isDir

    parameters dir$
    Declare jn&
    jn& = PathIsDirectory(addr(dir$))
    return jn&

endproc

proc isDirEmpty

    parameters dir$
    Declare jn&
    jn& = PathIsDirectoryEmpty(addr(dir$))
    return jn&

endproc

Proc weekday

    Parameters day&
    Return substr$("Sonntag,Montag,Dienstag,Mittwoch,Donnerstag,Freitag,Samstag",day& + 1,",")

endproc

proc Fattrib

    parameters attrib&
    Declare attrib$
    let attrib$="----"

    if attrib& = 1

        let attrib$="r---"

    elseif attrib& = 2

        let attrib$="--h-"

    elseif attrib& = 3

        let attrib$="r-h-"

    elseif attrib& = 4

        let attrib$="---s"

    elseif attrib& = 5

        let attrib$="r--s"

    elseif attrib& = 6

        let attrib$="--hs"

    elseif attrib& = 7

        let attrib$="r-hs"

    elseif attrib& = 16

        let attrib$="<DIR>"+"  "+"----"

    elseif attrib& = 17

        let attrib$="<DIR>"+"  "+"r---"

    elseif attrib& = 18

        let attrib$="<DIR>"+"  "+"--h-"

    elseif attrib& = 19

        let attrib$="<DIR>"+"  "+"r-h-"

    elseif attrib& = 20

        let attrib$="<DIR>"+"  "+"---s"

    elseif attrib& = 21

        let attrib$="<DIR>"+"  "+"r--s"

    elseif attrib& = 22

        let attrib$="<DIR>"+"  "+"--hs"

    elseif attrib& = 23

        let attrib$="<DIR>"+"  "+"r-hs"

    elseif attrib& = 32

        let attrib$="-a--"

    elseif attrib& = 33

        let attrib$="ra--"

    elseif attrib& = 34

        let attrib$="-ah-"

    elseif attrib& = 35

        let attrib$="rah-"

    elseif attrib& = 36

        let attrib$="-ahs"

    elseif attrib& = 37

        let attrib$="ra-s"

    elseif attrib& = 38

        let attrib$="-ahs"

    elseif attrib& = 39

        let attrib$="rahs"

    elseif attrib& = 48

        let attrib$="<DIR>"+"  "+"-a--"

    elseif attrib& = 49

        let attrib$="<DIR>"+"  "+"ra--"

    elseif attrib& = 51

        let attrib$="<DIR>"+"  "+"rah-"

    elseif attrib& = 55

        let attrib$="<DIR>"+"  "+"rahs"

    elseif attrib& = 128

        let attrib$="----"

    elseif attrib& = 256

        let attrib$="----T"

    elseif attrib& = 2048

        let attrib$="----C"

    elseif attrib& = 4096

        let attrib$="----O"

    endif

    return attrib$

endproc

Proc ApiFindFile

    parameters file$,filehndl&
    Declare info#,file#,utc#,time#,succ&,return$,attrib$,lwrite$,ctime$,cwrite$,atime$,awrite$,wtime$,size$,LName$,Sname$
    Declare aday$,cday$,wday$,size!
    Dim info#,328
    Dim File#,261
    DIM utc#,8
    DIM time#,16
    String File#,0=file$

    If filehndl& = 0

        filefindhndl&=FindFirstFile(file#,info#)

    endif

    If filehndl& > 0

        succ&=FindNextFile(filefindhndl&,info#)

    endif

    Fattrib @long(Info#,0) attribut
    attrib$=@$(0)
    LName$=@String$(Info#,44) longname
    Sname$=@String$(Info#,304) shortname
    -------------------------Erstellzeit
    FileTimeToLocalFileTime(info#+4,utc#)
    FileTimeToSystemTime(utc#,time#)
    let cwrite$=""
    let ctime$=""

    if word(time#,0) >= 1601

        cday$ = weekday(word(time#,4))
        let cwrite$=Format$("00",word(time#,6))+"."+Format$("00",word(time#,2))+"."+Format$("00",word(time#,0)) Last written date
        let ctime$=Format$("00",word(time#,8))+":"+Format$("00",word(time#,10))+":"+Format$("00",word(time#,12)) last written time

    else

        let cwrite$="00.00.00"
        let ctime$="00:00:00"

    endif

    -----------------------------Letzter Zugriff
    FileTimeToLocalFileTime(info#+12,utc#)
    FileTimeToSystemTime(utc#,time#)
    let awrite$=""
    let atime$=""

    if word(time#,0) >= 1601

        aday$ = weekday(word(time#,4))
        let awrite$=Format$("00",word(time#,6))+"."+Format$("00",word(time#,2))+"."+Format$("00",word(time#,0)) Last written date
        let atime$=Format$("00",word(time#,8))+":"+Format$("00",word(time#,10))+":"+Format$("00",word(time#,12)) last written time

    else

        let awrite$="00.00.00"
        let atime$="00:00:00"

    endif

    --------------------------- last written
    FileTimeToLocalFileTime(info#+20,utc#)
    FileTimeToSystemTime(utc#,time#)
    let lwrite$=""
    let wtime$=""

    if word(time#,0) >= 1601

        wday$ = weekday(word(time#,4))
        let lwrite$=Format$("00",word(time#,6))+"."+Format$("00",word(time#,2))+"."+Format$("00",word(time#,0)) Last written date
        let wtime$=Format$("00",word(time#,8))+":"+Format$("00",word(time#,10))+":"+Format$("00",word(time#,12)) last written time

    else

        let lwrite$="00.00.00"
        let wtime$="00:00:00"

    endif

    ---------------------------size
    size! = @long(Info#,28)*(65535+1)+@long(Info#,32) Maxdword
    size$=Format$("###,###,###,###.00",size!)
    ---------------------------------------

    If left$(attrib$,5) = "<DIR>" Verzeichnisse nach oben in einer Listbox

        let lname$="["+lname$+"]"

    endif

    Dispose File#
    Dispose info#
    Dispose UTC#
    Dispose time#
    let Return$=lname$+"|"+sname$+"|"+size$+"|"+wday$+"|"+lwrite$+"|"+wtime$+"|"+cday$+"|"+cwrite$+"|"+ctime$+"|"
    Return$ = Return$ +aday$+"|"+awrite$+"|"+atime$+"|"+attrib$
    return return$

endproc

Rückgabe
@SubStr$(back$,1,"|") =Langer Dateiname
@SubStr$(back$,2,"|") =Kurzer Dateiname
@SubStr$(back$,3,"|") =Dateigröße
@SubStr$(back$,4,"|") =Wochentag des letzen Schreibzugriffes
@SubStr$(back$,5,"|") =Datum des letzen Schreibzugriffes
@SubStr$(back$,6,"|") =Uhrzeit des letzen Schreibzugriffes
@SubStr$(back$,7,"|") =Wochentag der Erstellung der Datei
@SubStr$(back$,8,"|") =Datum der Erstellung der Datei
@SubStr$(back$,9,"|") =Zeit der Erstellung der Datei
@SubStr$(back$,10,"|") =Wochentag letzter Zugriff auf Datei
@SubStr$(back$,11,"|") =Datum letzter Zugriff auf Datei
@SubStr$(back$,12,"|") =Zeit letzter Zugriff auf Datei
@SubStr$(back$,13,"|") =Dateiattribut
Aufruf und Abfrage:
ApiFindFile "Datei mit Pfad",Filehandle
print @$(0)
oder in neueren Profanversionen:
back$ = ApiFindFile(Datei mit Pfad,Filehandle)
nicht vergessen das Filehandle mit Findclose(Filehandle) zu schließen
Beim ersten Aufruf mit einer Dateimaske ist das Filehandle = 0
Bei weiteren Aufrufen mit der selben Dateimaske muss das Handle übergeben werden, der Filename
wird nicht mehr benötigt.
Beispiel:
ApiFindFile "c:Temp*.exe",0
ApiFindFile "",filefindhndl&
FindClose(filefindhndl&)
bei *.* werden natürlich auch Verzeichnisse gefunden, diese kann man mit "Isdir" sauber ausfiltern
window 0,0-1024,768
ApiFindFile "c:Programmieren!MeineProgs!In_ArbeitDatenbankModifystructure*.inc",0
print @$(0)

whilenot GetLastError() = 18

    ApiFindFile "",filefindhndl&
    case substr$(@$(0),1,"|") <> "":print @$(0)

endwhile

FindClose(filefindhndl&)
waitinput

Proc FAttrib

    Parameters Attrib&
    Declare Attrib$
    Attrib$ = If((Attrib& & 16) <> 0,"<DIR> ","")
    Attrib$ = Attrib$ + If((Attrib& &  1) <> 0,"r","-")
    Attrib$ = Attrib$ + If((Attrib& & 32) <> 0,"a","-")
    Attrib$ = Attrib$ + If((Attrib& &  2) <> 0,"h","-")
    Attrib$ = Attrib$ + If((Attrib& &  4) <> 0,"s","-")
    128 einfach auslassen: ergibt "----"
    Attrib$ = Attrib$ + If((Attrib& & 256) <> 0,"T","")
    Attrib$ = Attrib$ + If((Attrib& & 2048) <> 0,"C","")
    Attrib$ = Attrib$ + If((Attrib& & 4096) <> 0,"O","")
    Return Attrib$

EndProc