こんにちは、はんばあぐです。

　ブラウザからタイトルや表示中のURLを抜き出すクラスです。
　NN,IE 3,4,5対応です。

　使い方は，クラスからインスタンスを作成し，Getメソッドをするだけ。す
ると，propertyにタイトルとURLが取得されます。


unit UnitGetBrowser;

interface

uses Windows, SysUtils, Messages;

type
  TGetBrowser = class
  private
    FEdithWnd: LongInt;                  // Editのハンドル
    FURL: String;
    FCaption: String;
    function FindEdit(const MainhWnd: Longint; var EdithWnd:Longint):
Boolean;

    procedure GetTitle;
  public
    constructor Create;
    function Get: Boolean;

    property URL:   String read FURL;
    property Title: String read FCaption;
  end;

implementation

uses Dialogs;

const
  BrowserCaption: array[0..2] of String =
                  ('Microsoft Internet Explorer',
                   'Netscape',
                   'ｲﾝﾀｰﾈｯﾄ ｴｸｽﾌﾟﾛｰﾗ');

var
  Hnd: HWND;                            // ブラウザのハンドル
  Caption: String;                      // ブラウザのCaption
  flgHit: Boolean;                      // ブラウザの存在flag
  EnumEdithWnd: Longint;                // Editのハンドル


{ WindowsAPIコールバック関数 ウィンドウの列挙 }
function EnumWindowsProc(Wnd: HWND; lParam: Longint): Bool; stdcall;
var
  szCaption: array [0..255] of Char;
  S: String;
begin
  Result:= True;
  FillChar(szCaption, SizeOf(szCaption), #0);
  GetWindowText(Wnd, szCaption, 255);

  S := szCaption;
  If S = '' then Exit;

  //ShowMessage(S);
  if (Pos(BrowserCaption[0], S) > 0) or
     (Pos(BrowserCaption[1], S) > 0) or
     (Pos(BrowserCaption[2], S) > 0) then
  begin
    If Pos('Hidden', S) >0 then Exit;   // Netscape's hidden frameは除
く
    If Pos('NetscapeSlaveWindow', S) > 0 then Exit;
                                        // NetscapeSlaveWindowを除く
    // ここでタイトルバーに該当する文字のあるウィンドウを検索
    Hnd := Wnd;
    Caption := S;
    flgHit := True;
    //ShowMessage(Caption);
    Result := false;                    // 発見したら終わり
  end;
end;


{ WindowsAPIコールバック関数 子ウィンドウの列挙 }
function EnumChildProc(const hWnd, lParam: Longint): Boolean; stdcall;
var
  cName: array[0..255] of Char;
  Name: String;
begin
  Result := True;
  FillChar(cName, SizeOf(cName), #0);
  if (lParam = 1) then begin
    if GetClassName(hWnd, cName, 255) <> 0 then
    begin
      Name := cName;
      if CompareText('Edit', Name) = 0 then
      begin// クラスがEdit(一行テキストボックス)ならば
        EnumEdithWnd := hWnd;
        // Editを取得してハンドルを格納
        //Result := false;
        {1回目の発見で終わらせるとNNで不具合が起こる。NNでは，
         ブラウザで表示されているeditも拾ってしまうから。
         IEはそうでない。}
      end;
    end;
  end;
end;


{ TGetBrowser }

{ constructor }
constructor TGetBrowser.Create;
begin
  { グローバル変数の初期化 }
  flgHit := false;
  Hnd := 0;                            // ブラウザのハンドル
  Caption := '';                      // ブラウザのCaption
  EnumEdithWnd := 0;                // Editのハンドル
end;


{ Editのハンドルを取得 }
function TGetBrowser.FindEdit(const MainhWnd: Integer;
  var EdithWnd: Integer): Boolean;
begin
  Result := False;
  if IsWindow(MainhWnd) then            // ちゃんと存在するか
  begin
    EnumEdithWnd := 0;
    // 子ウィンドウを検索開始
    EnumChildWindows(MainhWnd, @EnumChildProc, 1);
    if (IsWindow(EnumEdithWnd)) then
    begin
      EdithWnd := EnumEdithWnd;
      Result := True;
    end;
  end;

end;


{ メインルーチン }
function TGetBrowser.Get: Boolean;
var
  Buf: array[0..255] of Char;
begin
  Result := false;

  { ブラウザのハンドルを取得 }
  EnumWindows(@EnumWindowsProc, 0); // ウィンドウリスト取得
  { 各ウィンドウのハンドルをアプリケーション定義のコールバック関数に順
に
    渡すことにより､ 画面上のすべてのトップ レベル ウィンドウを列挙しま
す。}

  If not flgHit then
  begin
   //ShowMessage('ブラウザはありません。');
   Exit;
  end;

  { Editのハンドルを取得 }
  if FindEdit(Hnd, FEdithWnd) then begin
  // Editを取得

    FillChar(Buf, SizeOf(Buf), #0);
    SendMessage(FEdithWnd, WM_GETTEXT, SizeOf(Buf), Integer(@Buf));
    // 文字列の取得
    FURL := Buf;
    FCaption := Caption;
    GetTitle;
    Result := True;
  end;
end;

{ FCaptionからTitleを抜き出す }
procedure TGetBrowser.GetTitle;
var
  P,i: Integer;
  flagHit: Boolean;
begin
  i:=0;// 初期化
  flagHit := false;

  repeat
    P := Pos(BrowserCaption[i], FCaption);
    If P > 4 then
    begin
      flagHit := True;
      Break;
    end;
    Inc(i);
  until i > 2;


  {P := Pos(IECaption, FCaption);
  If P <= 4 then
  begin
    P := Pos(NNCaption, FCaption);
    If P <= 4 then
    begin
      FCaption := '■タイトルなし';
      Exit;
    end;//if
  end;//if }

  If flagHit then
  begin
    FCaption := Copy(FCaption, 1, P-4);
  end else
  begin
    FCaption := '■タイトルなし';
  end;
end;

end.





-----
  99/7/24(土) 07:58  はんばあぐ (BZQ00131)

Original document by はんばあぐ      氏 ID:(BZQ00131)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。