导航
  • 主页
  • Windows SDK/API
  • 基础类
  • ActiveX
  • 数据库及相关技术
  • 网络及通讯开发
  • VCL组件使用和开发
  • 问答

获取网页文字的delphi代码改写成BCB

木叶流丹 汐彤电子 工程师  2016-11-11 10:46:56
想请人把这个delphi的代码,改写成c++Builder。
主文件:
unit Main;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,Forms,
Dialogs,MSHTML,SHDocVw, StdCtrls,ActiveX,UnitHookConst,ExtCtrls,StrUtils,
DB,ADODB;

type
TfrmMain = class(TForm)
btnOk: TButton;
edtKey: TEdit;
lbl1: TLabel;
edtQt: TEdit;
lbl2: TLabel;
tmrMain: TTimer;
conQt: TADOConnection;
qryQt: TADOQuery;

procedure btnOkClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure tmrMainTimer(Sender: TObject);
private
{ Private declarations }
procedure wndproc(var messages:TMessage );override ;
public
{ Public declarations }
end;

const MessageID=WM_user+100;

var
frmMain: TfrmMain; rect:TRect;
threadid:Integer ;
hMappingFile:THandle;
pMem:PShareMem ;
iewinhandle,iehandle:THandle;
iewebbrowser:IWebBrowser2 ;
x,y:integer;

document:IHTMLDocument2 ;
elem:IHTMLElement ;

implementation

{$R *.dfm}
function StartHook(sender:HWND;messageID:Word):BOOL ;stdcall ;external 'DllMouse.dll';
function StopHook:BOOL;stdcall ;external 'DllMouse.dll';
const RSPSIMPLESERVICE = 1; RSPUNREGISTERSERVICE = 0;

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

function GetIEFromHWND(WHandle: HWND; var IE: IWebbrowser2): HRESULT;
var
hInst: HWND;
lRes: Cardinal;
//tempInt: Cardinal;
MSG: Integer;
pDoc: IHTMLDocument2;
ObjectFromLresult: TObjectFromLresult;

begin
Result :=0;
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, 10000, lRes);
//tempInt:=0;
Result := ObjectFromLresult(lRes, IHTMLDocument2, 0, pDoc);
//Result :=GetLastError ;
if Result = S_OK then
(pDoc.parentWindow as IServiceprovider).QueryService(IWebbrowserApp, IWebbrowser2, IE);
finally
FreeLibrary(hInst);
end;
end;
end;

procedure clear;
begin
frmMain.edtQt.Text :='';
frmMain.edtKey.Text :='';
end;

function timerfunc(info:Pointer):Integer ;stdcall ;
begin
Sleep(10);

if iehandle <>pMem.data2.hwnd then
begin
iehandle:= pMem.data2.hwnd ;
GetIEFromHWND(iehandle,iewebbrowser );
end;
Document := iewebbrowser.Document as IHtmlDocument2;
if Assigned(Document) then
begin
elem:=document.elementFromPoint(x-rect.Left ,y-rect.Top );
frmMain.edtQt.Text := RightStr(elem.innerText,Length(elem.innerText)-1) ;
frmMain.edtQt.Text := StringReplace(frmMain.edtQt.Text,' ','',[rfReplaceAll]);
frmMain.edtQt.Text := StringReplace(frmMain.edtQt.Text,' ','',[rfReplaceAll]);

end;
end;

procedure TfrmMain.wndproc(var messages: TMessage);
var
// threadid:Cardinal ;
s:array[0..255]of char;

begin
if pMem = nil then
begin
hMappingFile := OpenFileMapping(FILE_MAP_WRITE,False,MappingFileName);
if hMappingFile=0 then Exception.Create('不能建立共享内存!');
pMem := MapViewOfFile(hMappingFile,FILE_MAP_WRITE or FILE_MAP_READ,0,0,0);
if pMem = nil then
begin
CloseHandle(hMappingFile);
Exception.Create('不能映射共享内存!');
end;
end;
if pMem = nil then exit;
if Messages.Msg = MessageID then
begin
x:=pMem.data2.pt.x;
y:=pMem.data2.pt.y;

//self.caption:='x='+inttostr(x)+' y='+inttostr(y) +' handle='+inttostr(pmem.data2.hwnd );

if(pmem.data2.hwnd =0)then
begin
//inherited ;
exit;
end;
FillChar (s,255,0);
GetClassName(pmem.data2.hwnd ,s,255);
GetWindowRect(pmem.data2.hwnd ,rect ) ;
if(lstrcmp(s,'Internet Explorer_Server')=0)then
begin
if tmrMain.Enabled =False then
tmrMain.Enabled :=true;
end
else
begin
clear;
end;
//exit ;
end
else Inherited;
end;

procedure TfrmMain.btnOkClick(Sender: TObject);
begin
if TButton(Sender).Caption ='开始获取' then
begin
if startHook(Self.Handle ,MessageID ) then
begin
TButton(Sender).Caption :='停止获取' ;
lbl1.Visible := True;
lbl2.Visible := True;
edtKey.Visible := True;
edtQt.Visible := True;
end;
end
else
begin
if stopHook then
begin
TButton(Sender).Caption :='开始获取' ;
lbl1.Visible := False;
lbl2.Visible := False;
edtKey.Visible := False;
edtQt.Visible := False;
end;

end;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
var FileName: string;
errNO: integer;
// hMutex: HWND;
begin
// hMutex := CreateMutex(nil, False, pchar(Application.title));
errNO := GetLastError;
if errNO = ERROR_ALREADY_EXISTS then
begin //检测是否重复运行
Application.MessageBox('软件已经在运行', '助手', MB_OK);
Application.Terminate;
end
else
begin
iehandle :=0;
lbl1.Visible := False;
lbl2.Visible := False;
edtKey.Visible := False;
edtQt.Visible := False;
Top := 0;
Left := Trunc((Screen.Width-frmMain.Width)/2);
end;
end;

procedure TfrmMain.tmrMainTimer(Sender: TObject);
begin
tmrMain.Enabled :=false;
timerfunc(nil);
end;

initialization
OleInitialize(nil);
Coinitialize(nil);
finalization
OleUninitialize;
CoUninitialize;
end.


UnitHookConst文件:
unit UnitHookConst;

interface
uses windows;
const
MappingFileName='_MyDllMouse';

type
TShareMem=record
data1:array [1..2] of DWORD;
data2:TMOUSEHOOKSTRUCT;
IfRbutton:boolean;
buffer:array[0..1024]of char;
end;
PShareMem=^TShareMem;

implementation

end.

...全文
155 点赞 收藏 1
写回复
1 条回复
切换为时间正序
请发表友善的回复…
发表回复
不需要改,CB直接支持使用Delphi单元,你把.pas添加到CB工程中,编译,它就会自动生成.pas的接口.hpp文件,然后你在C++代码中可以直接使用。
回复
发动态
发帖子
C++ Builder
创建于2007-08-02

1.3w+

社区成员

C++ Builder相关内容讨论区
申请成为版主
社区公告
暂无公告