Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2002.11.14;
Скачать: CL | DM;

Вниз

Уважаемые Мастера! Как   Найти похожие ветки 

 
Outlier   (2002-10-03 18:41) [0]

Откройте секрет :-) ПЛЗ(!), ну никак не выходит ->

Есть Эксплорер (или Нетскп,Опера), в нем страница, в странице -
выделен некий ТЕКСТ, как этот текст извлечь???

Разметка, стиль и пр. не интерисует, только содержание...

Всем зарание сенкс ;-)

П.С. Любителей OCR - просьба не беспокоится...
ищется решение на уровне WinAPI,Hooks,Msg(s),etc...


 
int64 ©   (2002-10-03 23:47) [1]

Из VCL здесь только кнопка и Мемо (для наглядности).

uses ..., MSHTML;

type
TObjectFromLResult = function(LRESULT: lResult; const IID: TGUID; WPARAM: wParam; out pObject): HRESULT; stdcall;

function GetSelTextFromHWND_IE(WHandle: HWND; var Text: string): HRESULT;
var
hInst, Wnd: HWND;
lRes: Cardinal;
MSG: Integer;
ObjectFromLresult: TObjectFromLresult;
Doc: IHTMLDocument2;
begin
hInst := LoadLibrary("Oleacc.dll");
@ObjectFromLresult := GetProcAddress(hInst, "ObjectFromLresult");
if @ObjectFromLresult <> nil then begin
try
Wnd := FindWindowEX(WHandle, 0, "Shell DocObject View", nil);
Wnd := FindWindowEX(Wnd, 0, "Internet Explorer_Server", nil);
MSG := RegisterWindowMessage("WM_HTML_GETOBJECT");
SendMessageTimeOut(Wnd, MSG, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes);
Result := ObjectFromLresult(lRes, IHTMLDocument2, 0, Doc);
if assigned(Doc) then
Text:= (Doc.selection.createRange as IHTMLTxtRange).text;
finally
FreeLibrary(hInst);
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Wnd: HWND;
Text: string;
begin
Wnd := FindWindow("IEFrame", nil);
if Wnd = 0 then
begin
showmessage("No Running instance of Internet Explorer");
exit;
end;
if GetSelTextFromHWND_IE(Wnd, Text)=S_OK then
Memo1.Text:= Text;
end;


Данный пример получает выделенный текст из IE.
Для других браузеров, имхо достаточно будет вызовов нескольких API функций (типа GetWindowText). Во всяком случае, универсального решения для всех сразу браузеров не существует.


 
Outlier   (2002-10-06 11:04) [2]

Спасибо!



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

Текущий архив: 2002.11.14;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.02 c
3-45780
vic_vm
2002-10-24 14:32
2002.11.14
Глюк омпонента TIBEvents из IBX


6-46033
Vasily5000
2002-09-17 04:31
2002.11.14
Delphi, Cgi and MIME.


3-45665
NightCon
2002-10-24 07:09
2002.11.14
БД не работает по сети


14-46128
JavascripT
2002-10-27 12:01
2002.11.14
Русский Размер


6-46032
Nubie
2002-07-15 15:13
2002.11.14
Кто работал с почтой?