⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unitmainform.~pas

📁 自动点击网页的连接
💻 ~PAS
字号:
unit UnitMainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,Forms, 
  Dialogs, OleCtrls, SHDocVw, EmbeddedWB, StdCtrls, MSHTML,ActiveX,Comobj;

const
  loginURL ='http://verkopen.marktplaats.nl/useradmin/my.php';
  postURL  ='http://verkopen.marktplaats.nl/select_category.php';
type
  TState = (stLogin, stFill, stloading, stLoop );
  TForm1 = class(TForm)
    browser: TEmbeddedWB;
    Button1: TButton;
    edtURL: TEdit;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure browserDocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
  private
    FcurFrame: IWebbrowser2;
    FState: TState;
    { Private declarations }
    function GetFrame(doc: IHtmlDocument2;FrameNo: Integer): IWebbrowser2;
    procedure SetcurFrame(const Value: IWebbrowser2);
    procedure SetState(const Value: TState);

  public
    { Public declarations }
    property curFrame : IWebbrowser2 read FcurFrame write SetcurFrame;
    function setElementValue(ElementName ,Value:string): boolean; overload;
    function setElementValue(ElementIndex:integer ; Value:string): boolean; overload;
    property State : TState read FState write SetState;
  end;

var
  Form1: TForm1;

implementation                               

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
browser.Go(edtURl.Text);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  i,j: Integer;
  web :IWebBrowser2;
  All: IHtmlElementCollection;
begin

  if (State = stlogin )then
  begin
    browser.Go(loginURL);
  end;

end;
  {  web:=getframe(browser.GetDocument as IHTMLDocument2,0);
  all:=(web.document as IHTMLDocument2).all ;
  showmessage(all.toString);

  for j:=0 to all.length -1 do
  begin
      showmessage((all.item(j,0) as IHTMLElement).innerhtml);
  end;
}






function TForm1.GetFrame(doc: IHtmlDocument2;
  FrameNo: Integer): IWebbrowser2;
var
  OleContainer: IOleContainer;
  enum: IEnumUnknown;
  unk: IUnknown;
  Fetched: PLongint;
begin
  if Assigned(Doc) then
  begin
    Fetched := nil;
    OleContainer := doc as IOleContainer;
    OleContainer.EnumObjects(OLECONTF_EMBEDDINGS, Enum);
    Enum.Skip(FrameNo);
    Enum.Next(1, Unk, Fetched);
    Result := Unk as IWebbrowser2;
  end else Result := nil;
end;





procedure TForm1.SetcurFrame(const Value: IWebbrowser2);
begin
  FcurFrame := Value;
end;

function TForm1.setElementValue(ElementName, Value: string): boolean;
begin

result:= true;
end;

function TForm1.setElementValue(ElementIndex: integer;
  Value: string): boolean;
begin
result:= true;
end;

procedure TForm1.SetState(const Value: TState);
begin
  FState := Value;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  State := stLogin;
end;

procedure TForm1.browserDocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  if state = stLogin then
  begin

  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -