maryam145
چهارشنبه 06 آبان 1394, 12:21 عصر
ا سلام خدمت دوستان عزیز
من در حال طراحی یک نرم افزار برای افزایش بازدید سایت خودم هستم.
تا ی جایی برنامه و نوشتم ولی مشکل داره از دوستان اگر کسی تو این زمینه آشنایی داره ممنون میشم راهنمایی کنه : اینم کدهام :
unit UnitMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,MSHTML,ExtCtrls, OleCtrls, SHDocVw;
type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
Timer1: TTimer;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmMain: TForm1;
i:Integer;
elem:IHTMLElement;
implementation
uses Math;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('www.google.com');
end;
function GetElementById(const Doc: IDispatch; const Id: string): IDispatch;
var
Document: IHTMLDocument2; // IHTMLDocument2 interface of Doc
Body: IHTMLElement2; // document body element
Tags: IHTMLElementCollection; // all tags in document body
Tag: IHTMLElement; // a tag in document body
I: Integer; // loops thru tags in document body
begin
Result := nil;
if not Supports(Doc, IHTMLDocument2, Document) then
raise Exception.Create('Invalid HTML document');
if not Supports(Document.body, IHTMLElement2, Body) then
raise Exception.Create('Can''t find <body> element');
Tags := Body.getElementsByTagName('*');
for I := 0 to Pred(Tags.length) do
begin
Tag := Tags.item(I, EmptyParam) as IHTMLElement;
if AnsiSameText(Tag.id, Id) then
begin
Result := Tag;
Break;
end;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
elem:= GetElementById(WebBrowser1.Document,'lst-ib') as IHTMLElement;
if Assigned(elem) then
elem.innerHTML:='aseman';
end;
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
Timer1.Enabled:=True;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
end;
end.
من در حال طراحی یک نرم افزار برای افزایش بازدید سایت خودم هستم.
تا ی جایی برنامه و نوشتم ولی مشکل داره از دوستان اگر کسی تو این زمینه آشنایی داره ممنون میشم راهنمایی کنه : اینم کدهام :
unit UnitMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,MSHTML,ExtCtrls, OleCtrls, SHDocVw;
type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
Timer1: TTimer;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmMain: TForm1;
i:Integer;
elem:IHTMLElement;
implementation
uses Math;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('www.google.com');
end;
function GetElementById(const Doc: IDispatch; const Id: string): IDispatch;
var
Document: IHTMLDocument2; // IHTMLDocument2 interface of Doc
Body: IHTMLElement2; // document body element
Tags: IHTMLElementCollection; // all tags in document body
Tag: IHTMLElement; // a tag in document body
I: Integer; // loops thru tags in document body
begin
Result := nil;
if not Supports(Doc, IHTMLDocument2, Document) then
raise Exception.Create('Invalid HTML document');
if not Supports(Document.body, IHTMLElement2, Body) then
raise Exception.Create('Can''t find <body> element');
Tags := Body.getElementsByTagName('*');
for I := 0 to Pred(Tags.length) do
begin
Tag := Tags.item(I, EmptyParam) as IHTMLElement;
if AnsiSameText(Tag.id, Id) then
begin
Result := Tag;
Break;
end;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
elem:= GetElementById(WebBrowser1.Document,'lst-ib') as IHTMLElement;
if Assigned(elem) then
elem.innerHTML:='aseman';
end;
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
Timer1.Enabled:=True;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
end;
end.