今回は Delphi３を用いた Webサーバーアプリケーションの開発に挑戦したいと思います。
※Webサーバーアプリケーションの開発は Delphi3.1 Professional版以上の機能です。また作成したアプリケーションは Windowsベースの OS搭載のサーバーでしか動作しません (クライアントは何でもいい)。動作確認にはIISなどの Webサーバーが必要になります。
※Inside Windows で Delphiによる Webサーバーアプリ開発の連載(全三回)が始まりました。そちらも合わせてお読みください。

Webサーバーアプリケーションとは？

xWebサーバーアプリケーションとは Java や Delphi のようにクライアント環境で動作せず、CGIのようにサーバー側で動作するアプリケーションです。例えば Yahoo! の検索処理はサーバーアプリケーションです。サーバーアプリケーションはクライアントの要求 (リクエスト) をキャッチして、コンテンツ (HTMLや画像) をレスポンスとして返します。

必要な環境

XWebサーバーアプリの開発には、当然 Webサーバーが必要です。WindowsNT ならマイクロソフトの IIS などがあります。 Windows95 なら マイクロソフトの Personal Web Serverなどがいいと思います。今回のサンプルも PWSを使ってテストしていきます。
XWebサーバー以外には当然ですが Delphi 3.1 (Pro以上)が必要です。もしくは C++Builder３(Pro以上)でも開発が可能です。

ＰＷＳの設定

Xこれはメインでは無いので簡単に済ませます。セットアップは "pwssetupjpn.exe" を実行すれば自動で行われます。インストールしたコンピュータは Webサーバーとなるのでネットワークの設定をしないといけません。うまく起動したらテスト用のフォルダを \WebShare\WwwRoot\ の配下につくり実行権を与えておきましょう。フォルダにはフルアクセスを許可しておきましょう。

Webサーバー版"Hello World" その１

Xでは早速お決まりの「Hello World」を作ってみたいと思います。ただ 「Hello World」を出すだけでは面白くないので、３つのリンク「Pascal」、「C++」、「Java」をクリックしたらそれに対応したボーランド製品名を表示するアプリケーシュンをつくりましょう。まずは HTMLからです。これは Test1.html と言う名前でつくります。内容は以下のようになります。

■ 最初の HTML (Test1.html) 
  <HTML>
  <HEAD>
   <TITLE>Delphi WebServer Application Sample1</TITLE>
  </HEAD>
  <BODY>
    <CENTER>
    <P>言語を選んでください。</P>
    <P><A HREF="webapp1.dll/LANG?NAME=PASCAL">パスカル</A></P>
    <P><A HREF="webapp1.dll/LANG?NAME=CPP">シープラスプラス</A></P>
    <P><A HREF="webapp1.dll/LANG?NAME=JAVA">ジャヴァ</A></P>
    </CENTER>
  </BODY>
  </HTML>
 - - - - - - - - - - - -  - - - - - - - - - - - - - - - - - - - -  - - - -

Xポイントは <A HREF〜>タグです。通常、このタグにはジャンプ先の URLを記述しますが、ここでは今から作る Webサーバーアプリケーションのファイル名を記述します。その後ろにあるパラメータはアプリケーションに引数として渡されます(※ ParamStrで処理するわけではありません)。この URLの構成要素と各名称は重要なので覚えておいてください。(下の例で Queryは QueryFieldの集合であることを示すために EDT=STD と言うパラメータを追加しています。あ、DLLを Exeって書いちゃった。)

Xこれをブラウザで確認しておきましょう。ブラウザのURLには "http://ホスト.ドメイン/フォルダ/Test1.html"と入力します。
X次はサーバー側のアプリです。Delphi を起動しましょう。新規作成で 「Webサーバーアプリケーション」 を選び、形式は 「ISAPI/NSAPI DLL」 を選択してください。新しいプロジェクトとデータモジュールに似た Webモジュールと言うフォームが表示されたはずです。この Webモジュールとは データモジュールに [Internet] ページにある「TWebDispatcher」を合わせたものです。ですのでこのフォームに TWebDispatcher を追加することは出来ません。この TWebDispatcher はリクエストを判断して適切なイベントを発生させるコンポーネントです。

XX今回の例でクライアントの目的は「適切な開発ツールを教えてくれ！」 と言う 「情報の取得」 です。要するに 「LANG?NAME=PASCAL の条件に合うレスポンスをちょうだい」 と言っています。これをサーバー側でキャッチして条件に合うレスポンスを返すようにコーディングします。まずウェブモジュールを右クリックをして 「アクションの設定」 を選んでください。小さなダイアログが出ます。ここで [追加] ボタンをクリックしてアクションをひとつ追加します。 "WebActionItem1" が追加されたらこれを選びプロパティを変更します。クライアントの要求が増えた場合はこの WebActionItemもそれに伴って追加します。まず MethodTypeプロパティを "mtGet" に変更します。このアクションが「情報の取得」と言う要求に対するイベントなので mtGetになります。次に PathInfoを変更します。これは「LANG」になります(上の URLの構成要素参照)。

XX次にこのアクションのイベントを記述します。[イベント]ページで "OnAction"イベントをダブルクリックしてイベントハンドラを以下のように記述してください。

■ Hello Worldソース (Unit1.pas) 
  procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  const
    strHtml1  = '<HTML><HEAD><TITLE>RESPONSE</TITLE></HEAD><BODY><FONT SIZE="+5">';
    strHtml2  = '</FONT></BODY></HTML>';
  var
    strContent  : string;
  begin
    {リクエストの解析}
    // PASCALの場合
    if      (Request.QueryFields.Values['NAME'])  = 'PASCAL'  then  begin
      strContent  :=  strHtml1  + 'Delphi!' + strHtml2;
    end
    // C++の場合
    else if (Request.QueryFields.Values['NAME'])  = 'CPP'  then  begin
      strContent  :=  strHtml1  + 'C++Builder!' + strHtml2;
    end
    // JAVAの場合
    else if (Request.QueryFields.Values['NAME'])  = 'JAVA'  then  begin
      strContent  :=  strHtml1  + 'JBuilder!' + strHtml2;
    end;
    {レスポンス送信}
    Response.Content  :=  strContent;
  end; -- - --- - --- - --- - --- - --- - --- - --- - --- - --- - --- - --- - --- - -

XXRequestオブジェクトにはクライアントからのリクエスト情報が入っています。このオブジェクトを使ってユーザーが何を選んだかを調べることが出来ます。QueryFieldsは TStringsです。今回はクエリーがひとつなので一行 "NAME=xxxxxx" が入っているだけです。TStringsには Valuesと言う便利なメソッドがあります。これは各行の内容が「名前=値」のような場合に名前を指定すれば値の部分だけを返すと言うメソッドです。これを使って NAMEの値を取得できます。取得した値を元にレスポンスをつくりそれを Responseオブジェクトに渡します。コードはこれだけです。このプロジェクトを"webapp1.dpr"で保存して、コンパイルして DLLを作成しブラウザで確認してみましょう。(IDEからのデバッグ方法はヘルプを参照)
選んだリンクが「PASCAL」の場合は以下のようなレスポンスが返ってきます。(実際は改行とインデントはありません。)

■ WebApp1が作成したレスポンスコンテンツ 
  <HTML>
  <HEAD>
   <TITLE>RESPONSE</TITLE>
  </HEAD>
  <BODY>
    <FONT SIZE="+5">Delphi!</FONT>
  </BODY>
  </HTML>
 - - - - - - - - - - - -  - - - - - - - - - - -

XXレスポンスへ渡すコンテンツの作り方が少々カッコ悪いことに気がついたと思います。前回の例では constに共通部分の HTMLを記述し、後で結合して渡しています。これだとレスポンスの内容がコードを見ただけでは解りにくく、さらに保守性が著しく低くなってしまいます。しかし さすがはボーランド、ここでも使い勝手の良さを追求していました。その解決方法とは「TPageProducerコンポーネント」を使用することです。これを使ってもう一度 Hello Worldを改造してみます。

Webサーバー版"Hello World" その２

X[Internet] ページにある 「TPageProducer」 をウェブモジュールに配置します。このコンポーネントには、雛型となる HTMLを記述できる　"HTMLDoc"プロパティ(TStrings型)があります。これを開き FrontPageや PageMillでデザインした HTMLのソースをペーストします。ただしそのままではページの内容を動的に変更できません。ここでは「あなたにお勧めの開発ツールは XXXXX です！」と言うレスポンスを返します。この XXXXX の部分を動的に変更します。動的に変更したい箇所を HTML内で<#パラメータ名>として記述します。(パラメータつきのSQLに似ています。) こう書くことで TPageProducerは、この特殊タグをコンテンツ (このHTML) が必要になった時に適切な値に置換します。いや、置換が必要になったことをイベントによって知らせます。どのタグをどの文字列に置換するかはコーディングしないといけません。しかしここでの置換は非常に簡単です。まずは PageProducerの HTMLDocに記述する HTMLコードを見てみましょう。

■ PageProducerの HTMLDocプロパティ 
  <HTML>
  <HEAD>
    <META NAME="GENERATOR" CONTENT="Adobe PageMill 2.0J Win">
    <META HTTP-EQUIV="Content-Type" CONTENT="text/html;CHARSET=x-sjis">
    <TITLE>WebApp1 Response</TITLE>
  </HEAD>
  <BODY BGCOLOR="#ffffff">
  <P><HR ALIGN=LEFT></P>
  <P><CENTER>あなたにお勧めの開発ツールは・・・</CENTER></P>
  <P><CENTER><FONT SIZE=+4>「<#TOOLNAME>」</FONT></CENTER></P>
  <P><CENTER>です！</CENTER></P>
  <P ALIGN=RIGHT><HR ALIGN=RIGHT></P>
  <P ALIGN=RIGHT>詳細情報は <A HREF="http://www.borland.co.jp/" TARGET="_blank">Borland
  Online Japan</A> で！
  </BODY>
  </HTML> - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

X次はこの動的変更箇所をどのタイミングで変更、置換するか？です。TPageProducerには "OnHTMLTag" と言うイベントがあります。ここで処理します。このイベントは PageProducer のコンテンツ内容をレスポンスに提供する際に発生します。このイベントでは変更箇所(特殊タグ)を何に変更するかを記述します。今回の例では以下のようになります。リクエストの条件もここで判断します。ですので Action でのイベントではレスポンスに PageProducerのコンテンツを渡すだけでよくなります。

■ Actionイベントと PageProducerの OnHTMLTagイベント (Unit1.pas) 
  procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  begin
    {レスポンス}
    Response.content  :=  PageProducer1.Content;
  end;


  procedure TWebModule1.PageProducer1HTMLTag(Sender: TObject; Tag: TTag;
    const TagString: String; TagParams: TStrings; var ReplaceText: String);
  begin
    if  (TagString  = 'TOOLNAME') then  begin
      {リクエストの解析}
      // PASCALの場合
      if      (Request.QueryFields.Values['NAME'])  = 'PASCAL'  then  begin
        ReplaceText :=  'Delphi!';
      end
      // C++の場合
      else if (Request.QueryFields.Values['NAME'])  = 'CPP'  then  begin
        ReplaceText :=  'C++Builder!';
      end
      // JAVAの場合
      else if (Request.QueryFields.Values['NAME'])  = 'JAVA'  then  begin
        ReplaceText :=  'JBuilder!';
      end;
    end;
  end; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Xこれで<#TOOLNAME>の部分は適切な文字列・製品名に置き換えられます。これをコンパイルしてテストしてみましょう。ここで気がつかれたかもしれませんが ISAPI/NSAPI DLLで作成したサーバーアプリケーションはいったんサーバーを停止させないと置き換えで来ません(できるかもしれないけど)。これは DLLがサーバーのインプロセスで動作するからです。一旦停止させて置き換えた後に再び HTTPサービスを起動してください。これでテストできます。どうだったでしょうか？うまく動作しましたか？次は簡易チャットに挑戦してみましょう！

簡単なチャットCGIをつくろう

Xでは次はちょっと凝って簡単なチャットアプリケーションをつくってみましょう。仕様は以下のようになります。(1)クライアント側で入力した発言内容をサーバーのテキストファイルに追加する。(2)テキストファイルが20行を超えたら20行目以降の行は削除する。(3)テキストデータから20行分の発言内容をHTMLにしてクライアントに返す。と言う具合にします。サーバー側ではデータベースではなくテキストファイルを使いたいと思います。また、最初にログイン用のHTMLを表示し、そこでハンドル名を入力してもらうことにします。

Xまず、最初に表示するログイン用の HTMLからです。ここでは Formタグを使って文字入力をしてもらうことにします。さらにその情報をクライアントからサーバーアプリに POST してもらいます。以下のようになります。

■ ログイン用のHTML (index.html) 
<HTML>
  <HEAD>
    <META NAME="GENERATOR" CONTENT="Adobe PageMill 2.0J Win">
    <META HTTP-EQUIV="Content-Type" CONTENT="text/html;CHARSET=x-sjis">
    <TITLE>Untitled Document</TITLE>
  </HEAD>
  <BODY BGCOLOR="#ffffff">
  <FORM ACTION="chat.exe/MSGADD" METHOD=POST>

  <P><HR ALIGN=LEFT></P>
  <H3><CENTER>Delphian WebChatへようこそ！</CENTER></H3>

  <P><CENTER><TABLE WIDTH="266" HEIGHT="41" BORDER="1" CELLSPACING="2" CELLPADDING="0">
     <TR>
     <TD WIDTH="600" BGCOLOR="#ffffbb">ハンドル名を入力してログインボタンをクリックしてください。
         ハンドル名が無い場合は「権兵衛」さんになります。</TD></TR>
  </TABLE>
  </CENTER></P>

  <P><CENTER>ハンドル名：<INPUT NAME="HANDLE" TYPE="text" SIZE="25"></CENTER></P>
  <P><CENTER><INPUT NAME="Name" TYPE="submit" VALUE="ログイン"></CENTER></P>
  <P><HR ALIGN=LEFT></FORM>
  </BODY>
  </HTML> - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Xサーバープログラム側では、POSTされた情報を元にチャットの画面を生成し、レスポンスを返す処理が必要です。入力されたハンドル名は保持しておくことが難しいため(一回の要求につき一回だけアプリケーションは起動される。そのため変数に格納していてもレスポンスを返した時点でアプリケーションは終了してしまい変数の内容は破棄される。)、クライアントの HTMLに隠しフィールドとして格納することにします。さらにレスポンスのコンテンツには自分を呼び出すためのコードを付加します。

X新規作成で CGIのウェブサーバー chat.dpr を作成します。前回と同じ手順で TPageProducerを追加してください。TPageProducerの HTMLDocにはチャット画面用の HTMLを記述します。メッセージ入力欄と送信用のボタン、トップページに戻るためのリンクとログ表示用の領域(ここは動的に変わります)。そしてハンドル名用の隠しフィールドです。

■ PageProducerのコードチャット画面用 (Unit1.pas) 
<html>
  <head>
   <title>Delphian WebChat</title>
  </head>
  <body>
    <b><i>
    <a href="mailto:boheme@oks3.3web.ne.jp">Delphian WebChat</a>
    </i></b>
    <form method="POST" action="chat.exe/MSGADD">
      <input type="hidden" name="HANDLE" SIZE=30 value="<#Handle>">
      <input type="text"   name="MSG"    SIZE=30 value="">
      <input type="submit" value="     発言     ">
      <a href="index.html">ログオフ</a>
    </form>
    <hr>
    <#Log>
  </body>
  </html> - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Xクライアントに返すコンテンツの中に自分を呼び出すためのコード action="chat.exe/MSGADD" があるのが解ると思います。これで処理を何度も繰り返すことが出来ます。ログイン用の HTMLも、チャットでの発言用の HTMLでも同じ呼び出し方をしている事に気をつけてください。サーバーアプリではそれがログイン時の要求であれ、チャットでの発言の要求であれ、レスポンスとして返すコンテンツは同じです。サーバー側ではリクエスト情報の中からハンドル名と発言内容を取りだし、それをファイルに書き出します。ここで発言内容が空っぽの場合は書き出しをせずに、レスポンスを返すだけにしておけば空白行ができるのを防げます。
X今回のアプリケーションで発生するアクションは "POST" のみです。アクションの設定は mtPostを指定してください。また、Defaultプロパティを Trueにしておくと処理が確実になりますです。

■ チャットプログラム (Unit1.pas) 
  implementation

  {$R *.DFM}
  
  var
    sltLog    : TStringList; {ログファイル用}
    strHandle : string;      {ハンドル名}
    
  //-----------------------------------------------------
  //  初期処理
  //-----------------------------------------------------
  procedure TWebModule1.WebModule1Create(Sender: TObject);
  begin
    sltLog  :=  TStringList.Create;
    if  (FileExists(ExtractFilePath(ParamStr(0)) + 'log.txt'))  then  begin
      sltLog.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'log.txt');
    end;
  end;

  //-----------------------------------------------------
  //  要求発生処理
  //-----------------------------------------------------
  procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  var
    strMsg  : string;
  begin
    // ハンドル名
    strHandle         :=  Request.ContentFields.Values['HANDLE'];
    if  (Length(Trim(strHandle)) = 0) then  begin
      strHandle       :=  '権兵衛'; //名前が無い場合
    end;
    // メッセージを追加
    if  (Length(Request.ContentFields.Values['MSG']) > 0) then  begin
      strMsg  :=    '<B>' +  strHandle + '</B>'    +
                    ' 「' +  Request.ContentFields.Values['MSG'] + '」<BR>';
      // ログの１行目に追加する
      sltLog.Insert(0, strMsg);
      // 20行以上ある場合は下から削除する
      While (sltLog.Count > 20)  do  begin
        sltLog.Delete(sltLog.Count - 1);
      end;
      sltLog.SaveToFile(ExtractFilePath(ParamStr(0)) + 'log.txt');
    end;
    // レスポンス
    Response.Content  :=  PageProducer1.Content;
    Response.SendResponse;
  end;

  //-----------------------------------------------------
  //  特殊タグの置換処理
  //-----------------------------------------------------
  procedure TWebModule1.PageProducer1HTMLTag(Sender: TObject; Tag: TTag;
    const TagString: String; TagParams: TStrings; var ReplaceText: String);
  begin
    if  (TagString  = 'Log')  then  begin
      ReplaceText :=  sltLog.Text;
    end;
    if  (TagString  = 'Handle')  then  begin
      ReplaceText :=  strHandle;
    end;
  end;

  //-----------------------------------------------------
  //  終了処理
  //-----------------------------------------------------
  procedure TWebModule1.WebModule1Destroy(Sender: TObject);
  begin
    sltLog.Free;
  end;

  end. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Xここで発言内容やハンドル名と言った FORM 上の情報は ContentFieldsプロパティを使って取得します。QueryFields には格納されていないので注意してください。 (QueryFields は引数) また、このアプリケーションではディスクファイルを読み書きしています。ここで注意しなければならないのは排他処理です。場合によっては Createで読みこんだ Log.txtは 最後 Destroy時に書きこむときにはすでに他のユーザーが書き換えている可能性があります。それを解決するには mutex、もしくはアトムを使うと簡単です。

■ 競合問題を考慮した場合 (Unit1.pas) 
  implementation

  {$R *.DFM}

  const
    cstAtom  =  'WebChat';

  var
    sltLog    : TStringList;
    strHandle : string;
    Atm       : TAtom;

  //-----------------------------------------------------
  //  初期処理
  //-----------------------------------------------------
  procedure TWebModule1.WebModule1Create(Sender: TObject);
  begin
    sltLog  :=  TStringList.Create;
    // アトムによる重複起動のチェック
    Atm :=  GlobalFindAtom(cstAtom);
    while (Atm <> 0) do  begin
      Atm :=  GlobalFindAtom(cstAtom);
      if  Atm <>  0 then
      begin
        // 別プロセス有り
        Sleep(1000);
      end;
    end;
    // 別プロセス無し
    Atm :=  GlobalAddAtom(cstAtom);
    if  (FileExists(ExtractFilePath(ParamStr(0)) + 'log.txt'))  then  begin
      sltLog.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'log.txt');
    end;
  end;

  //-----------------------------------------------------
  //  要求発生処理
  //-----------------------------------------------------
  procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  var
    strMsg  : string;
  begin
    // ハンドル名
    strHandle         :=  Request.ContentFields.Values['HANDLE'];
    if  (Length(Trim(strHandle)) = 0) then  begin
      strHandle       :=  '権兵衛';
    end;
    // メッセージを追加
    if  (Length(Request.ContentFields.Values['MSG']) > 0) then  begin
      strMsg  :=    '<B>' +  strHandle + '</B>'    +
                    ' 「' +  Request.ContentFields.Values['MSG'] + '」<BR>';
      sltLog.Insert(0,strMsg);
      While (sltLog.Count > 20)  do  begin
        sltLog.Delete(sltLog.Count - 1);
      end;
      sltLog.SaveToFile(ExtractFilePath(ParamStr(0)) + 'log.txt');
    end;
    Response.Content  :=  PageProducer1.Content;
    Response.SendResponse;
  end;

  //-----------------------------------------------------
  //  返す
  //-----------------------------------------------------
  procedure TWebModule1.PageProducer1HTMLTag(Sender: TObject; Tag: TTag;
    const TagString: String; TagParams: TStrings; var ReplaceText: String);
  begin
    if  (TagString  = 'Log')  then  begin
      ReplaceText :=  sltLog.Text;
    end;
    if  (TagString  = 'Handle')  then  begin
      ReplaceText :=  strHandle;
    end;
  end;

  //-----------------------------------------------------
  //  終了処理
  //-----------------------------------------------------
  procedure TWebModule1.WebModule1Destroy(Sender: TObject);
  begin
    sltLog.Free;
    // アトムの破棄
    Atm :=  GlobalFindAtom(cstAtom);
    if  Atm <>  0 then
    begin
      GlobalDeleteAtom(Atm);
    end;
  end;

  end. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Xこれで簡易チャットシステムは完了です。かなり簡単に開発できることが解ってもらえたと思います。 ASP ではスクリプトと HTML がごちゃまぜで非常に可読性の悪いものになっています。Webサーバーアプリケーションの開発にも使いなれた Delphiが使えるのは大きなメリットですね。


Delphi Acid Floor -TechDocs- Copyright 1998 Toyota