델파이 기초 - WebBrowser 기능 정리

델파이 기초 - WebBrowser 기능 정리

 

WebBrowser에 글추가

 

procedure WebString(Web: TWebBrowser; msg : string);
var tmp : string;
begin
  tmp := Web.OleObject.Document.Body.innerHTML;
  tmp := tmp + msg;
  Web.OleObject.Document.Body.innerHTML := tmp;
  Web.OleObject.Document.Body.Doscroll('PageDown');
end;

웹브라우져 컨트롤을 이용할때, enter key와 ctrl+c/x 동작 하도록 하기

 

작성자   : 임기택 [xor74] 

IOleInPlaceActiveObject로 검색을 해보니 비슷한 문서들이 많이 있긴 하던데,
대부분 enter key에 대한 언급 뿐이더군요.
그래서 ctrl+c/ctrl+x에 대해서도 처리하도록 조금 수정 해 봤습니다.
참고하세요..

-------------------------------------------------------------------------------------
uses
 ActiveX, ClipBrd;

var
 Form1: TForm1;
 FOleInPlaceActiveObject: IOleInPlaceActiveObject;
 SaveMessageHandler: TMessageEvent;

procedure TForm1.FormActivate(Sender: TObject);
begin
 SaveMessageHandler := Application.OnMessage;
 Application.OnMessage := MyMessageHandler;
end;

procedure TForm1.FormDeactivate(Sender: TObject);
begin
 Application.OnMessage := SaveMessageHandler;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Application.OnMessage := SaveMessageHandler;
 FOleInPlaceActiveObject := nil;
end;

procedure TForm1.MyMessageHandler(var Msg: TMsg; var Handled: Boolean);
const
 DialogKeys: set of Byte = [VK_LEFT, VK_RIGHT, VK_BACK, VK_UP, VK_DOWN,
   $30..$39, $41..$42, $44..$55, $57, $59..$5A];
begin
 { exit if we don't get back a webbrowser object }
 if WebBrowser1 = nil then
 begin
   Handled := False;
   Exit;
 end;

 if (Msg.hwnd = WebBrowser1.Handle) or (IsChild(WebBrowser1.Handle, Msg.hwnd)) then
 begin
   if ((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP)) and (GetKeyState(VK_CONTROL) < 0) then
   begin
     Handled := (WebBrowser1.Application as IOleInPlaceActiveObject).TranslateAccelerator(Msg)=S_OK;
     if (Msg.wParam = 67) then
     Clipboard.AsText := WebBrowser1.OleObject.Document.selection.createRange().text;
     if (Msg.wParam = 88) then
       WebBrowser1.OleObject.Document.selection.createRange().text := ';
     WebBrowser1.OleObject.Document.selection.createRange().select();
   end
   else
   begin
     Handled := not word(Msg.wParam) in [byte('A')..byte('Z'),VK_RETURN];
     if Handled or (Msg.wParam = VK_RETURN) then
       Handled := (WebBrowser1.Application as IOleInPlaceActiveObject).TranslateAccelerator(Msg)=S_OK;
   end
 end;

end;

 

WebBrowser에 메인과 프레임 읽기 완료 알기

 

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
 CurWebrowser: IWebBrowser;
 TopWebBrowser: IWebBrowser;
 Document: OleVariant;
 WindowName: string;
begin
 CurWebrowser := pDisp as IWebBrowser;
 TopWebBrowser := (Sender as TWebBrowser).DefaultInterface;
 if CurWebrowser = TopWebBrowser then
   Memo1.Lines.Add('Complete document was loaded')
 else;
 begin
   Document := CurWebrowser.Document;
   WindowName := Document.ParentWindow.Name;
   Memo1.Lines.Add(Format('Frame "%s" was loaded', [WindowName]));
 end;
end;

 

TWebBrowser에서 특정문자를 부각시키고 위치하기

 

TWebBrowser에 불려진 윕분서에서 특정 문자열을 찾아서 부각시키고
찾은 문자열에 화면을 스크롤하여 보여줍니다.

아래의 코드는 찾은 문자열의 배경을 빨간색으로 바꾸어 줍니다.
prefix 를 바꾸어주면 다르게도 가능하겠죠. ^^

TEmbeddedWB에서도 WBLocateHighlight(WB: TWebBrowser; Text: string)을
WBLocateHighlight(WB: TEmbeddedWB; Text: string)으로 바꾸어주면 사용 할 수 있습니다.


uses mshtml;

procedure WBLocateHighlight(WB: TWebBrowser; Text: string) ;
const
  prefix = '<span style="color:white; background-color: red;">';
  suffix = '</span>';
var
  tr: IHTMLTxtRange;
begin
  if Assigned(WB.Document) then
  begin
    tr := ((wb.Document AS IHTMLDocument2).body AS IHTMLBodyElement).createTextRange;
    while tr.findText(Text, 1, 0) do
    begin
      tr.pasteHTML(prefix + tr.htmlText + suffix) ;
      tr.scrollIntoView(True) ;
    end;
  end;
end;

사용 방법은 
WBLocateHighlight(WebBrowser1,'musk95') ;
입니다.

 

WebBrowser를 이용하여 폼 필드에 값 할당과 submit

 

i) 직접 접근 방법

 WebBrowser1.OleObject.Document.frmMain.userID.value := 'k133';
                             // 폼 이름과 폼 필드 이름을 직접 코딩
 WebBrowser1.OleObject.Document.frmMain.submit;
 => "구성원이 없습니다." 라는 에러 발생합니다.


ii) 이름으로 접근 방법

 WebBrowser1.OleObject.Document.all.item('userID').value := 'k133';

 WebBrowser1.OleObject.Document.all.item('submit').Click;

 

빈화면을 만들기

procedure NewDocument;
var
 C: array[0..MAX_PATH-1] of Char;
 FileName: String;
begin
 GetTempPath( MAX_PATH, C );
 FileName := C;
 if FileName[ Length( FileName ) ] <> '\' then FileName := FileName + '\';
 FileName := FileName + 'test.htm';
 with TFileStream.Create( FileName, fmCreate ) do Free;
 WebBrowser.Navigate( FileName );
end;

소스보기

 

procedure 프로시져명;
var MyDocument: OleVariant;
begin
  MyDocument := WebBrowser1.Document;
  Memo1.Lines.Clear;
  // HTML 소스 보기
  Memo1.Lines.Add(MyDocument.DocumentElement.InnerHTML);
  // 일반 내용 보기
  Memo1.Lines.Add(WebBrowser1.OleObject.Document.DocumentElement.InnerText);
  Memo1.Visible:= True;
  Memo1.Align:= alClient;
  if Memo1.CanFocus then
  Memo1.SetFocus;
end;

 

싸이트이동

WebBrowser1.Navigate('싸이트명');

WebBrowser1.Navigate('About:Blank'); //웹브라우져초기화

 

현재오픈된 URL가지고 오기

procedureOKGetURL(AStrings:TStrings); 

functionWebBrowserCheck(constWebb:IWebBrowser2):Boolean; 
var WebV:Variant; 
    Buf:string; 
begin
  WebV:=Webb; 
  Result:=False; 
  if Assigned(Webb)then 
  try 
    Buf:=WebV.Document.URL; 
    Result:=True; 
  except; 
  end; 
end; 

var 
  Count,i:integer; 
  mShellWindow:IShellWindows; 
  Webb:IWebBrowser2; 
  WebV:Variant; 
begin 
  mShellWindow:=CreateComObject(CLASS_ShellWindows) as IShellWindows; 
  Count:=mShellWindow.Count; 
  fori:=0 to Count-1 do
  begin 
    ifWebBrowserCheck(mShellWindow.Item(i)asIWebBrowser2) then
    begin 
      try
        Webb:=IWebBrowser2(mShellWindow.Item(i));
        WebV:=Webb; 
        AStrings.Add(WebV.Document.URL);
      except; 
      end;     
    end;
  end;
end;

 

WebBrowser에서 이미지 찾아서 클릭하기

 

uses
  MSHTML;

var
  iDoc: IHtmlDocument2;
  i: integer;
  ov: OleVariant;
  iDisp: IDispatch;
  iColl: IHTMLElementCollection;
  InputImage: HTMLInputImage;
begin
  WebBrowser1.ControlInterface.Document.QueryInterface(IHtmlDocument2, iDoc);
  if not Assigned(iDoc) then
  begin
    Exit;
  end;
  ov := 'INPUT';
  iDisp := iDoc.all.tags(ov);
  if Assigned(IDisp) then
  begin
    IDisp.QueryInterface(IHTMLElementCollection, iColl);
    if Assigned(iColl) then
    begin
      for i := 1 to iColl.Get_length do
      begin
        iDisp := iColl.item(pred(i), 0);
        iDisp.QueryInterface(HTMLInputImage, InputImage);
        if Assigned(InputImage) then
        begin
          if InputImage.Name = 'submit' then
          // if the name is submit / falls der name submit lautet
          begin
            InputImage.Click;  // click it / klick es
          end;
        end;
      end;
    end;
  end;
end;

// 2.

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Word;
  Document: IHtmlDocument2;
  str: string;
begin
  // Schleife über alle Bilder im Webbrowser
  for i := 0 to WebBrowser1.OleObject.Document.Images.Length - 1 do
  begin
    Document := WebBrowser1.Document as IHtmlDocument2;
    // URL auslesen
    Str := (Document.Images.Item(i, 0) as IHTMLImgElement).Href;
    // Dateiname des Bildes überprüfen
    if Pos('submit_icon.gif', str) <> 0 then
    begin
      ((Document.Images.Item(i, 0) as IHTMLImgElement) as IHTMLElement).Click;
    end;
  end;
end;