XProfan

Autor: Dieter Zornow (für XProfan 9 optimiert: Roland G. Hülsmann)
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 GetLastError(0) !"KERNEL32","GetLastError"
Struct TFileInfo = LName$(256),   Langer Dateiname
SName$(12),    Kurzer Dateiname (8.3)
Size!,         Dateigröße (Float für Größen über 2 GB)
WDay$(10),     Wochentag des letzen Schreibzugriffes (Write)
WDate$(10),    Datum des letzen Schreibzugriffes
WTime$(8),     Uhrzeit des letzen Schreibzugriffes
CDay$(10),     Wochentag der Erstellung der Datei (create)
CDate$(10),    Datum der Erstellung der Datei
CTime$(8),     Uhrzeit der Erstellung der Datei
ADay$(10),     Wochentag letzter Zugriff auf Datei (access)
ADate$(10),    Datum des letzter Zugriff auf Datei
ATime$(8),     Uhrzeit letzter Zugriff auf Datei
Attr$(10)       Dateiattribut

Proc weekday

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

endproc

proc Fattrib

    -----------
    parameters attrib&
    return if(testbit(attrib&,4),"<DIR> ","")
    + if(testbit(attrib&,0),"r","-")
    + if(testbit(attrib&,5),"a","-")
    + if(testbit(attrib&,1),"h","-")
    + if(testbit(attrib&,2),"s","-")

endproc

Proc ApiFindFile

    ---------------
    parameters file$,filehndl&,FileInfo#
    Declare info#,file#,utc#,time#,findhndl&
    Dim File#,261
    Dim info#,328
    DIM utc#,8
    DIM time#,16
    String File#,0=file$

    If filehndl& = 0

        findhndl& = FindFirstFile(file#,info#)

    else

        FindNextFile(filehndl&,info#)

    endif

    FileInfo#.Attr$  = Fattrib(@long(Info#,0)) attribut
    FileInfo#.LName$ = @String$(Info#,44)      longname
    FileInfo#.Sname$ = @String$(Info#,304)     shortname
    FileInfo#.size!  = @long(Info#,28) * 65536 + @long(Info#,32)  dateigröße
    -------------------------Erstellzeit
    FileTimeToLocalFileTime(info#+4,utc#)
    FileTimeToSystemTime(utc#,time#)

    if word(time#,0) >= 1601

        FileInfo#.cday$  = weekday(word(time#,4))
        FileInfo#.cdate$ = Format$("00",word(time#,6))+"."+Format$("00",word(time#,2))+"."+Format$("00",wor d(time#,0)) Last written date
        FileInfo#.ctime$ = Format$("00",word(time#,8))+":"+Format$("00",word(time#,10))+":"+Format$("00",wo rd(time#,12)) last written time

    else

        FileInfo#.cday$  = ""
        FileInfo#.cdate$ = "00.00.0000"
        FileInfo#.ctime$ = "00:00:00"

    endif

    -----------------------------Letzter Zugriff
    FileTimeToLocalFileTime(info#+12,utc#)
    FileTimeToSystemTime(utc#,time#)

    if word(time#,0) >= 1601

        FileInfo#.aday$  = weekday(word(time#,4))
        FileInfo#.adate$ = Format$("00",word(time#,6))+"."+Format$("00",word(time#,2))+"."+Format$("00",wor d(time#,0)) Last written date
        FileInfo#.atime$ = Format$("00",word(time#,8))+":"+Format$("00",word(time#,10))+":"+Format$("00",wo rd(time#,12)) last written time

    else

        FileInfo#.aday$  = ""
        FileInfo#.adate$ = "00.00.0000"
        FileInfo#.dtime$ = "00:00:00"

    endif

    --------------------------- last written
    FileTimeToLocalFileTime(info#+20,utc#)
    FileTimeToSystemTime(utc#,time#)

    if word(time#,0) >= 1601

        FileInfo#.wday$  = weekday(word(time#,4))
        FileInfo#.wdate$ = Format$("00",word(time#,6))+"."+Format$("00",word(time#,2))+"."+Format$("00",wor d(time#,0)) Last written date
        FileInfo#.wtime$ = Format$("00",word(time#,8))+":"+Format$("00",word(time#,10))+":"+Format$("00",wo rd(time#,12)) last written time

    else

        FileInfo#.wday$  = ""
        FileInfo#.wdate$ = "00.00.0000"
        FileInfo#.wtime$ = "00:00:00"

    endif

    ---------------------------------------

    If left$(FileInfo#.attr$,5) = "<DIR>" Verzeichnisse nach oben in einer Listbox

        let FileInfo#.lname$="["+Trim$(FileInfo#.lname$)+"]"

    endif

    Dispose File#
    Dispose info#
    Dispose UTC#
    Dispose time#
    return findhndl&

endproc

proc ApiFindFileFirst

    -------------------
    parameters file$,FileInfo#
    Return ApiFindFile(file$,0,FileInfo#)

EndProc

proc ApiFindFileNext

    ------------------
    parameters filehndl&,FileInfo#
    Return ApiFindFile("",filehndl&,FileInfo#)

EndProc

Rückgabe: FindHandle&, Ergebnisse in: FileInfo-Struktur (s.o.)
Aufruf und Abrage:
FindHandle& = ApiFindFileFirst(Datei mit Pfad,FileInfo-Struktur)
FindHandle& = ApiFindFileNext(FindHandle&,FileInfo-Struktur)
nicht vergessen das Findhandle mit Findclose(Findhandle) zu schließen
Beispiel:
FHandle& = ApiFindFileFirst("c:\Temp*.exe",FileInfo#)
ApiFindFileNext(FHandle&,FileInfo#)
... usw
FindClose(FHandle&)
Bei *.* werden natürlich auch Verzeichnisse gefunden, diese kann man
über das "<DIR>" in FileInfo#.Attr$ sauber ausfiltern
Beispielprogramm
================
Declare Filefindhndl&
Declare FileInfo#
Dim FileInfo#,TFileInfo
window 0,0 - 1024,768
Set("Decimals",0)
Filefindhndl& = ApiFindFileFirst("C:\Documents and Settings\rhuelsma\My DocumentsDownloads\*.*",FileInfo#)

repeat

    print FileInfo#.LName$ + "|"
    + FileInfo#.SName$ + "|"
    + FileInfo#.ADate$ + "|"
    + FileInfo#.ATime$ + "|"
    + FileInfo#.Attr$  + "|"
    + Format$("###,###,###,##0 Bytes",FileInfo#.Size!)
    ApiFindFileNext(filefindhndl&,FileInfo#)

until GetLastError() = 18

FindClose(filefindhndl&)
 href='./../../funktionsreferenzen/XProfan/imprimir/'>imprimir "Fertig!"
waitinput