XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Text suchen (in Dateien)
Lauffähig ab Profan-Version 5.0
declare i%,listbox1&,Listbox2&,eingabe$,button0&
declare datei$,zeile$,datei$,z%,ok%,edit2&,fz$
declare ok$,edit&,button1&,button2&,len%,fz2$,zahl$
declare radiobutton1&,radiobutton2&,gefunden%,text&

PROC KLICK          WICHTIG WEGEN EINFACHKLICK

    getmessage
    Case (%message,512): Return

ENDPROC

PROC SEARCH

    let gefunden%=0
    @destroywindow(Listbox1&)  Um erneut zu füllen
    @destroywindow(Listbox2&)  Um erneut zu füllen
    und wiederherstellen
    Let ListBox2&=CreateListBox(%hwnd,,10,200,472,97)
    Let ListBox1&=CreateListBox(%hwnd,,10,10,472,97)
    FILEMODE 0
    let I%=0
    let eingabe$=GETTEXT$(EDIT&)
    assign #1,datei$
    reset #1
    Clear ok$

    whilenot eof(#1)

        input #1,zeile$
        addstring(LISTBOX1&,@UPPER$(zeile$))

    wend

    close #1
    assign #1,datei$
    reset #1
    case @GetCheck(Radiobutton1&):let eingabe$=eingabe$;
    let fz$=mid$(eingabe$,1,1)
    len%=@Len(eingabe$)

    whilenot eof(#1)

        input #1,zeile$
        let OK$=getstring$(LISTBOX1&,i%)
        let ok%=@Instr(upper$(eingabe$),OK$)

        if @gt(ok%,0)

            if @GetCheck(Radiobutton1&)

                let OK$=@Mid$(OK$,ok%,len%)
                let ok$=upper$(ok$)
                let ok$=ok$;
                zeile$=@Trim$(zeile$)
                let fz2$=mid$(zeile$,1,1)
                let eingabe$=upper$(eingabe$,)

                if @and( @equ$(eingabe$,ok$),equ$(fz$,fz2$))

                    ADDString(LISTBOX2&,zeile$)
                    inc gefunden%
                    let zahl$=Es wurden ,gefunden%;x ,eingabe$, in,datei$,gefunden
                    settext text&,zahl$

                endif

            Elseif @getcheck(Radiobutton2&)

                let OK$=@Mid$(OK$,ok%,len%)
                let ok$=upper$(ok$)
                let eingabe$=upper$(eingabe$)

                if @equ$(eingabe$,ok$)

                    ADDString(LISTBOX2&,zeile$)
                    inc gefunden%
                    let zahl$=Es wurden ,gefunden%;x ,eingabe$, in,datei$,gefunden
                    settext text&,zahl$

                endif

            Endif

        endif

        INC I%

    WEND

    CLOSE #1
    let zahl$=Es wurden ,gefunden%;x ,eingabe$, in,datei$,gefunden
    settext text&,zahl$

ENDPROC

SetTrueColor 1
WindowStyle $003F
Window 10,10-500,400
Windowtitle Nach Text suchen
UseFont MS Sans Serif,13,0,0,0,0
SetDialogFont 1
cls RGB(192,192,192)
Let ListBox2&=CreateListBox(%hwnd,,10,200,472,97)
Let ListBox1&=CreateListBox(%hwnd,,10,10,472,97)
Let Edit2&=CreateEdit(%hwnd,Hier Datei (oder Button klicken),11,160,172,21)
Let Edit&=CreateEdit(%hwnd,Hier Suchtext,10,120,172,21)
Let Button1&=CreateButton(%hwnd,GO!,240,120,80,25)
Let Button2&=CreateButton(%hwnd,Datei wählen,240,160,80,25)
let button0&=CreateButton(%hwnd,,0,0,0,0)  Damit Programm den Focus besser setzen kann
Let RadioButton1&=CreateRadioButton(%hwnd,Text genau suchen,340,120,140,17)
Let RadioButton2&=CreateRadioButton(%hwnd,Text ungefähr suchen,340,140,140,17)
Let Text&=CreateText(%hwnd,Hier wird die gefundene Suchanzahl angezeigt,10,320,470,17)
setcheck Radiobutton1&,1

while 1

    waitinput

    if getfocus(button2&)

        KLICK
        let datei$=@LOADFILE$(ÖFFNE:,*.prf)
        settext edit2&,datei$
        setfocus(button0&)

    elseif getfocus(button1&)

        KLICK

        if @and(@neq$(datei$,),@neq$(gettext$(Edit&),Hier Suchtext))

            SEARCH

        elseif @equ$(datei$,)

            @MessageBox(Bitte Datei wählen,Fehler,16)

        elseif @equ$(gettext$(Edit&),Hier Suchtext)

            @MessageBox(Bitte richtigen Suchtext eingeben!,Fehler,16)

        endif

        setfocus(button0&)

    endif

wend