Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Corba";
Текущий архив: 2008.06.29;
Скачать: [xml.tar.bz2];

Вниз

IHTMLDocument2 получение всех ссылок   Найти похожие ветки 

 
Dmitrij_K   (2006-05-06 16:28) [0]

Чтобы получить ссылки использую такой код
[code=delphi]
unit uParseHTML;    
interface    
uses Classes, mshtml, ActiveX, Variants;    
procedure Init_parser;    
procedure Close_parser;    
procedure daj_all_link(var aBuff:AnsiString;aLinkList,aTextList:TStrings);    
implementation    
var    
 iDoc : IHTMLDocument2;    
procedure Init_parser;    
begin    
 idoc := CoHTMLDocument.Create as IHTMLDocument2;    
end;    
procedure Close_parser;    
begin    
 if assigned(iDoc) then    
 begin    
   iDoc.Close;    
   iDoc := nil;    
 end;    
end;    
procedure set_buff(var aBuff:AnsiString);    
var v : Variant;    
begin    
 v    := VarArrayCreate([0, 0], varVariant);    
 v[0] := aBuff;    
 idoc.clear;    
 idoc.write(PSafeArray(TVarData(v).VArray));    
end;    
procedure daj_all_link_2(var aLinkList,aTextList:TStrings);    
var    
 v : OleVariant;    
 j : Integer;    
 d : IDispatch;    
 e : IHTMLElement;    
 l : IHTMLAnchorElement;    
 c : IHTMLElementCollection;    
 z : string;    
 s : string;    
begin    
 aLinkList.Clear;    
 aTextList.Clear;    
 v := "A";    
 d := iDoc.all.tags(v);    
 if assigned(d) then    
 begin    
   d.QueryInterface(IHTMLElementCollection, c);    
   if assigned(c) then    
   begin    
     for j:=1 to c.Get_length do    
     begin    
       d := c.item(pred(j),0);    
       d.QueryInterface(IHTMLElement, e);    
       d.QueryInterface(IHTMLAnchorElement, l);    
       if assigned(e) and assigned(l) then    
       begin    
         z := l.href;    
         if aLinkList.IndexOf(z)=-1 then    
         begin    
           aLinkList.Add(z);    
           aTextList.Add(e.innerText);    
         end    
       end    
     end    
   end    
 end    
end;    
procedure daj_all_link(var aBuff:AnsiString;aLinkList,aTextList:TStrings);    
begin    
 set_buff(aBuff);    
 daj_all_link_2(aLinkList,aTextList);    
end;    
end.
[/code]

У ссылок с относительным путем получаю такую хрень
[b]about:blank/path/name.htm[/b]

Как в IHTMLDocument2 прописать текуший URL, чтобы ссылки нормальные получались?


 
Pavlo ©   (2006-05-07 14:53) [1]

Ну как догадаться не мудренно.
Если такую фигню пишет [b]about:blank/path/name.htm[/b]
ТО ты находишься к примеру на http://www.delphimaster.ru/ адальше идёт папка на под директорию.Следовательно пишем процедуру,получаем весь урл если урл нормальный(типа первые символы не равны [b]about:blank/) то делай шо ты хош,а если не нормальный то вызываем процедуру создания нормального урл.передаем урл и вырезаем символы [b]about:blank/ и вставляем урл на котором находимся(главный)+всё что пошло после [b]about:blank/
Стучи в асю может напишу процедуры если время будет .
И напиши какую ты прогу хош ,мож у меня шо то подобное уже есть
Ася 229-493-799


 
Dmitrij_K   (2006-05-08 11:09) [2]

Если кому интересно
http://forum.vingrad.ru/index.php?showtopic=94888


 
Шпиён   (2006-05-14 01:41) [3]

Если интересно, то можно сделать проще
http://forum.sources.ru/index.php?showtopic=137176&st=0



Страницы: 1 вся ветка

Форум: "Corba";
Текущий архив: 2008.06.29;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.043 c
2-1212491944
ZENsan
2008-06-03 15:19
2008.06.29
Interface...


2-1212586709
Михаил
2008-06-04 17:38
2008.06.29
Помогите с формой


15-1211104921
Дмитрий С
2008-05-18 14:02
2008.06.29
Фишка


15-1210925436
Ega23
2008-05-16 12:10
2008.06.29
Года полтора-два назад тема была


15-1211204540
LightRipple
2008-05-19 17:42
2008.06.29
Блокировка логических дисков





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский