Delphi Tips 
-----------------------------

キーワード:通信

>> Index

05/17 HTMLタグ表記の大文字・小文字変換を行う
09/20 エクスプローラのように、アプリケーションにブラウザページをつくりたい。
09/19 簡易アプリケーション間通信
09/17 起動中のブラウザからURLを取得する/ブラウザにURLをセットする方法
09/09 TWebBrowser を使って HTML の描画イメージを取得する
09/09 サブネットマスク値など TCP/IP 関連パラメータを取得する
09/09 UDP 通信で NoParam ???
09/01 RichEditでHTMLタグを色・書式付き表示をする
02/08 ダイヤルアップネットワークで設定されている接続先を取得する

最終更新: 5761 日前

0326  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 2002/05/17 osamu rev 1.1
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 2002/05/17 osamu 編集
HTMLタグ表記の大文字・小文字変換を行う

コードはSJISを仮定します。

HTMLのコメント部分、""などで囲まれたパラメータ部分などは変換しません。

速度を気にするのであれば IsDBCSLeadByte は避けるべきです。自分で文字テーブルを作れば速くなります。ByteType の方は最適化されていたと思います。通常の用途では速度が気になることは無いかもしれませんね。

function ChangeHTMLTagCase(s:string; Lower:Boolean):string;
const
    sNormal   = 0;
    sInComment= 1;
    sInBracket= 2;
    sInQuote  = 3;
    sInDQuote = 4;
    sAfterEq  = 5;
var
  p: PChar;
  state: Integer;
begin
  state:= 0;
  Result:= s;
  UniqueString(Result);
  p:= PChar(Result);
  while p^<>#0 do begin
    if IsDBCSLeadByte(Ord(p^)) and ((p+1)^<>#0) then begin
      Inc(p, 2);
    end else begin
      case state of
      sNormal:
        if p^='<' then
          if StrLComp(p, '<!--', 4)=0
            then state:= sInComment
            else state:= sInBracket;
      sInComment:
        if p^='-' then
          if StrLComp(p, '-->', 3)=0 then
            state:= sNormal;
      sInBracket:
        case p^ of
        '''': state:= sInQuote;
        '"':  state:= sInDQuote;
        '=':  state:= sAfterEq;
        '>':  state:= sNormal;
        'A'..'Z': if Lower     then p^:= Chr(Ord(p^)+32);
        'a'..'z': if not Lower then p^:= Chr(Ord(p^)-32);
        end;
      sInQuote:
        case p^ of
        '''': state:= sInBracket;
        end;
      sInDQuote:
        case p^ of
        '"':  state:= sInBracket;
        end;
      sAfterEq:
        case p^ of
        '''': state:= sInQuote;
        '"':  state:= sInDQuote;
        ' ':  state:= sInBracket;
        '>':  state:= sNormal;
        end;
      end;
      Inc(p);
    end;
  end;
end;
参照: [Delphi-ML:66840] <WWW> <文字列> <PASCAL>

0266  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 1999/09/19 西坂良幸 rev 1.2
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 1999/09/20 西坂良幸 編集
エクスプローラのように、アプリケーションにブラウザページをつくりたい。

本来なら、DelphiにあるHRMLコンポーネント等を使うんでしょうが、これも、D4まででは、結局AktiveXなので、オフィス97をお持ちの方は、Webブラウザコントロール(WebBrowser)を使うととても簡単です。

これは、オフィス97のCD-ROM
 \VALUPACK\ACCESS\WEBHELP\Webrowse.hlpに
Web ブラウザ コントロールとして、詳しい解説があります。
この実体は、Shdocvw.dll というDLLファイルです。

メニューで[コンポーネント|ActiveXコントロールの取り込み]を開いて下さい。
ダイアログのリストに、Microsoft Internet Contorols(version 1.??) というのがあります。
無かったら、Windows\Systemディレクトリの、Shdocvw.dllを探して追加して下さい。
クラス名の欄に、TWebBrowser_V1、TWebBrowser と表示されたら、インストール実行で、パレットのActiveXページにコンポーネントがインストールされます。

ページ切り替えは省略しますが、
フォームにこのコンポーネントを貼り付け、Alignを決めます。

procedure TForm1.FormShow(Sender: TObject);
begin
  WebBrowser1.GoHome;
end;

とすれば、Web表示が出来上がりです。

URLを指定するときは、Navigate、やNavigate2 メソッドを使います

たとえば、URLがファイル(*.htm)なら、

procedure TForm1.Button1Click(Sender: TObject);
var
 url: WideString;
 flg,Tmp: OleVariant;
begin
  if OpenDialog1.Execute then
  begin
    url := OpenDialog1.FileName;
    flg := 0;
    WebBrowser1.Navigate(url, flg, Tmp, Tmp, Tmp);
  end;
end;


メソッドや、プロパティの詳細は、上記のヘルプファイルを見て下さい。
264番のインターネットエクスプローラオブジェクトと似通っているようです。
参照: [Delphi-ML:25232] [Delphi-ML:37104] <その他Windows関連> <WWW> <ShellApi> <Windows>

0268  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 1999/09/19 K.Takaoka rev 1.1
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 1999/09/19 K.Takaoka 編集
簡易アプリケーション間通信

Win32 環境で 2 つのアプリケーションがお互いに通信する方法は非常に多くあります.
同じコンピュータ上の 2 つのフォーム(ウィンドウ)の間で簡単に通信を行うには WM_COPYDATA というメッセージを使うという方法があります.
これは、2 つのフォームが同じアプリケーションであっても違うアプリケーションであっても問題ありません.

WM_COPYDATA を利用するには, 相手の WindowHandle が分かっている必要があります. Form1 の WindowHandle は Form1.Handle で取得できます.
画面内にあるフォーム(ウィンドウ)の検索は FindWindow API を用いて行うことができます.
ここでは相手の WindowHandle の得方については言及しません.

受信側では TForm1 のインターフェス部にメッセージハンドラを追加します. private でかまわないでしょう.

  private
    procedure WMCopyData(var msg: TWMCopyData);
      message WM_COPYDATA;


送信側では、CopyDataStruct 構造体に送信するデータを格納してから、WM_COPYDATA を送信します.


procedure TForm1.Button1Click(Sender: TObject);
var
  buf: PChar;
  i: Integer;
  cd: TCopyDataStruct;
begin
  cd.dwData := SIGNATURE_STRING;
  cd.cbData := Length(Memo1.Lines.Text)+1;
  cd.lpData := StrAlloc(cd.cbData);
  try
    StrCopy(cd.lpData, PChar(Memo1.Lines.Text));
    SendMessage(Handle, WM_COPYDATA, WPARAM(Handle), LPARAM(@cd));
  finally
    StrDispose(cd.lpData);
  end;
end;


この例では, Memo1 の内容を自分自身に送信しています.
このメッセージの受信側実装は


procedure TForm1.WMCopyData(var msg: TWMCopyData);
var
  i: Integer;
  buf: PChar;
begin
  if msg.CopyDataStruct.dwData=SIGNATURE_STRING then
  begin
    buf := StrALloc(msg.CopyDataStruct.cbData);
    try
      StrCopy(buf, msg.CopyDataStruct.lpData);
      Memo2.Lines.Text := buf;
    finally
      StrDispose(buf);
    end;
  end
  else
    inherited;
end;


このような感じになります. この例では受信した文字列を Memo2 に設定しています.
受信した CopyDataStruct の内容は読み出し専用になっていますので注意してください.

双方で使われている SIGNATURE_STRING は適当な DWORD 値を指定します.たとえば

  cosnt SIGNATURE_STRING: DWORD = $00000001;

のような値でも良いでしょう, 重要なのは送信側と受信側で同じ値を使うことです.

CopyDataStruct には 3 つの要素 dwData と cbData と lpData があります.
lpData に目的のデータを格納し cbData には lpData に保持されたデータのバイト数を格納します.
dwData は独立して利用できますが, 一般的には lpData の内容を示すユニークな値を格納しておきます.
参照: [Delphi-ML:4527] [Tips:90]

0044  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 1999/02/08 osamu rev 1.5
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 1999/09/17 おばQ 編集
起動中のブラウザからURLを取得する/ブラウザにURLをセットする方法

DDE を用いれば、ブラウザが現在表示している URL を取得したり、逆に URL をブラウザにセットすることができます。

Form1 に DdeClientConv1 を配置し、ConnectMode プロパティを ddeManual にします。

type  TBrowserType = (btIE, btNN);
const BrowserServices : array [TBrowserType] of string =
                ('Iexplore', 'netscape');

を用意して、

function TForm1.GetBrowserURL(BrowserType: TBrowserType): string;
var
  ServiceStr, TopicStr, ItemStr, UrlStr: String;
  UrlPch: PChar;
begin
  ServiceStr := BrowserServices[BrowserType];
  TopicStr   := 'WWW_GetWindowInfo';
  UrlStr     := '';

  with DdeClientConv1 do
  begin
    if SetLink(ServiceStr, TopicStr) then
      if OpenLink then
      begin
        ItemStr:= '0xFFFFFFFF';
        UrlPch := RequestData(ItemStr);
        UrlStr := UrlPch;
        StrDispose(UrlPch)
        CloseLink;
      end;
  end; {with}

  Result := copy( UrlStr, 2, Pos('",',UrlStr) - 2);
end;

GetBrowserURL(btIE) とすると起動中のインターネットエクスプローラの URL を文字列として取得出来ます。btNN とするとネットスケープから URL を取得します。
ブラウザは起動しておいてください。

URL をセットするには以下の関数を使います。

function TForm1.SetBrowserURL(BrowserType: TBrowserType; UrlStr: String): Boolean;
var
  ServiceStr, TopicStr: String;
  Pch: PChar;
begin
  Result := false;

  ServiceStr := BrowserServices[BrowserType];
  TopicStr   := 'WWW_OpenURL';

  with DdeClientConv1 do
  begin
    if SetLink(ServiceStr, TopicStr) then
      if OpenLink then
      begin
        Pch := RequestData( PChar(UrlStr) );
        CloseLink;
        StrDispose(Pch);
        Result := true; {成功すれば戻り値がTrue}
      end;
  end; {with}
end;

IE の場合は起動中のブラウザ画面にセットされた URL のページが表示されます。NN の場合は新しく Window を開いてページを表示するようです。
参照: [Delphi-ML:42589] [Delphi-ML:42621] <その他Windows関連> <WWW> <Windows>

0247  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 1999/09/09 osamu rev 1.1
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 1999/09/09 osamu 編集
TWebBrowser を使って HTML の描画イメージを取得する

WebBrowser1.ControlInterface.Width と 同.Height を保存し、ページのサイズにして OleDraw の後で復元したところ、イメージが取得できました。

IWebBrowser の Width, Height は表示しているコントロールの Width/Height にイコールであるため、TWebBrowser(TOleContainer)の大きさが可変であることが必要なのがちょっと困者ですが、なんとかなった、、、ことにします。

  web: TWebBrowser;

var
  bmp: TBitmap;
  body: OleVariant;
  w, h: Integer;
begin
  body := (Web.Document as IHTMLDocument2).Body;

  bmp := TBitmap.Create;
  try
    // 軽くマージンをつけておかないとスクロールバーがついちゃいます。
    bmp.Width  := body.scrollWidth  + 16;
    bmp.Height := body.scrollHeight + 16;

    (* ここで WindowLock(Web.Handle) すべきでしょうか?
       CPU などの性能によってはチラつきそうです。       *)

    // 現在値を保存してリサイズします。
    w := Web.ControllInterface.Width;
    h := Web.ControllInterface.Height;
    Web.ControllInterface.Width  := bmp.Width;
    Web.ControllInterface.Height := bmp.Height;

    // 描画します。
    OleDraw(Web.ControllInterface, DVASPECT_DOCPRINT, bmp.Canvas.Handle,
            Rect(0, 0, bmp.Width, bmp.Height));

    // 元の大きさに戻します。
    Web.ControllInterface.Width  := w;
    Web.ControllInterface.Height := h;

    (* ここで WindowLock() してるなら戻す *)
    (* ここでいろいろ bmp を使って遊べます *)

  finally
    bmp.Free;
  end;
end;

一応、上記のようなかんじなのですが、dislable なスクロールバーがつくものの、全体をイメージにできました。scrollbar の幅と高さを GetSystemMetrics などで手にいれてカットすれば okay っぽいのですが、常に scrollbar がついているか…など検証が必要そうです。

# IWebBrowser 関連を操作して、強制的に消せましたっけ?
参照: [Delphi-ML:33701] <WWW>

0245  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 1999/09/09 osamu rev 1.1
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 1999/09/09 osamu 編集
サブネットマスク値など TCP/IP 関連パラメータを取得する

>ネットワークコンピュータに設定されているTCP/IPのアドレスは
>gethostbynameで取得できると思いますが、サブネットマスクの
>アドレスはどうやって取得すればよいのでしょうか。

こういうことは MS で検索しましょう。

http://support.microsoft.com/support/

で WindowsNT workStation を SUBNETMASK で検索すると

http://support.microsoft.com/support/kb/articles/q120/6/42.asp?FR=0

が見つかります。
TCP/IP 関連パラメータの格納場所が公開されています。
参照: [Delphi-ML:33813]

0244  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 1999/09/09 osamu rev 1.1
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 1999/09/09 osamu 編集
UDP 通信で NoParam ???

Q:
UDPで受信するコードを書こうとしています。
ヘルプで調べてみたのですが、以下のNoParamの部分が分かりません。

procedure TForm1.UDP1DataArrival(Sender: TObject; bytesTotal: Integer);
begin
  UDP1.GetData(data, NoParam); //データを取得する
  Memo1.Lines.Append(data); //表示を追加する
end;

A:
function NoParam: Variant;
begin
  TVarData(Result).VType := varError;
  TVarData(Result).VError:= DISP_E_PARAMNOTFOUND;
end;

わかりにくいのですが、一応載っています。「パラメータの省略」というページです。
参照: [Delphi-ML:33778]

0216  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 1999/08/25 おばQ rev 1.2
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 1999/09/01 おばQ 編集
RichEditでHTMLタグを色・書式付き表示をする

HTMLソースを表示する時タグだけ色分けや書式付きで表示されると便利です。
以下のソースを入力して、RichEditにHTMLソースを表示させて
ボタンを押すと、なかなか高速にタグだけに色がつきます。
テキストを検索してSelAttributesで色付けしてもいいのですが、
あまりにも遅いのでほとんどAPIを使います。

タグを入力してリアルタイムに色をつけることは少々ムズカシそうだったので
実装していません。こちらと組み合わせてみるのもよいでしょう。
そちらの方法は、自分で考えてね(^^;;;

//関数部
procedure RichEditHTMLTagPickUp(RichEdit: TRichEdit; TagColor: TColor);
    function ColorToStringHex(Value: TColor): string;
    begin
      Result := '$00' + IntToHex(ColorToRGB(Value),6)
    end;
var
  mask: Longint;
  CFmt: TCharFormat;
  Str: String;
  PTop, PPos, PEnd, PNext: PChar;
  CR: TCharRange;
begin
  try
    RichEdit.Lines.BeginUpdate;//高速化、1

    mask := SendMessage(RichEdit.Handle, EM_GETEVENTMASK, 0, 0);//高速化、2
    SendMessage(RichEdit.Handle, EM_SETEVENTMASK, 0, 0);
    with RichEdit do
    begin
        SelStart := length(Text);//高速化、3
        Perform(EM_SCROLLCARET, 0, 0);

        case 1 of
          0:
          begin
            CFmt.cbSize := sizeof(CFmt);
            CFmt.dwMask := CFM_BOLD;
            CFmt.dwEffects := CFE_BOLD;
          end;
          1:
          begin
            CFmt.cbSize := sizeof(CFmt);
            CFmt.dwMask := CFM_COLOR;
            CFmt.crTextColor := ColorToRGB(TagColor);
          end;
        end;

        Str := RichEdit.Text;
        PTop := PChar(Str);
        PPos := PTop;

        while (AnsiStrScan(PPos, '<') <> nil) do//高速化、4
        begin
          PPos := AnsiStrScan(PPos, '<');
          PEnd := PPos;
          while (AnsiStrScan(PEnd +1 , '>') <> nil) do
          begin
            PNext := AnsiStrScan(PEnd +1 , '>');
            PEnd := PNext +1;
              while (PEnd = PChar(#13)) or (PEnd = PChar(#10)) do
                Inc(PEnd);
              if PEnd <> PChar('<') then Break;
          end;
          CR.cpMin := PPos - PTop;
          CR.cpMax := PEnd - PTop;
          RichEdit.Perform(EM_EXSETSEL, 0, lParam(@CR));
          RichEdit.Perform(EM_SETCHARFORMAT, 1, lParam(@CFmt));//書式決定
          PPos := PEnd;
        end;
    end;
  finally
    SendMessage(RichEdit.Handle, EM_SETEVENTMASK, 0, mask);//高速化、2終
    RichEdit.Lines.EndUpdate;//高速化、1終
  end;
end;

//実装部
procedure TForm1.Button2Click(Sender: TObject);
begin
  RichEditHTMLTagPickUp(RichEdit1, Form1.Color);
end;

注意:タグが綺麗に閉じられていないと無限ループに
   はまってしまう事が考えられます。気をつけてください

内部でcase文に1を設定している所があります。
ここを0にしますとHTMLタグがBold属性になります。
1の場合ですとForm1.Colorになります。
適当に書きなおしてください。

RichEditのUndoバッファは影響を受けますので注意です。

元々はC++BuilderMLでのC++Builder用のTipsでしたが、
Delphiに書き換えました。
MLのC++BuilderでのサンプルソースはMLを参照してください。
Delphi版とほぼ同じ内容です。
参照: [builder:8463] <WWW> <Win95> <コンポーネント >

0124  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 1999/02/08 osamu rev 1.1
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 1999/02/08 osamu 編集
ダイヤルアップネットワークで設定されている接続先を取得する

> ダイヤルアップネットワークで設定されている複数の接続先を
> すべて取得して、選択した接続先に接続するには
> どうすればよいのでしょうか?

http://www.kh.rim.or.jp/~maruoka/Builder/TIPS/tips14.html

に説明があります、参考にしてください。
参照: [builder:6282]

[新規作成] [最新の情報に更新]

How To
Lounge
KeyWords

Tips
Delphi
Home
Osamu Takeuchi osamu@big.or.jp

.