unit Unit2;

interface

uses
  SysUtils, Classes, HTTPApp, StrUtils, HTTPProd, DSProd, OleServer,
  ASGSQLite3, DB;

type
  TWebModule2 = class(TWebModule)
    DataSetPageProducer1: TDataSetPageProducer;
    PageProducer2: TPageProducer;
    DataSetPageProducer2: TDataSetPageProducer;
    PageProducer1: TPageProducer;
    ASQLite3DB1: TASQLite3DB;
    ASQLite3Table1: TASQLite3Table;
    ASQLite3Log1: TASQLite3Log;
    DataSource1: TDataSource;
    ASQLite3Query1: TASQLite3Query;
    ASQLite3UpdateSQL1: TASQLite3UpdateSQL;
    PageProducer3: TPageProducer;
    procedure WebModuleCreate(Sender: TObject);
    procedure WebModuleDestroy(Sender: TObject);
    procedure WebModuleBeforeDispatch(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure WebModule2indexAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure WebModuleAfterDispatch(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure PageProducer2HTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure WebModule2RegistAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure DataSetPageProducer2HTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure DataSetPageProducer1HTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure WebModule2UsrdelAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure PageProducer1HTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure WebModule2AdminAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure PageProducer3HTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure WebModule2admin2Action(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure WebModule2admdelAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure WebModule2errorAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure WebModule2nextAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure WebModule2backAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
  private
    { Private declarations }
    title1, title2: string;
    head, body, foot, page: string;
    pos: integer;
    admin_pass: string;
    htmlw: Boolean;
    home: string;
    page_def: integer;
    maxn, maxs, maxv: integer;
    maxline: integer;
    w_regist: Int64;
    second: TDateTime;
    autolink, tag: Boolean;
    mudai: string;
    re_color: string;
    hostview: integer;
    no_host, no_word: TStringList;
    login: Boolean;
    l_count: integer;
    loginlist: TStringList;
    function LinkContent(path: string): string;
    function footer(path: string): string;
  public
    { Public declarations }
  end;

const
    GAIBU: Boolean = true;
    LOCKEY: integer = 1;
    LOCK: string = 'lock/plock';

var
  WebModule2: TWebModule2;

implementation

uses WebReq, Unit3, DateUtils;

{$R *.DFM}

procedure TWebModule2.WebModuleCreate(Sender: TObject);
begin
//* <title>に入れるタイトル */
        title1 := 'P-BBS';
//* 掲示板のTOPタイトル（HTML可）*/
        title2 := '<font size=5 face=Verdana color=gray><b>P-BBS</b></font>';
//* <body>タグ */
        body := '<body bgcolor="#ddf2ed" text="#444444" link="#0000AA">';
//* 管理者用パスワード。必ず変更して下さい。*/
        admin_pass := 'full';
//* TOPページをHTMLに書き出すか （yes=1 no=0）*/
        htmlw := true;
//* 一ページあたりの表示記事数 */
        page_def := 10;

        l_count:=5;
//* 文字数制限（名前、題名、本文）全角だとこの半分です */
        maxn  := 40;
        maxs  := 40;
        maxv  := 1500;
//* 本文の改行数制限 */
        maxline := 25;
//* 同一ホストからの連続投稿を制限
//  --> 秒数を記述するとその時間以上を経過しないと連続投稿できない*/
        w_regist := 2;

        second:=0;
//* 文中で自動リンクするかどうか（yes=1 no=0）*/
        autolink := true;
//* HTMLタグを有効にするか（yes=1 no=0)*/
        tag := true;
//* タイトル無しで投稿された場合 */
        mudai := '(無題)';
//* ＞がついた時の色 */
        re_color := '#225588';
//* ホストを表示するか（表示しない=0 <!-->内で表示=1 表示=2）*/
        hostview := 1;
//* 外部書き込み禁止にする?(する=1,しない=0) */
//define("GAIBU", 0);

//* 使用するファイルロックのタイプ（mkdir=1 flock=2 使わない=0）*/
//define("LOCKEY", 2); 		//通常は2でOK
//* mkdirロックを使う時はlockという名でディレクトリを作成して777にしてください */
//define("LOCK" , "lock/plock");	//lockの中に作るロックファイル名
        login:=false;
        no_host:=TStringList.Create;
        no_host.CommaText:='"kantei.go.jp","anonymizer.com","pt$","ph$","my$","th$","rr.com"';
        no_word:=TStringList.Create;
        no_word.CommaText:='"死ね","馬鹿","novapublic"';
        loginlist:=TStringList.Create;
        loginlist.CommaText:='"/admin2","/admdel","/next","/back"';
end;

procedure TWebModule2.WebModuleDestroy(Sender: TObject);
begin
        no_host.Free;
        no_word.Free;
        loginlist.Free;
end;

procedure TWebModule2.WebModuleBeforeDispatch(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  i: integer;
begin
        ASQLite3Query1.ExecSQL;
        ASQLite3Table1.TableName:='pbbs';
        ASQLite3Table1.Active:=true;;
        home:='http://'+Request.Host+Request.InternalScriptName+'/';
        head:='<html><head><META HTTP-EQUIV="Content-type" CONTENT="text/html; charset=Shift_JIS"><title>'+
                title1+'</title></head>';
        foot:='[ <a href='+home+'>ホーム</a> ] [ <a href='+home+'admin>管理</a> ]'+
                '<br><br><small><!-- P-BBS v1.232 -->- <a href="http://php.s3.to" target="_top">P-BBS</a> -</small>'+
                '</body></html>';
  if (login = true)and(loginlist.IndexOf(Request.InternalPathInfo) = -1) then
  begin
        login:=false;
  end;
  for i:=0 to no_host.Count-1 do
  begin
    if AnsiContainsText(Request.URL,no_host[i]) = true then
    begin
        Response.StatusCode:=204;
        break;
    end;
  end;
end;

procedure TWebModule2.WebModule2indexAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
        pos:=StrToIntDef(Request.Query,ASQLite3Table1.RecordCount div page_def);
        Response.Content:=PageProducer2.Content;
end;

procedure TWebModule2.WebModuleAfterDispatch(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
        ASQLite3Table1.Active:=false;
end;

procedure TWebModule2.PageProducer2HTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
var
  s: string;
begin
  if TagString = 'page_def' then
  begin
        ReplaceText:=IntToStr(page_def);
  end;
  if TagString = 'home' then
  begin
        ReplaceText:=home;
  end;
  if TagString = 'main' then
  begin
        s:='';
    if (pos+1)*page_def >= ASQLite3Table1.RecordCount then
    begin
        ASQLite3Table1.Last;
        pos:=ASQLite3Table1.RecordCount div page_def;
    end else
    begin
        ASQLite3Table1.RecNo:=(pos+1)*page_def-1;
    end;
    while (ASQLite3Table1.Bof = false)and(ASQLite3Table1.RecNo >= pos*page_def) do
    begin
        s:=s+DataSetPageProducer2.Content;
        ASQLite3Table1.Prior;
    end;
        ReplaceText:=s;
  end;
  if TagString = 'title2' then
  begin
        ReplaceText:=title2;
  end;
  if TagString = 'foot' then
  begin
        ReplaceText:=footer('');
  end;
end;

procedure TWebModule2.WebModule2RegistAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  i: integer;
  s, name, pass, sub, com: string;
  x: TDateTime;
  y: Int64;
  procedure linecount;
  var
    j: integer;
    temp: TStringList;
  begin
        temp:=TStringList.Create;
    try
        temp.Text:=com;
      if temp.Count > maxline then
      begin
                s:=s+'行数が長すぎます<br>';
      end else
      begin
                com:='';
        for j:=0 to temp.Count-1 do
        begin
                com:=com+'<br>'+temp[j];
        end;
      end;
    finally
        temp.Free;
    end;
  end;
  procedure cookie;
  begin
    with Response.Cookies.Add do
    begin
        Name:='name';
        Value:=Request.Authorization;
    if Value = '' then
    begin
        Value:=Request.CookieFields.Values['name'];
    end;
        Secure:=true;
        Expires:=Now+20;
    end;
  end;
begin
        s:='';
  if Request.Method <> 'POST' then
  begin
        s:=s+'不正な投稿をしないでください<br>';
  end;
  if (GAIBU = false)and(AnsiContainsStr(Request.URL,home) = false) then
  begin
        s:=s+'外部から書き込みできません<br>';
  end;
        name:=Request.ContentFields.Values['name'];
        sub:=Request.ContentFields.Values['sub'];
        com:=Request.ContentFields.Values['com'];
        pass:=Request.ContentFields.Values['password'];
  if name = '' then
  begin
        name:='no name';
  end else
        if Length(name) > maxn then
  begin
        s:=s+'名前が長すぎます<br>';
  end;
  if sub = '' then
  begin
        sub:=mudai;
  end else
        if Length(sub) > maxs then
  begin
        s:=s+'タイトルが長すぎます<br>';
  end;
  if com = '' then
  begin
        s:=s+'本文が書き込まれていません<br>';
  end else
        if Length(com) > maxv then
  begin
        s:=s+'本文が長すぎます<br>';
  end;
  for i:=0 to no_word.Count-1 do
  begin
    if (AnsiContainsText(com,no_word[i]) = true)or(AnsiContainsText(sub,no_word[i]) = true)or
      (AnsiContainsText(name,no_word[i]) = true) then
    begin
        s:=s+'使用できない言葉が含まれています<br>';
    end;
  end;
        x:=Now;
        y:=SecondsBetween(x,second);
  if (second <> 0)and(y < w_regist) then
  begin
    if ASQLite3Table1.FieldByName('com').AsString = com then
    begin
        Response.SendRedirect(home);
        Exit;
    end else
    begin
        s:=s+'連続投稿はもう少し時間をおいてからお願い致します　残り'+IntToStr(w_regist-y)+'秒<br>';
    end;
  end;
        second:=x;
        linecount;
        cookie;
  if s <> '' then
  begin
        Response.Content:=head+s+'ブラウザの戻るで移動してください。</body></html>';
  end else
  begin
        ASQLite3Table1.Last;
    if ASQLite3Table1.RecordCount = 0 then
    begin
        i:=0
    end else
    begin
        i:=ASQLite3Table1.FieldByName('no').AsInteger+1;
    end;
        ASQLite3Table1.AppendRecord([pass,i,Now,name,sub,com]);
        Response.SendRedirect(home+'?'+IntToStr(ASQLite3Table1.RecordCount div page_def));
  end;
end;

procedure TWebModule2.DataSetPageProducer2HTMLTag(Sender: TObject;
  Tag: TTag; const TagString: String; TagParams: TStrings;
  var ReplaceText: String);
begin
  if TagString = 'now' then
  begin
        ReplaceText:=DateToStr(ASQLite3Table1.FieldByName('date').AsFloat);
  end;
end;

procedure TWebModule2.DataSetPageProducer1HTMLTag(Sender: TObject;
  Tag: TTag; const TagString: String; TagParams: TStrings;
  var ReplaceText: String);
begin
  if TagString = 'home' then
  begin
        ReplaceText:=home;
  end else
        if TagString = 'now' then
  begin
        ReplaceText:=DateTimeToStr(ASQLite3Table1.FieldByName('date').AsFloat);
  end;
end;

procedure TWebModule2.WebModule2UsrdelAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  s, t: string;
  x: Boolean;
  no, pwd: string;
begin
        no:=Request.ContentFields.Values['no'];
        pwd:=Request.ContentFields.Values['pwd'];
  if (no = '')or(pwd = '') then
  begin
        t:='削除noまたは削除キーが入力もれです';
  end;
        s:='';
        x:=false;
  with ASQLite3Table1 do
  begin
        First;
  while Eof = false do
  begin
    if FieldByName('no').AsString = no then
    begin
        s:=ASQLite3Table1.FieldByName('pass').AsString;
        x:=true;
        break
    end;
        Next;
  end;
  end;
  if x = true then
  begin
    if s = '' then
    begin
        t:='該当記事には削除キーが設定されていません)';
    end else
        if s <> pwd then
    begin
        t:='削除キーが違います';
    end;
  end else
  begin
        t:='該当記事が見当たりません';
  end;
  if t <> '' then
  begin
        Response.Content:=head+t+'</body></html>';
  end else
  begin
        s:=Request.ContentFields.Values['no'];
    with ASQLite3Table1 do
    begin
        First;
    while Eof = false do
    begin
      if s = FieldByName('no').AsString then
      begin
                Delete;
                break;
      end;
        Next;
    end;
    end;
        Response.SendRedirect(home);
  end;
end;

procedure TWebModule2.PageProducer1HTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
begin
  if TagString = 'home' then
  begin
        ReplaceText:=home;
  end;
  if TagString = 'main' then
  begin
    with ASQLite3Table1 do
    begin
    if (pos+1)*page_def >= RecordCount then
    begin
        Last;
    end else
    begin
        RecNo:=(pos+1)*page_def-1;
    end;
    while (Bof = false)and(RecNo >= pos*page_def) do
    begin
        ReplaceText:=ReplaceText+DataSetPageProducer1.Content;
        Prior;
    end;
    end;
  end;
end;

procedure TWebModule2.WebModule2AdminAction(Sender: TObject; Request: TWebRequest;
  Response: TWebResponse; var Handled: Boolean);
var
  s: TStringList;
  t: TResourceStream;
begin
        s:=TStringList.Create;
        t:=TResourceStream.Create(HInstance,'File1.rc',PChar('TEXT'));
  try
        s.LoadFromStream(t);
        Response.Content:=s.Text
  finally
        s.Free;
        t.Free;
  end;
end;

procedure TWebModule2.PageProducer3HTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
begin
  if TagString = 'home' then
  begin
        ReplaceText:=home;
  end;
end;

procedure TWebModule2.WebModule2admin2Action(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  pwd: string;
begin
  if login = false then
  begin
        pwd:=Request.ContentFields.Values['apass'];
  end;
  if (login = true)or(admin_pass = pwd) then
  begin
        pos:=StrToIntDef(Request.Query,ASQLite3Table1.RecordCount div page_def);
        Response.Content:=PageProducer1.Content+footer('admin2');
        login:=true;
  end else
  begin
    if Request.MethodType <> mtPost then
    begin
        Response.Content:='ログインしてください';
    end else
    begin
        Response.Content:='パスワードが正しくありません';
    end;
  end;
end;

procedure TWebModule2.WebModule2admdelAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  i: integer;
  s: string;
begin
  for i:=0 to Request.ContentFields.Count-1 do
  begin
        s:=Request.ContentFields.Values[Request.ContentFields.Names[i]];
    with ASQLite3Table1 do
    begin
        First;
    while Eof = false do
    begin
      if s = FieldByName('no').AsString then
      begin
                Delete;
      end else
      begin
                Next;
      end;
    end;
    end;
  end;
        Response.SendRedirect(home+'admin2?'+IntToStr(pos));
end;

function TWebModule2.LinkContent(path: string): string;
var
  i, j: integer;
begin
        result:='';
  if pos > l_count div 2 then
  begin
        j:=-(l_count div 2);
  end else
  begin
        j:=-pos;
  end;
  for i:=0 to l_count-1 do
  begin
    if ASQLite3Table1.RecordCount < (pos+i+j)*page_def then
    begin
        break;
    end;
    if i+j = 0 then
    begin
        result:=result+'　'+IntToStr(pos)+'　';
    end else
    begin
        result:=result+Format('　<a href="'+home+path+'?%d">%d</a>　',[pos+i+j,pos+i+j]);
    end;
  end;
end;

procedure TWebModule2.WebModule2errorAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
        Response.SendRedirect(home);
end;

procedure TWebModule2.WebModule2nextAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  s: string;
begin
        s:='?'+IntToStr(pos+1);
  if login = true then
  begin
        Response.SendRedirect(home+'admin2'+s);
  end else
  begin
        Response.SendRedirect(home+s);
  end;
end;

procedure TWebModule2.WebModule2backAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  s: string;
begin
  if pos > 0 then
  begin
        s:='?'+IntToStr(pos-1);
  end else
  begin
        s:='?0';
  end;
  if login = true then
  begin
        Response.SendRedirect(home+'admin2'+s);
  end else
  begin
        Response.SendRedirect(home+s);
  end;
end;

function TWebModule2.footer(path: string): string;
begin
        page:='<hr size=1>%d　件中<br> %d 番目から %d 番目の記事を表示<br><center>Page:[<b><a href="'+home+'back"><<</a>'+
                LinkContent(path)+'<a href="'+home+'next">>></a>]</b></center>';
        result:=Format(page,[ASQLite3Table1.RecordCount,pos*page_def,(pos+1)*page_def-1])+foot;
end;

initialization
  if WebRequestHandler <> nil then
    WebRequestHandler.WebModuleClass := TWebModule2;

end.
