XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Suchen: Suchmaschine für (X)Profan
------------------------------------------------------------------------------
PRFSEARCH VER.1.5                                    (c) 1998 Richard Maurukas
------------------------------------------------------------------------------
(P)Fairware, Freeware..                              für Profan² 6.0, 32 Bit
Systemvorraussetzung:
Win95, Profan² 6.0, 32 Bit
Auf dem System muß die riched32.dll installiert sein.
Unter WinNT nicht getestet.
Wer hat sich noch nicht geärgert, das eine geschriebene Routine oder eine
Textpassage gerade jetzt im Datendschungel nicht auffindbar ist?
Nun, mir gings schon öfter so. Aus diesem Grund habe ich nun
diese Suchmaschine für Profan gebaut. Nebenbei versuchte ich mich
auch gleich an den Richedit Messages zur Textsuche, die ich hier in einen
fertigen SuchDialog eingebaut habe.
------------------------------------------------------------------------------
Erweiterungen zur Ver.1.0
1.)
Es wurde eine Datei-Typ Auswahlbox eingebaut. Es können nunmehr
*.PRF Profan Quelltext-Dateien,
*.INC Profan Include-Dateien,
*.DLG Profan Dialog-Dateien,
*.WND Profan Fenster-Dateien,
*.PSC Profan Script Dateien
*.PRV PRFELLOW Vorlagen *)
*.HTM HTML Dokumente,
*.RTF Rich Text Format Dateien,
*.TXT ASCII Text Dateien
nach einen eingegeben Begriff dursucht werden.
(Erweiterungen sind in der PROC SUCHFENSTERDIALOG leicht möglich.)
*) PRFELLOW ist eine geniale IDE für Profan von Thomas Hölzer mit
umfangreichen Tools, Vorlagen und AddOns.
2.)
Es wurde ein kompletter RichEdit-Suchdialog im Profan Quellcode integriert.
Es kann nunmehr im Text-Betrachter der Text nach weiteren Suchbegriffen
durchsucht werden.
Außerdem kann hier noch nach ganzem Wort und Groß-/Kleinschreibung
selektiert werden. Dieser Dialog, kann natürlich für alle RichEdit-Controls
so in andere Programme übernommen werden.
3.)
Es wurde ein zusätlicher Button unterhalb des Suchfeldes angebracht.
Dieser Button löscht den Text im Suchfeld und fügt  einen Text aus
der Zwischenablage in das Suchfeld ein.
4.)
Es werden nun in Info-Feldern die Anzahl der gelisteten Verzeichnisse, Dateien
und der gefundenen Dateien angezeigt.
Kann natürlich noch verbessert oder erweitert werden.
------------------------------------------------------------------------------
Kurzinfo:
Laufwerk und Verzeichnis wählen bis in der Dateiliste der ausge-
wählte DateiTyp erscheint. Suchbegriff eingeben und mit dem Button
-Suchen- alle Dateien in der Dateiliste nach dem Begriff durchsuchen
lassen. Dateien, in denen der Begriff vorkommt, werden in die Liste
unter dem Suchbegriff eingefügt. Aus dieser Liste kann nun eine
gewünschte Datei zur Bearbeitung gewählt werden. Nach dem Öffnen
der Datei wird der erste Textbereich, der den Suchbegriff enthält,
automatisch markiert. Eine weiterführende Suche kann nun über das
Menü -Bearbeiten- fortgeführt werden. Der gefundene Text wird markiert
und in den sichtabren Bereich gescrollt. Wird das Ende der Datei erreicht,
wird die Suche wieder am Anfang der Datei fortgesetzt.
------------------------------------------------------------------------------
-----------------------------PROGRAMM BEGINN----------------------------------
declare LWListe%,Verzliste%,Dateiliste%,suchbegrif%
declare gefliste%,such%,info%,beenden%,Ende%,LW$,Verzname%
declare betrachten%,Datei$,LPOS&,zwischenabl%,Suchtext$
declare hdll&,Rich&,FileTyp%
declare AnzVerz%,AnzDat%,AnzGefDat%
declare Dirname#,SEARCHPOS#,SEARCHTEXT#,RichEdit#,crcp#
dim Dirname#,255
dim Searchpos#,20
dim Searchtext#,255
dim crcp#,16

PROC VERZEICHNISLISTE

    sendmessage(Verzliste%,$0184,0,0)
    string Dirname#,0=*.*
    sendmessage(Verzliste%,$018D,$8010,Dirname#)
    sendmessage(Verzliste%,$0186,0,0)
    settext AnzVerz%,add$(Verz: ,str$(getcount(Verzliste%))
    setfocus(%Hwnd)

ENDPROC

PROC DATEILISTE

    sendmessage(Dateiliste%,$0184,0,0)
    string Dirname#,0=gettext$(Filetyp%)
    sendmessage(Dateiliste%,$018D,$0007,Dirname#)
    settext AnzDat%,add$(Dat: ,str$(getcount(Dateiliste%))

ENDPROC

PROC RICHEDITCONTROL

    Let hdll&=UseDll(riched32.dll)
    Let RICH&=Control(RichEdit,,$50B01144,0,3,Sub(%Winright,8),24,
    %hwnd,1202,%Hinstance)
    UseFont Times New Roman,16,0,0,0,0
    SendMessage(RICH&,$030,%Font,0)                 WM_SETFONT
    SendMessage(RICH&,1091,0,RGB(255,255,255))      EM_SETBKGNDCOLOR
    Settext Rich&, Simple Suchmaschine für Profan². Durchsucht gewählte
    Dateien nach einen Suchbegriff.
    sendmessage(RICH&,$00B9,0,0) EM_SETMODIFY noch nicht geänderter Text

ENDPROC

Proc ALLSUCH

    let Lpos&=0
    findet den eingegeben Suchbegriff im RichEdit-Control
    string SEARCHTEXT#,0=suchtext$ Gettext$(suchbegrif%)
    long SEARCHPOS#,0=0            Suchbeginn Position
    long SEARCHPOS#,4=-1           Endposition. -1= Ende des Textes
    long SEARCHPOS#,8=SEARCHTEXT#  Der Text aus FindEdit%
    long SEARCHPOS#,12=           die gefundene StartPosition
    long SEARCHPOS#,16=           die gefundene EndPosition
    let Lpos&=sendmessage(Rich&,$044F,$0000,SEARCHPOS#) EM_FINDTEXTEX
    let Lpos&=long(Searchpos#,12)
    long crcp#,0=Lpos&
    let Lpos&=long(Searchpos#,16)
    long crcp#,4=Lpos&
    sendmessage(RICH&,$0437,0,crcp#)EM_EXSETSEL  Gefunden Text markieren

ENDPROC

PROC BEGRIFFSUCHE

    declare e%
    sendmessage(gefListe%,$0184,e%,0)
    let e%=0

    IF gt(getcount(Dateiliste%),0)

        WHILENOT equ(e%,getcount(Dateiliste%))

            sendmessage(Dateiliste%,$0186,e%,0)
            let Datei$=trim$(getstring$(Dateiliste%,e%))
            Dim RichEdit#,add(@FileSize(Datei$),3000)
            readtext RichEdit#,Datei$
            sendmessage(RICH&,$000C,0,RichEdit#)
            ALLSUCH

            IF gt(lpos&,-1)

                addstring(gefListe%,Datei$)
                settext AnzGefDat%,add$(Gefunden: ,str$(getcount(gefliste%))

            ENDIF

            settext verzname%,Einen Augenblick bitte, bin am suchen...
            setfocus(RICH&)
            dispose RichEdit#
            inc e%

        WEND

    ELSE

        Fehler aufgetreten.....

    ENDIF

    settext verzname%,Suche beendet.

ENDPROC

PROC DateiauswahlFenster_ein

    setwindowpos Rich&=0,3-Sub(%Winright,8),24
    enablewindow betrachten%,1
    enablewindow suchbegrif%,1
    enablewindow such%,1
    enablewindow Verzliste%,1
    enablewindow LWListe%,1
    enablewindow gefListe%,1

endproc

PROC SUCHFENSTERDIALOG

    @creategroupbox(%Hwnd,LW., Verzeichnis u. Dateityp wählen,16,34,264,358)
    let LWliste%=@createlistbox(%Hwnd,,24,58,120,80)
    let Verzliste%=@createsortedlistbox(%Hwnd,,24,154,120,204)
    let FileTyp%=@createchoicebox(%Hwnd,,152,58,120,120)
    let Dateiliste%=@createsortedlistbox(%Hwnd,,152,102,120,256)
    let verzname%=createtext(%hwnd,,15,400,495,18)
    @creategroupbox(%Hwnd,Durchsuche..,288,34,222,358)
    @createtext(%Hwnd,Suchbegriff,296,58,136,24)
    let suchbegrif%=@createedit(%Hwnd,,296,82,180,24)
    let gefListe%=@createsortedlistbox(%Hwnd,,296,122,120,194)
    let betrachten%=@createbutton(%Hwnd,Datei betrachten,296,324,120,24)
    let such%=@createbutton(%Hwnd,Suchen,388,58,88,24)
    let zwischenabl%=createbutton(%Hwnd,,296,108,180,10)
    let AnzVerz%=createtext(%Hwnd,,24,360,118,18)
    let AnzDat%=createtext(%Hwnd,,152,360,118,18)
    let AnzGefDat%=createtext(%Hwnd,,296,360,118,18)
    createicon(%Hwnd,A,440,200)
    string Dirname#,0=
    sendmessage(LWListe%,$018D,$4000,Dirname#)
    addchoice(filetyp%,*.PRF)
    addchoice(filetyp%,*.INC)
    addchoice(filetyp%,*.PRV)
    addchoice(filetyp%,*.STR)
    addchoice(filetyp%,*.DLG)
    addchoice(filetyp%,*.WND)
    addchoice(filetyp%,*.PSC)
    addchoice(filetyp%,*.HTM)
    addchoice(filetyp%,*.RTF)
    addchoice(filetyp%,*.TXT)
    Startanzeige im Dateityp *.prf
    sendmessage(filetyp%,$040E,3,0)
    enablewindow Dateiliste%,0

ENDPROC

PROC SUCHENDIALOG

    DECLARE Finddlg%, Findedit%, FindGanzesWort%, FindGrossKlein%
    DECLARE FindWeiter%, FindEnde%, FEnde%
    DECLARE FT_WholeWord&, FT_MatchCase&, WP&, L1Pos&
    Usefont MS Sans Serif,10,0,0,0,0
    Setdialogfont 1
    let Finddlg%=Createdialog(%Hwnd,RichEdit Suche,30,100,342,110)
    createtext(Finddlg%,Suchen nach:,4,8,70,16)
    Let Findedit%=Createedit(Finddlg%,,75,7,257,18)
    creategroupbox(Finddlg%,,4,28,217,50)
    let FindGanzesWort%=createcheckbox(Finddlg%,
    Nur ganzes Wort finden,8,38,210,16)
    let FindGrossKlein%=createcheckbox(Finddlg%,
    Groß-/Kleinschreibung berücksichtigen,8,60,210,16)
    let FindWeiter%=Createbutton(FindDlg%,Nächsten &finden,232,38,100,20)
    Let FindEnde%=Createbutton(FindDlg%,Suche b&eenden,232,60,100,20)
    Setfocus(FindEdit%)
    let FEnde%=0

    Whilenot FEnde%

        WAITINPUT

        IF and(getfocus(Findweiter%),gt$(Gettext$(FindEdit%),))

            String SEARCHTEXT#,0=Gettext$(FindEdit%)

            IF equ(getcheck(FindGanzesWort%),1)

                let FT_Wholeword&=$0002

            ELSE

                let FT_Wholeword&=$0000

            ENDIF

            IF equ(getcheck(FindGrossklein%),1)

                let FT_MatchCase&=$0004

            ELSE

                let FT_MatchCase&=$0000

            ENDIF

            let WP&=add(FT_WholeWord&,FT_MatchCase&)
            Let L1pos&=L1pos&
            long SEARCHPOS#,0=L1Pos&       Suchbeginn Position
            long SEARCHPOS#,4=-1           Endposition. -1= Ende des Textes
            long SEARCHPOS#,8=SEARCHTEXT#  Der Text aus FindEdit%
            long SEARCHPOS#,12=           die gefundene StartPosition
            long SEARCHPOS#,16=           die gefundene EndPosition
            let L1pos&=sendmessage(Rich&,$044F,WP&,SEARCHPOS#) EM_FINDTEXTEX

            IF equ(-1,L1pos&)

                Messagebox(add$(add$(add$( ,gettext$(FindEdit%)), ),
                nicht gefunden.),RichEdit Suchergebnis,64)
                Setfocus(FindDlg%)

            ELSE

                zur Userinfo den gefundenen Text noch markieren
                Mit Workaround da long crcp#,0=long(searchpos#,16) nicht geht.
                let L1pos&=long(Searchpos#,12)
                long crcp#,0=L1pos&
                let L1pos&=long(Searchpos#,16)
                long crcp#,4=L1pos&
                sendmessage(RICH&,$0437,0,crcp#)EM_EXSETSEL  Gefunden Text markieren
                setfocus(RICH&)            Focus zur Anzeige der Markierung setzen

            ENDIF

            Falls das Ende des Textes erreicht ist die Startposition auf Anfang setzen
            case equ(L1Pos&,-1):let L1Pos&=0

        ELSEIF Getfocus(Findende%)

            let Fende%=1
            Destroywindow(FindDlg%)
            setfocus(RICH&)

        ENDIF

    WEND

ENDPROC

PROC STEUERUNG

    settext verzname%,@GetDir$(@)
    let ende%=0

    WHILENOT ende%

        waitinput
        let suchtext$=Gettext$(suchbegrif%)

        IF Menuitem(199)

            let ende%=1

        ELSEIF getfocus(zwischenabl%)

            Fügt den inhalt der Zwischenablage ins Feld suchen ein.
            settext suchbegrif%,
            sendmessage(suchbegrif%,$0302,0,0)
            setfocus(%Hwnd)

        ELSEIF getfocus(LWliste%)

            let lw$=getstring$(LWListe%,getcursel(LWliste%))
            let LW$=Translate$(LW$,[-,)
            let LW$=Translate$(LW$,-],:)
            chdir LW$
            VERZEICHNISLISTE
            DATEILISTE

        ELSEIF getfocus(Verzliste%)

            let lw$=getstring$(Verzliste%,getcursel(Verzliste%))
            let LW$=Translate$(LW$,[,)
            let LW$=Translate$(LW$,],)
            let lw$=Longname$(lw$)
            chdir LW$
            VERZEICHNISLISTE
            DATEILISTE
            settext verzname%,lw$
            setfocus(verzname%)

        ELSEIF getfocus(such%)

            settext AnzGefDat%,Gefunden:  0
            setfocus(%Hwnd)
            enablewindow betrachten%,0
            enablewindow such%,0
            enablewindow Verzliste%,0
            enablewindow LWListe%,0
            enablewindow Dateiliste%,0
            BEGRIFFSUCHE
            DateiauswahlFenster_ein
            Beep

        ELSEIF getfocus(betrachten%)

            IF gt(getcount(gefliste%),0)

                if gt(getcursel(gefliste%),-1))

                    let Datei$=trim$(getstring$(gefliste%,getcursel(gefliste%)))
                    enablewindow betrachten%,0
                    enablewindow such%,0
                    enablewindow Verzliste%,0
                    enablewindow LWListe%,0
                    enablewindow Dateiliste%,0
                    enablewindow gefListe%,0
                    enablewindow suchbegrif%,0
                    InsertMenu 199,110,Betrachter beenden
                    Insertmenu 201,202,Suchen
                    enablemenu 201,0
                    Dim RichEdit#,add(@FileSize(Datei$),2000)
                    readtext RichEdit#,Datei$
                    sendmessage(RICH&,$000C,0,RichEdit#)
                    Dispose RichEdit#
                    setwindowpos Rich&=0,3-Sub(%Winright,8),Sub(%Winbottom,60)
                    SendMessage(RICH&,1091,0,RGB(254,255,255))      EM_SETBKGNDCOLOR
                    SendMessage(RICH&,1091,0,RGB(255,255,255))      EM_SETBKGNDCOLOR
                    ALLSUCH

                ELSE

                    Messagebox(Noch keine Datei ausgewählt.,Bearbeitungsfehler,64)

                ENDIF

            ELSE

                Messagebox(Noch keine Datei zum Betrachten vorhanden.,
                Bearbeitungsfehler,64)

            ENDIF

        ELSEIF getfocus(Filetyp%)

            DATEILISTE

        ELSEIF Menuitem(110)

            RemoveMenu 110
            EnableMenu 201,1
            RemoveMenu 202
            DateiauswahlFenster_ein

        ELSEIF Menuitem(201)

            sendmessage(RICH&,$301,0,0)   WM_COPY

        ELSEIF Menuitem(202)

            SUCHENDIALOG

        ELSEIF Menuitem(901)

            Messagebox(add$(add$(add$(    PRFSEARCH VER.1.0
            ,
            ========================
            ),
            (c) 1998 Richard Maurukas),
            ========================),
            Suchmaschine für Profan²,64)

        ENDIF

    WEND

ENDPROC

------------------------------------------------------------------------------
Window 0,0-540,480
WindowTitle Profan² Quelltext Suchmaschine.
PRFSEARCH VER.1.5 (c) Richard Maurukas
settruecolor 1
cls rgb(075,192,192)
POPUP &Datei
Appendmenu 199,&Beenden
POPUP &Bearbeiten
Appendmenu 201,&Kopieren
POPUP Über
Appendmenu 901,Info
SUCHFENSTERDIALOG
VERZEICHNISLISTE
DATEILISTE
RICHEDITCONTROL
STEUERUNG
Freedll Rich&
Dispose Dirname#
Dispose crcp#
END
-----------------------------PROGRAMM ENDE----------------ass=s2>--------------------