Webサーバーアプリケーション(Stand Alone)作成～Delphiソースコード集

Delphiを起動して新規作成を行う

Delphiを起動し、ファイル→新規作成→その他・・・をクリックします。

左ペインの「WebBroker」を選択し、右ペインの「Webサーバーアプリケーション」をクリックし「OK」ボタンをクリックします。

「次へ」をクリックします。

今回はスタンドアロンアプリケーションを選択します。IISやApacheで動かす場合はCGIやISAPIやApacheダイナミックリンクモジュールを選択します。

VCLアプリケーションを選択して「次へ」をクリックします。

ポートのテストを押して他で使われていたらポート番号を変更します。そうでなければ完了をクリックします。

タグの「WebModuleUnit1」を選択します。

プロパティのActionsの右側の「・・・」ボタンをクリックします。

ウィンドウが表示されるのでツールバーの左の「新規作成」ボタンをクリックします。

新しくWebActionItem1が作成されましたのでクリックして選択します。

プロパティ「pathInfo」に「/mypost」と入力します。

「イベント」タブに切り替えてOnActionの右側の空白欄をダブルクリックします。

既に自動的にソースコードが作成されています。

ソースコードを記述する

以下の赤字部分のソースコードを記述してください。（ほとんどHTMLです。Postの処理も超簡単です。）

uses System.SysUtils, System.Classes, Web.HTTPApp;
type
  TWebModule1 = class(TWebModule)
    procedure WebModule1DefaultHandlerAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure WebModule1WebActionItem1Action(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  private
    { private 宣言 }
  public
    { public 宣言 }
  end;
var
  WebModuleClass: TComponentClass = TWebModule1;

implementation

{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}

procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content:=
    '<html>' +
    '<head>'+
    '<meta charset="UTF-8">'+
    '<title>Web サーバー アプリケーション</title>'+
    '</head>' +
    '<body>'+
    '<h2>Web サーバー アプリケーション</h2>'+
    '<form method="post" action="/mypost">'+
    '何か入力してください：<input type="text" name="txt">'+
    '<input type="submit">'+
    '</form>'+
    '</body>' +
    '</html>';
end;

procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content:=
    '<html>' +
    '<head>'+
    '<meta charset="UTF-8">'+
    '<title>Web サーバー アプリケーション</title>'+
    '</head>' +
    '<body>'+
    '<h2>POST文字列の表示</h2>'+
    '<p>'+ Request.ContentFields.Values['txt'] +'</p>'+
    '<a href="/">戻る</a>'+
    '</body>' +
    '</html>';
end;

end.

参考：Postの値はRequest.ContentFieldsに入っています。Getの値はRequest.QueryFieldsに入っています。

実行する

ツールバーの実行ボタン（F9キーでも同じ）を押して実行します。（デバッガを使わずに実行でもOKです。）
実行するとウィンドウが表示されるので、「起動」ボタンをクリックします。（以下の場合はポート8080が待機状態になります。）

ファイアーウォールの警告が出たら、「アクセスを許可する」ボタンを押して許可してください。

ブラウザを起動する。

ブラウザを起動してURLに
http://localhost:8080/
と入力してEnterキーを押します。

「何か入力してください」の欄に何でもいいので入力して「送信」ボタンを押します。
POSTされた文字列がサーバーを介して表示されます。

WebBrokerのStand Aloneアプリで外部ファイルを使う場合

スタンドアロン　アプリケーションは、そのままでは外部ファイル（.css、.jsや各種画像ファイル[.png、.jpg、.gif]等）を使えません。
以下のようにWebModule1DefaultHandlerAction関数内で外部ファイル指定時の処理をするソースコードを追加すると使用可能になります。
実行ファイルと同じフォルダ内に「htdocs」フォルダを作成（これがドキュメントルートとなる）して必要なファイルを配置してください。
（例）
・・・\htdocs\css\style.css
・・・\htdocs\images\01.jps

unit WebModuleUnit1;

interface

uses
  System.SysUtils, System.Classes, Web.HTTPApp
  ,System.StrUtils,System.IOUtils;

type
  TWebModule1 = class(TWebModule)
    procedure WebModule1DefaultHandlerAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  private
    { private 宣言 }
    function getContentType(fname:string):string;
    function getFileName(fname:string):string;
   public
    { public 宣言 }
  end;

var
  WebModuleClass: TComponentClass = TWebModule1;

const
  ExtensionArr:array[0..12] of string=
    ('txt','html',
     'js','css',
     'gif','jpg',
     'png','pdf',
     'webm','ogg',
     'mp3','mp4','wav');
  ContentTypeArr:array[0..12] of string =
    ('text/plain','text/html',
     'text/javascript','text/css',
     'image/gif','image/jpeg',
     'image/png','application/pdf',
     'audio/webm','application/ogg',
     'audio/mpeg','audio/mp4','audio/wav');

  htdocs:string='htdocs';

implementation

{%CLASSGROUP 'Vcl.Controls.TControl'}

{$R *.dfm}

function TWebModule1.getContentType(fname: string): string;
var i,idx:integer;
begin
  result:='';
  idx:=-1;
  if fname='' then exit;
  for i := 0 to length(ExtensionArr)-1 do
  begin
    if LowerCase(ExtractFileExt(fname))=
      ('.'+ExtensionArr[i]) then
    begin
      idx:=i; break;
    end;
  end;
  if idx>=0 then
    result:=ContentTypeArr[idx];
end;

function TWebModule1.getFileName(fname: string): string;
var path:string;
begin
  result:='';
  //ディレクトリトラバーサル配慮で".."は無効にする
  if pos('..',fname)>0 then exit;
  path:=ExtractFilePath(paramstr(0));
  if RightStr(path,1)='\' then
    path:=LeftStr(path,length(path)-1);
  path:=path+'\'+htdocs+ReplaceStr(fname,'/','\');
  if TPath.HasValidPathChars(path,false) then
  begin
    if getContentType(path)<>'' then
    begin
      if FileExists(path,true) then
      begin
        result:=path;
      end;
    end;
  end
end;

procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var FileName,ContentType:string;
    strm:TFileStream;
begin
  FileName:=getFileName(Request.PathInfo);
  if FileName<>'' then
  begin
    ContentType:=getContentType(FileName);
    strm:=TFileStream.Create(Filename,fmOpenRead);
    strm.Position:=0;
    Response.ContentStream:=strm;
    Response.ContentType:=ContentType;
    exit;
  end;

  Response.ContentType := 'text/html; charset="UTF-8"';
  Response.Content :=
    '<!DOCTYPE html>'+
    '<html>' +
    '<head>'+'<title>Web サーバー アプリ</title>'+
    '<link rel="stylesheet" href="/css/style.css">'+
    '</head>' +
    '<body>'+
    'Web サーバー アプリケーション<br>'+
    '<img src="/images/01.jpg" class="imagestyle">'+
    '</body>' +
    '</html>';
end;

end.