kaynak koddaki linkleri almak.

[maqro]

s.a

bi download programı yapmak istiyorum, limewire benzeri.

şöyle bir mantık kurdum. googlede ve bazı arama sitelerinde detaylı aramalar yapıp(inurl vb.) şekilde.

sonra açılan sayfaları bi webbrowserde açıp içindeki linkeri almak istiyorum.

şöyle bir kod ile kaynak kodu txt ile açtırıyorum.

Kod: Tümünü seç

procedure WBViewSourceDialog(AWebBrowser: TWebbrowser) ;
const
  CGID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}';
  HTMLID_VIEWSOURCE = 2;

var
  CmdTarget : IOleCommandTarget;
  vaIn, vaOut: OleVariant;
  PtrGUID: PGUID;
begin
  New(PtrGUID) ;
  PtrGUID^ := CGID_WebBrowser;
  if AWebBrowser.Document <> nil then
    try
      AWebBrowser.Document.QueryInterface(IOleCommandTarget, CmdTarget) ;
      if CmdTarget <> nil then
      try
        CmdTarget.Exec(PtrGUID, HTMLID_VIEWSOURCE, 0, vaIn, vaOut) ;
      finally
        CmdTarget._Release;
      end;
    except
   end;
  Dispose(PtrGUID) ;
end;


procedure TForm1.Button2Click(Sender: TObject);
begin
WBViewSourceDialog(webbrowser1);
end;

1. olarak txt açılan html kodlarını memeoda açmak istiyorum ama string hatası veriyor sanırım bir convert yapmalıyım orada. ama neyi strige çevireceğimi çözemedim.

birde farzı misal memeoya kaynak kodları attım içindeki linkleri antireplace ile uzuzn uzadıya uğraşmadan daha kısa bi şekilde yapmak mümkünmü?

[ikutluay]

arama her derdin ilacı...

dün bu konuda bir topic açmıştım... ancak bu resimdeki image linklerini buluyor sen kendine uyarlarsın.

burayada yapıştırdım.

Kod: Tümünü seç

uses mshtml, ActiveX, COMObj, IdHTTP, idURI;

{ .... }

procedure GetImageLinks(AURL: string; AList: TStrings);
var
  IDoc: IHTMLDocument2;
  strHTML: string;
  v: Variant;
  x: Integer;
  ovLinks: OleVariant;
  DocURL: string;
  URI: TidURI;
  ImgURL: string;
  idHTTP: TidHTTP;
begin
  AList.Clear;
  URI := TidURI.Create(AURL);
  try
    DocURL := 'http://' + URI.Host;
    if URI.Path <> '/' then
      DocURL := DocURL + URI.Path;
  finally
    URI.Free;
  end;
  Idoc := CreateComObject(Class_HTMLDocument) as IHTMLDocument2;
  try
    IDoc.designMode := 'on';
    while IDoc.readyState <> 'complete' do
      Application.ProcessMessages;
    v      := VarArrayCreate([0, 0], VarVariant);
    idHTTP := TidHTTP.Create(nil);
    try
      strHTML := idHTTP.Get(AURL);
    finally
      idHTTP.Free;
    end;
    v[0] := strHTML;
    IDoc.Write(PSafeArray(System.TVarData(v).VArray));
    IDoc.designMode := 'off';
    while IDoc.readyState <> 'complete' do
      Application.ProcessMessages;
    ovLinks := IDoc.all.tags('IMG');
    if ovLinks.Length > 0 then
    begin
      for x := 0 to ovLinks.Length - 1 do
      begin
        ImgURL := ovLinks.Item(x).src;
        // The stuff below will probably need a little tweaking
        // Deteriming and turning realtive URLs into absolute URLs
        // is not that difficult but this is all I could come up with
        // in such a short notice.
        if (ImgURL[1] = '/') then
        begin
          // more than likely a relative URL so
          // append the DocURL
          ImgURL := DocURL + ImgUrl;
        end
        else
        begin
          if (Copy(ImgURL, 1, 11) = 'about:blank') then
          begin
            ImgURL := DocURL + Copy(ImgUrl, 12, Length(ImgURL));
          end;
        end;
        AList.Add(ImgURL);
      end;
    end;
  finally
    IDoc := nil;
  end;
end;


// Beispiel:
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
  GetImageLinks('http://www.swissdelphicenter.ch', Memo1.Lines);
end;

[maqro]

hocam teşekkür ederim.