(13-04-2017, 12:55 AM)Delphi4Us كتب : هذا الكود سيعرض لك ما تحدده فقط صورة لينك او اي شئ من الصفحة

كود :

Title: How to get the Selected Objects in a TWebbrowser procedure TForm1.Button1Click(Sender: TObject); begin  if Webbrowser1.OleObject.Document.Selection.type = 'Control' then  begin    if Webbrowser1.OleObject.Document.Selection.CreateRange.CommonParentElement.tagName =      'IMAGE' then      ShowMessage('An Image is selected');  end  else  begin    if Webbrowser1.OleObject.Document.Selection.createRange.Text = '' then      ShowMessage('Nothing is selected - ');  end; end;

---

هذا سوف يعطيك كل الروابط التي بالصفحة

كود :

Title: How to list all links of a page of a TWebbrowser procedure TForm1.Button1Click(Sender: TObject); var  i: Integer; begin  for i := 0 to Webbrowser1.OleObject.Document.links.Length - 1 do    Listbox1.Items.Add(Webbrowser1.OleObject.Document.Links.Item(i)); end; {*****************} { if there are frames } procedure TForm1.Button2Click(Sender: TObject); var  u : variant;  v : IDispatch;  s : string;  procedure RecurseLinks(htmlDoc: variant);  var    BodyElement : variant;    ElementCo: variant;    HTMLFrames: variant;    HTMLWnd : variant;    j, i : integer;  begin    if VarIsEmpty(htmlDoc) then      exit;    BodyElement := htmlDoc.body;    if BodyElement.tagName = 'BODY' then    begin      ElementCo := htmlDoc.links;      j := ElementCo.Length - 1;      for i := 0 to j do      begin        u := ElementCo.item(i);        s := u.href;        listLinks.Items.Add(s);      end;    end;    HTMLFrames := htmlDoc.Frames;    j := HTMLFrames.length - 1;    for i := 0 to j do    begin      HTMLWnd := HTMLFrames.Item(i);      RecurseLinks(HTMLWnd.Document);    end;  end; // RecurseLinks begin  v := WebBrowser1.document;  listLinks.Clear;  RecurseLinks(v); end;

---

هذا سيعطيك النص الذي تضلله

كود :

Title: How to find and highlight text in TWebBrowser private  procedure SearchAndHighlightText(aText: string);     {....} uses mshtml; { .... } procedure TForm1.SearchAndHighlightText(aText: string); var  tr: IHTMLTxtRange; //TextRange Object begin  if not WebBrowser1.Busy then  begin    tr := ((WebBrowser1.Document as IHTMLDocument2).body as IHTMLBodyElement).createTextRange;    //Get a body with IHTMLDocument2 Interface and then a TextRang obj. with IHTMLBodyElement Intf.    while tr.findText(aText, 1, 0) do //while we have result    begin      tr.pasteHTML('' +        tr.htmlText + '');      //Set the highlight, now background color will be Lime      tr.scrollIntoView(True);      //When IE find a match, we ask to scroll the window... you dont need this...    end;  end; end; Usage Example: procedure TForm1.Button1Click(Sender: TObject); begin  SearchAndHighlightText('delphi'); end;

---

جرب هذا يعطيك ايضا الروابط

كود :

Title: get all Frame URLs in TWebbrowser? procedure TForm1.Button2Click(Sender: TObject); var  i: Integer; begin  Listbox1.Clear;  //if frames available  if Webbrowser1.OleObject.Document.Frames.Length  0 then  begin    //walk through all frames and get the url    //to the Listbox    for i := 0 to Webbrowser1.OleObject.Document.Frames.Length - 1 do    begin      Listbox1.Items.Add(Webbrowser1.OleObject.Document.Frames.item(i).Document.URL);    end;  end; end;

(13-04-2017, 08:58 PM)Delphi4Us كتب : هل افهم من كلامك ان هناك صورة واحدة فقط باللاحقة JPG ام ان هناك اكثر من صور في الصفحة
وبحال كان هناك اكثر من صورة
هل تريد ان تظهر روابطهم كلهم ام تريد اظهار رابط صورة واحدة معينة فقط

(13-04-2017, 11:51 PM)Delphi4Us كتب : مع انك تستطيع جلب ما تريد مباشرة من الاداة TWEB ولكن على العموم
انت بحاجة الى البحث عن كلمات اساسية متواجدة دائما
وعندك الكلمة الاولى هي HTTP ونهاية الكلمة هي .JPG 
اذا تبحث عن الكلمة الاولى وتعرف موقعها وكذلك مع الثانية
تم تقوم بنسخ الجملة التي تقع بين العددين
لا اعرف لضيق الوقت اجريت اختبار سريع لمثال يبدوا انه نفسه الذي معك وعدلت فيه قليلا

حاول ان تجربه اكثر من مرة

كود :

var  i,k1,k2: Integer;  a: string; begin  edt2.Text:='https';  mmo1.Lines.Add('');  mmo1.Lines.Text := ' ' + mmo1.Lines.Text;  for i := 0 to Length(mmo1.Lines.Text) - Length(edt2.Text) do  begin    a := Copy(mmo1.Lines.Text, i, Length(edt2.Text));    if chk1.Checked = True then    begin      if a = edt2.Text then      begin        find := True;        x    := 2;        mmo1.Lines.Text := Copy(mmo1.Lines.Text, 2, Length(mmo1.Lines.Text) - 1);        mmo1.SetFocus;        mmo1.SelStart  := i - 2;        mmo1.SelLength := Length(edt2.Text);        break;      end;    end    else    begin      if lowercase(a) = lowercase(edt2.Text) then      begin        mmo1.Lines.Text := Copy(mmo1.Lines.Text, 2, Length(mmo1.Lines.Text) - 1);        find := True;        x    := 2;        mmo1.SetFocus;        mmo1.SelStart  := i - 2;        mmo1.SelLength := Length(edt2.Text);        break;      end;    end;  end;  k1:=i;  edt2.Text:='.jpg';  i:=0;  mmo1.Lines.Add('');  mmo1.Lines.Text := ' ' + mmo1.Lines.Text;  for i := 0 to Length(mmo1.Lines.Text) - Length(edt2.Text) do  begin    a := Copy(mmo1.Lines.Text, i, Length(edt2.Text));    if chk1.Checked = True then    begin      if a = edt2.Text then      begin        find := True;        x    := 2;        mmo1.Lines.Text := Copy(mmo1.Lines.Text, 2, Length(mmo1.Lines.Text) - 1);        mmo1.SetFocus;        mmo1.SelStart  := i - 2;        mmo1.SelLength := Length(edt2.Text);        break;      end;    end    else    begin      if lowercase(a) = lowercase(edt2.Text) then      begin        mmo1.Lines.Text := Copy(mmo1.Lines.Text, 2, Length(mmo1.Lines.Text) - 1);        find := True;        x    := 2;        mmo1.SetFocus;        mmo1.SelStart  := i - 2;        mmo1.SelLength := Length(edt2.Text);        break;      end;    end;  end;  k2:=i;  mmo1.SelStart  := k1-2 ;  mmo1.SelLength := k2-k1+Length(edt2.Text)  ; // ShowMessage('');   mmo1.SetFocus; // mmo1.SelStart  := i - 2; end;