XProfan

 $P+
********************** HINWEISE ********************************
CODE ERZEUGT MIT ROKOS OBJECT CREATOR 4.2b
DATUM  25.02.2006
VERWENDETE PROFANVERSION IST 9.1-NT XPROFAN
CODE ERSTELLT UNTER WINDOWS XP
********************** DATEN ***********************************
PROJEKTNAME    Last1000
BESCHREIBUNG   Neueste Dateien auflisten
VERSION        1.00
AUTOR          Michael Wodrich
ERSTELLDATUM   25.02.2006
********************** ANMERKUNGEN *****************************
Dieses Programm listet die Dateien
(der letzten 10 Tage) und zeigt diese
in einer sortierten Listbox an.
Es werden maximal 1000 Dateien gezeigt.
Durch die Sortierung fallen alte Dateien
dabei heraus.
Wenn alles glatt läuft, dann läßt sich
dieses Programm jederzeit abbrechen.
*) "der letzten 10 Tage" habe ich mal herausgenommen
********************** QUELLCODE *******************************
Set("ErrorLevel",0)
Set("TrueColor",1)
Set("AutoPaint",2)
DEF GETSYSCOLOR(1) !"USER32","GetSysColor"
 $I C:PROFANLIBBILDBUTTON.INC (Für Bildbuttons/Iconbuttons)
Vertauschen der Ziffern (0 -> 9, 1 -> 8, 2 -> 7, ...)
führt zu absteigender Sortierung (alles außer Ziffern fällt hier weg)

Proc SortDesc

    Parameters dat$
    Declare B#,i%,j%,k%,erg$
    Dim B#,Len(dat$)+1
    String B#,0 = dat$
    j% = Len(dat$)

    While i% < j%

        k% = Byte(B#,i%)
        Byte B#,i% = If( (k% >= 47) and (k% <= 57),105 - k%, 46)
        Inc i%

    EndWhile

    erg$ = String$(B#,0)
    Dispose B#
    Return Translate$(erg$,".","")

EndProc

Zeile für die sortierte Listbox aufbereiten

Proc SortZeile

    Parameters Datei$
    Declare Zeile$

    If FileExists(Datei$)

        Zeile$ = SortDesc(GetFDate$(Datei$) + GetFTime$(Datei$)) +
        " " +
        GetFDate$(Datei$) +
        " " +
        Datei$

    EndIf

    Return Zeile$

EndProc

PROC DIALOG  ---------------------------------------------------------------------------

    Verzeichnisse werden hier zwischengelagert

    Proc Add_L

        Parameters x$
        Declare y$,i%
        i% = SendMessage(LB&,$01A2,-1,Addr(x$))

        If i% < 0

            AddString(LB&,x$)

        EndIf

    EndProc

    ...und nach dem Abruf auch wieder entfernt

    Proc Get_L

        Declare s$

        If GetCount(LB&,0) > 0

            s$ = GetString$(LB&,0)
            DeleteString(LB&,0)

        EndIf

        Return s$

    EndProc

    Hier wird die sortierte Listbox mit den Dateinamen gefüllt

    Proc Add_R

        Parameters x$
        Declare y$,i%
        y$ = SortZeile(x$)
        i% = SendMessage(SLB&,$01A2,-1,Addr(y$))

        If i% < 0

            AddString(SLB&,y$)
            SetText TEXT2&,"gefundene Dateien: "+Format$("#,##0",GetCount(SLB&))+Space$(10)

            If GetCount(SLB&) > 1000

                DeleteString(SLB&,1000)
                SetText TEXT2&,"gefundene Dateien: "+Format$("#,##0",GetCount(SLB&))+Space$(10)

            EndIf

        EndIf

    EndProc

    ein Plattenverzeichnis durcharbeiten

    Proc WholeSub

        Declare Datei$,V$
        ChDir Pfad$
        Case @Right$(Pfad$,1) = "" : Pfad$ = Del$(Pfad$,@Len(Pfad$),1)
        Let Datei$ = @Upper$(@FindFirst$("*.*"))

        WhileNot %IOResult

            If gestartet%

                If Datei$ <> ""

                    If @Left$(Datei$,1) = "["  ->ein Verzeichnis

                        Datei$ = @Mid$(Datei$,2,@Len(Datei$)-2)

                        IfNot (Datei$=".") Or (Datei$="..")

                            V$ = Pfad$ + "" + Datei$
                            Add_L( V$ )             ...merken

                        EndIf

                        Else                       ->eine Datei
                        V$ = Pfad$ + "" + Datei$
                        Add_R( V$ )             ...auflisten

                    EndIf

                EndIf

                ------

                If %PeekMessage  ...wenn eine Message anliegt

                    If %MWnd = DLG&  Ist die Message für mich???

                        -------
                        SetTimer 500
                        WAITINPUT  ja, holen
                        während der Dateisuche interessiert nur der Abbruch-Wunsch

                        If GETFOCUS(ICONBUTTON1&) ICONBUTTON (Abbruch)

                            SETFOCUS(DLG&)
                            Clear gestartet%  Arbeit einstellen
                            SendMessage(LB&,$0184,0,0)  Verzeichnis-Liste löschen

                        EndIf

                        KillTimer
                        -------

                    EndIf

                EndIf

                ------

            EndIf

            Let Datei$ = @Upper$(@FindNext$())

        EndWhile

    EndProc

    Vorarbeiten für ein ganzes Laufwerk

    Proc WholeDisk

        Parameters Lw$

        If gestartet%

            Declare Such$
            Pfad$ = @Upper$(Lw$)

            If Len(Pfad$) = 1

                Pfad$ = Pfad$ + ":"

            ElseIf Right$(Pfad$,1) = ":"

                Pfad$ = Pfad$ + ""

            ElseIf Right$(Pfad$,1) = ""

                Pfad$ = Left$(Pfad$,Len(Pfad$) - 1)

            EndIf

            If DirExists(Pfad$)  nicht vergessen (bei Wechselmedien wichtig)

                ChDir Pfad$
                Pfad$ = @GetDir$("@")
                Add_L( Pfad$ )
                Pfad$ = Get_L()

                While Pfad$ <> ""

                    WholeSub
                    Pfad$ = Get_L()

                EndWhile

            EndIf

        EndIf

    EndProc

    DECLARE DLG&, DIALOGENDE%
    DECLARE LB&, SLB&
    DECLARE TEXT1&, TEXT2&
    DECLARE ICONBUTTON1&, ICONBUTTON2&, ICONBUTTON3&
    Declare gestartet%
    WINDOWSTYLE 31
    DLG& = CREATE("DIALOG",%HWND,"Neueste Dateien zeigen",((%MAXX / 2) - (640 / 2)),((%MAXY / 2) - (480 / 2)), 640,480)
    USEFONT "MS Sans Serif",13,0,0,0,0
    SETDIALOGFONT 1
    LB& = CREATE("LISTBOX",DLG&,"LISTBOX",10,50,180,400)
    Create("Tooltip",DLG&,LB&,"Hier werden die noch zu bearbeitenden Verzeichnisse aufgelistet.")
    TEXT1& = CREATE("TEXT",DLG&,"zu bearbeitende Verzeichnisse:",10,20,150,20)
    TEXT2& = CREATE("TEXT",DLG&,"gefundene Dateien:",200,20,180,20)
    SLB& = CREATE("SORTEDLISTBOX",DLG&,"SORTEDLISTBOX",200,50,420,400)
    Create("Tooltip",DLG&,SLB&,"Hier stehen die gefundenen Dateien - jüngste oben.")
    ICONBUTTON "30","C:\PROFAN\ROCICON.DLL",DLG&,520,6,40,40
    LET ICONBUTTON1& = @&(0)
    Create("Tooltip",DLG&,ICONBUTTON1&,"Die Suche wird abgebrochen.")
    ICONBUTTON "18","C:\PROFAN\ROCICON.DLL",DLG&,570,6,40,40
    LET ICONBUTTON2& = @&(0)
    Create("Tooltip",DLG&,ICONBUTTON2&,"Dies ist der Ausgang - Auf Wiedersehen!")
    ICONBUTTON "52","C:\PROFAN\ROCICON.DLL",DLG&,470,6,40,40
    LET ICONBUTTON3& = @&(0)
    Create("Tooltip",DLG&,ICONBUTTON3&,"Eine neue Suche wird gestartet.")
    SETFOCUS(DLG&)
    Clear DIALOGENDE%

    WHILENOT DIALOGENDE%

        WAITINPUT

        If %KEY = 2

            Clear gestartet%
            LET DIALOGENDE% = 1

        ELSEIF GETFOCUS(LB&) LISTBOX

            SETFOCUS(DLG&)

        ELSEIF GETFOCUS(SLB&) SORTEDLISTBOX

            SETFOCUS(DLG&)

        ELSEIF GETFOCUS(ICONBUTTON3&) ICONBUTTON (Start)

            SETFOCUS(DLG&)
            gestartet% = 1
            SendMessage(LB&,$0184,0,0)
            SendMessage(SLB&,$0184,0,0)

        ELSEIF GETFOCUS(ICONBUTTON1&) ICONBUTTON (Abbruch)

            SETFOCUS(DLG&)
            Clear gestartet%

        ELSEIF GETFOCUS(ICONBUTTON2&) ICONBUTTON (Ende)

            SETFOCUS(DLG&)
            Clear gestartet%
            LET DIALOGENDE% = 1

        ENDIF

        If gestartet%

            WholeDisk("C")
            WholeDisk("D")
            WholeDisk("E")
            WholeDisk("F")
            WholeDisk("G")

        EndIf

    ENDWHILE

    DESTROYWINDOW(DLG&)
    ENDPROC --------------------------------------------------------------------------------

    Proc Main

        Declare Pfad$
        WindowTitle "Last1000"
        WindowStyle 16+64+1024
        Window 0,0 - 0,ass=s2>0
        dialog

    ENDPROC

    Main
    ProgEnd