Sorunumun büyük bir bölümünü hallettim...Herkese Teşekkür Ederim...
Kod: Tümünü seç
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, MSHTML, ActiveX, OleCtrls, SHDocVw, StdCtrls;
type
TForm1 = class(TForm)
SourceView: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
const
RSPSIMPLESERVICE = 1;
RSPUNREGISTERSERVICE = 0;
implementation
{$R *.dfm}
type
TObjectFromLResult = function(LRESULT: lResult; const IID: TIID; WPARAM: wParam; out pObject): HRESULT; stdcall;
//This function detects the Window
function GetIEFromHWND(WHandle: HWND; var IE: IWebbrowser2): HRESULT;
var
hInst: HWND;
lRes: Cardinal;
MSG: Integer;
pDoc: IHTMLDocument2;
ObjectFromLresult: TObjectFromLresult;
begin
hInst := LoadLibrary('Oleacc.dll');
@ObjectFromLresult := GetProcAddress(hInst, 'ObjectFromLresult');
if @ObjectFromLresult <> nil then begin
try
MSG := RegisterWindowMessage('WM_HTML_GETOBJECT');
SendMessageTimeOut(WHandle, MSG, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes);
Result := ObjectFromLresult(lRes, IHTMLDocument2, 0, pDoc);
if Result = S_OK then
(pDoc.parentWindow as IServiceprovider).QueryService(IWebbrowserApp, IWebbrowser2, IE);
finally
FreeLibrary(hInst);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
All: IHtmlElementCollection;
HtmlElement: IHtmlElement;
I: Integer;
Document: IHtmlDocument2;
IE: IWebBrowser2;
Wnd: HWND;
WndChild: HWND;
begin
Wnd := FindWindow('IEFrame', nil);
if Wnd = 0 then
begin
MessageDlg ('No Running instance of Internet Explorer!',mtError, [mbOK], 0);
end;
// walk Shell DocObject View->Internet Explorer_Server
WndChild := FindWindowEX(Wnd, 0, 'Shell DocObject View', nil);
if WndChild <> 0 then begin
WndChild := FindWindowEX(WndChild, 0, 'Internet Explorer_Server', nil);
if WndChild <> 0 then
begin
GetIEFromHWnd(WndChild, IE); //Get Iwebbrowser2 from Handle
Document := IE.Document as IHtmlDocument2;
if (assigned(Document)) then
begin
All := Document.All;
for I := 0 to All.Length -1 do
begin
HtmlElement := All.item(i,0) as IhtmlElement;
if (assigned(Document)) then
SourceView.Lines.Add (IntToStr(i) + ' ' + HTmlElement.innerHTML);
end;
end;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
sourceview.Text:='';
end;
end.
Bu Kodla İnternet Explorer ın html kodlarını alıyorum...
Kod: Tümünü seç
procedure TForm1.Button3Click(Sender: TObject);
var
ara,str:string;
sayi:integer;
begin
ara:=edit2.Text;
str:=memo1.Text;
if pos(ara,str)>0
then begin
sayi:=pos(ara,str);
showmessage('Aradığınız Kelimeden '+inttostr(sayi)+'. karakterde bulundu')
end else
showmessage('Aradığınız Kelime Yoq');
end;
Bu Kodla içinde Sunucu Bulunamıyor vs yazıyormu diye kontrol ediyorum...
Kod: Tümünü seç
procedure TForm1.Button1Click(Sender: TObject);
var
ShellWindow: IShellWindows;
WB: IWebbrowser2;
spDisp: IDispatch;
IDoc1: IHTMLDocument2;
k: Integer;
begin
ShellWindow := CoShellWindows.Create;
for k := 0 to ShellWindow.Count do
begin
spDisp := ShellWindow.Item(k);
if spDisp = nil then Continue;
spDisp.QueryInterface(iWebBrowser2, WB);
if WB <> nil then
begin
WB.Document.QueryInterface(IHTMLDocument2, iDoc1);
if iDoc1 <> nil then
begin
WB := ShellWindow.Item(k) as IWebbrowser2;
WB.Refresh;
end;
end;
end;
end;
Bu kodlada açık olan tüm pencerelere refresh yapıorum...
Bunları birazdaha değiştirerek amacıma ulaştım.
Şimdi Sadece Tek bir Sorunum var.
Açık olan internet explorer sayfasını sürekli aşağıda nası tutabilirim ?
bir internet explorer sayfası var sürekli kendiliğinden aşağıya indirsende yukarıya çıkıyor içindeki bir script yüzünden.Timer a bağlayarak tutmayı düşünüyorum... Bende bu sayfayı (Handle ını bildiğim veya tüm internet exlorer sayfalarını) nasıl aşağıda tutabilirim.