主页
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.