対応　Ｄ３　ＣＳＳ
　　　D3.1　ＣＳＳ　または　ＰＲＯ
　　　Ｄ４　ＣＳＳ　または　ＰＲＯ＋WEBサーバモジュール

デルファイで作成した、ＩＳＡＰＩの1行ボードのサンプルです。

使用法は

http://xxxx.xxxx.xx.xx/Scripts/BBSLN.DLL/BBS?ID=ベースhtmlファイル名

です。

取り敢えずサンプルとして
http://dmj.psnet.ne.jp:8080/Scripts/BBSLN.DLL/BBS?ID=lrbbs.html&FL=lr
で動作の確認が見られます。

準備：新規作成
　　　Webサーバアプリケーション
　　　ISAPI/NSAPI
　　　フォーム(モジュール)に　TPageProduserをドロップ
　　　WebApplicationをダブルクリック、PathinfoをBBSに設定。

ソース(コンポーネント名は変更していますので適宜変更してください。

unit BBSLN1;

interface

uses
  Windows, Messages, SysUtils, Classes, HTTPApp,IniFiles;

type
  TWWWMod = class(TWebModule)
    pp: TPageProducer;
    procedure WWWModBBSAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure ppHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    st,en,ln:integer;
    fl:string;
  end;

var
  WWWMod: TWWWMod;
  path:string;

implementation

{$R *.DFM}

function CMK(s:string):string;
var q:string;
    i:integer;
    b:boolean;
begin
  q:='';
  b:=false;
  if length(s)>0 then
    for i:=1 to length(s) do begin
      if b then begin
        case upcase(s[i]) of
        'B':q:=q+'<B>';
        'I':q:=q+'<I>';
        'N':q:=q+'</B>';
        'S':q:=q+'</I>';
        else
          q:=q+'!'
        end;
        b:=false
      end else begin
        case s[i] of
        #0..#8,#11..#12,#14..#31,#127:q:=q+' ';
        #10,#13:q:=q+'<BR>';
        '<':q:=q+'&lt;';
        '>':q:=q+'&gt;';
        '!':b:=true;
        else
          q:=q+s[i]
        end
      end
    end;
  if b then q:=q+'!';
  Result:=q
end;

procedure TWWWMod.WWWModBBSAction(Sender: TObject; Request: TWebRequest;
  Response: TWebResponse; var Handled: Boolean);
var req:TStrings;
    f:TextFile;
    s,t,u:string;
    fn:string;
  {$ifdef LOG}
    log:textfile;
  {$endif}
begin
  try
  {$ifdef LOG}
    assignfile(log,'a:\____log.txt');
    if fileexists('a:\____log.txt') then Append(log) else Rewrite(log);
  {$endif}
    if request.Method='POST' then req:=Request.ContentFields
                     else req:=Request.QueryFields;
    fn:=req.Values['ID'];
    fl:=path+req.Values['FL']+'BBS.TXT';
    st:=StrToIntDef(req.Values['ST'],0);
    en:=StrToIntDef(req.Values['EN'],0);
    ln:=StrToIntDef(req.Values['LN'],0);
  {$ifdef log}
    write(log,DateTimeToStr(now),',',request.RemoteHost);
    write(log,' - ',request.Method,', ');
    writeln(log,'ID:',fn,',FL:',fl,',ST:',st,',EN:',en,',LN:',ln);
  {$endif}
    { POST CHECK }
    if request.Method='POST' then begin
      AssignFile(f,fl);
      if FileExists(fl) then Append(f) else Rewrite(f);
      try
        u:=CMK(req.Values['URL']);
        s:=CMK(req.Values['MAIL']);
        t:=CMK(req.Values['NAME']);
        if trim(s)+trim(t)<>'' then begin
          if t='' then t:=request.RemoteHost;
          if t='' then t:='<FONT COLOR=#FF4040>不明</FONT>';
          if pos('@',s)>0 then
            t:='<A HREF="mailto:'+CMK(s)+'">'+t+'</A>';
          t:=t+' : ('+DateTimeToStr(now)+')';
          if (length(u)>7) and (copy(u,1,7)='http://') then
            t:=T+'<A HREF="'+u+'">'+u+'</A>';
          t:=t+'<BR>';
          u:=CMK(req.Values['MSG']);
          if u='' then u:='…';
          t:=t+'『'+u+'』<HR>';
          writeln(f,t)
        end;
      finally
        CloseFile(f)
      end
    end;
    { LOAD FROM LIST }
    if FileExists(path+fn) then begin
      pp.HTMLDoc.LoadFromFile(path+fn);
      Response.Content:=pp.Content
    end else
      Response.Content:='<H1>HTTP:ERROR BBS HAS NO DATA</H1>';
  finally
    {$ifdef log}
    CloseFile(log)
    {$endif}
  end
end;

procedure TWWWMod.ppHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
var sl:tstringlist;
    s:string;
    i:integer;
begin
  if uppercase(tagstring)='CONTENT' then begin
    if FileExists(fl) then begin
      sl:=TStringList.Create;
      try
        sl.LoadFromFile(fl);
        if ln=0 then ln:=100;
        if en=0 then en:=sl.Count-1;
        if st>en then st:=0;
        if st=0 then begin
          st:=en-ln;
          if st<0 then st:=0
        end;
        s:='<HR>';
        for i:=en downto st do s:=s+sl[i];
        ReplaceText:=s;
      finally
        sl.Free
      end
    end
  end
end;

var ini:TIniFile;
initialization
  ini:=TIniFile.Create('BBSLN.INI');
  path:=ini.ReadString('Config','path','a:\');
  if path[length(path)]<>'\' then path:=path+'\';
  ini.Free
end.

■ソース終わり

WINNTディレクトリに　BBSLN.INI　ファイルを作成し、
[Config]
path=C:\InetPub\BBSDATA\

などとしておくといいでしょう。(BBSDATAディレクトリは作成しておいてください。

サンプルhtmlファイル（これはConfigでの指定ディレクトリに入れます)

<HTML>
<TITLE>るろさんの　一行掲示板</TITLE>
<BODY BGCOLOR="#000080" TEXT="#FFFF80" LINK="#80FF80" VLINK="#FFFF00"
ALINK="#FF0000">
<H1>ようこそ一行掲示板へ</H1>
<HR>
<CENTER>
<FORM ACTION="http:/Scripts/BBSLN.DLL/BBS" METHOD="POST">
<INPUT TYPE=HIDDEN NAME="ID" VALUE="bbs.html">
<TABLE BORDER>
<TR><TD>お名前(ハンドル)</TD><TD>
<INPUT TYPE="text" NAME="NAME" SIZE=20 MAXLENGTH=20 VALUE="">
</TD><TD></TD></TR>
<TR><TD>ＥＭＡＩＬ</TD><TD>
<INPUT TYPE="text" NAME="MAIL" SIZE=50 MAXLENGTH=50 VALUE="">
</TD><TD></TD></TR>
<TR><TD>ＷＷＷページがあれば</TD><TD>
<INPUT TYPE="text" NAME="URL" SIZE=50 MAXLENGTH=50 VALUE="http://">
</TD><TD></TD></TR>
<TR><TD>メッセージをどうぞ</TD><TD>
<INPUT TYPE="text" NAME="MSG" SIZE=80 MAXLENGTH=120 VALUE="">
</TD><TD></TD></TR>
<TR><TD>　</TD><TD>
<INPUT TYPE="SUBMIT" VALUE="送　信">　　　　　<INPUT TYPE="RESET"
VALUE="クリア"></TD><TD></TD></TR>

</TABLE>
</FORM></CENTER>
<HR>
<#CONTENT>
<P><HR>
<A HREF="http://www.psnet.ne.jp/lereaux/">るろさんのページにもどる</A>
</BODY>
</HTML>



　　　　　　　　　　　　URL=http://dmj.psnet.ne.jp/ Delphiマガジン創刊
長月、白露、涼風啼蟋蟀  FDELPHI ☆ 瑠瓏 <KHB05271@nifty.ne.jp>
  　　　　　　　　　　　FJBUILDR    Sun,9/20/98  10:16

Original document by 瑠瓏            氏 ID:(KHB05271)

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