//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~ Warten bis Seite da ist ~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TWortsuche.WebBrowserDocumentComplete(Sender: TObject;
const pDisp: IDispatch;
var URL: OleVariant);
begin
Memo_Seitentext.Lines.Add(Webbrowser.OleObject.Document.documentElement.innerText);
ExtractLinks(Sender);
Wortertrennen(Sender);
Textzerlegen(Sender);
Sonderzeichen(Sender);
Leerestellenweg(Sender);
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~ Links extrahieren ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TWortsuche.ExtractLinks(Sender:TObject);
var i:integer;
begin
For i:=0
to WebBrowser.OleObject.Document.Links.Length-1
do// um die Anzahl der Links zu ermitteln
begin
Application.ProcessMessages;
IF bAbbruch
then break;
IF MatchesMask(WebBrowser.OleObject.Document.Links.Item(i).href,'
http*://*')
then// damit http protokoll benutzt wird
Listbox_Seitenlinks.Items.Add(WebBrowser.OleObject.Document.Links.Item(i).href);
// in Linkliste eintragen
end;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~ Wörter trennen ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TWortsuche.Wortertrennen(Sender: TObject);
var
tmp:
String;
i: Integer;
begin
tmp := Memo_Seitentext.Text;
for i := Ord('
A')
to Ord('
Z')
do
begin
Application.ProcessMessages;
IF bAbbruch
then break;
tmp := StringReplace(tmp, Chr(i), #13#10 + Chr(i), [rfReplaceAll]);
Memo_Seitentext.Text := Trim(tmp);
end;
//for
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~ Text zerlegen ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TWortsuche.Textzerlegen(Sender: TObject);
var sWort, sZeile:
string;iLauf, iLauf2:integer;
begin
For iLauf:=0
to Memo_Seitentext.Lines.Count-1
do
Begin
Application.ProcessMessages;
IF bAbbruch
then break;
sZeile:=Memo_Seitentext.Lines[iLauf]+'
';
For iLauf2:=1
to LENGTH(sZeile)
do
begin
sWort:=COPY(sZeile,1,POS('
',sZeile));
sZeile:=COPY(sZeile,POS('
',sZeile)+1, LENGTH(sZeile));
IF LENGTH(sWort)>1
then
Listbox_Seitenwoerter.Items.Add(TRIM(sWort));
end;
//for Length(sZeile)
end;
// for Memolines
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~ Sonderzeichen löschen ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TWortsuche.SonderZeichen(Sender: TObject);
var iLauf, i:integer;
begin
For iLauf:=0
to Listbox_Seitenwoerter.Items.Count-1
do
begin
FOR i:=32
to 255
do
Begin
Application.ProcessMessages;
IF bAbbruch
then break;
CASE i
OF
32..64 : Listbox_Seitenwoerter.Items[iLauf]:=StringReplace(Listbox_Seitenwoerter.Items[iLauf],chr(i),'
',[rfReplaceAll]);
91..96 : Listbox_Seitenwoerter.Items[iLauf]:=StringReplace(Listbox_Seitenwoerter.Items[iLauf],chr(i),'
',[rfReplaceAll]);
123..195 : Listbox_Seitenwoerter.Items[iLauf]:=StringReplace(Listbox_Seitenwoerter.Items[iLauf],chr(i),'
',[rfReplaceAll]);
197..213 : Listbox_Seitenwoerter.Items[iLauf]:=StringReplace(Listbox_Seitenwoerter.Items[iLauf],chr(i),'
',[rfReplaceAll]);
215..219 : Listbox_Seitenwoerter.Items[iLauf]:=StringReplace(Listbox_Seitenwoerter.Items[iLauf],chr(i),'
',[rfReplaceAll]);
221..227 : Listbox_Seitenwoerter.Items[iLauf]:=StringReplace(Listbox_Seitenwoerter.Items[iLauf],chr(i),'
',[rfReplaceAll]);
229..245 : Listbox_Seitenwoerter.Items[iLauf]:=StringReplace(Listbox_Seitenwoerter.Items[iLauf],chr(i),'
',[rfReplaceAll]);
247..251 : Listbox_Seitenwoerter.Items[iLauf]:=StringReplace(Listbox_Seitenwoerter.Items[iLauf],chr(i),'
',[rfReplaceAll]);
253..255 : Listbox_Seitenwoerter.Items[iLauf]:=StringReplace(Listbox_Seitenwoerter.Items[iLauf],chr(i),'
',[rfReplaceAll]);
End;
//case
End;
//for i
end;
//For iLauf
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~ Leere Zeilen entfernen ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TWortsuche.Leerestellenweg(Sender: TObject);
var iLauf,iEnd:integer;
begin
iEnd:=Listbox_Seitenwoerter.Items.Count;
iLauf:=0;
While iLauf<=iEnd-1
do
begin
IF (LENGTH(TRIM(Listbox_Seitenwoerter.Items[iLauf]))<2)
then Listbox_Seitenwoerter.Items.Delete(iLauf);
iLauf:=iLauf+1;
iEnd:=Listbox_Seitenwoerter.Items.Count;
end;
//while
end;