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------------------------------------