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;
    ASQLite3Query1: TASQLite3Query;
    PageProducer3: TPageProducer;
    ASQLite3Table2: TASQLite3Table;
    ASQLite3Table3: TASQLite3Table;
    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 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 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 WebModule2viewAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
  private
    { Private declarations }
    title1, title2: string;
    head, body, foot, page: string;
    pos: integer;
    htmlw: Boolean;
    html: TStringList;
    admin_pass: string;
    r_name: string;
    home: string;
    page_def: integer;
    maxn, maxs, maxv, maxw: integer;
    maxline: integer;
    w_regist: Int64;
    autolink, tag: Boolean;
    mudai: string;
    re_color: string;
    hostview: integer;
    no_host, no_word: TStringList;
    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, 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">';
//* 一ページあたりの表示記事数 */
        page_def := 10;

        l_count:=5;
        pos:=-1;
//* 文字数制限（名前、題名、本文）全角だとこの半分です */
        maxn  := 40;
        maxs  := 40;
        maxv  := 1500;

        maxw:=160;
//* 本文の改行数制限 */
        maxline := 25;
//* 同一ホストからの連続投稿を制限
//  --> 秒数を記述するとその時間以上を経過しないと連続投稿できない*/
        w_regist := 5;
//* 文中で自動リンクするかどうか（yes=1 no=0）*/
        autolink := true;
//* HTMLタグを有効にするか（yes=1 no=0)*/
        tag := true;
//* タイトル無しで投稿された場合 */
        mudai := '(無題)';
//* ＞がついた時の色 */
        re_color := '#225588';
//* ホストを表示するか（表示しない=0 <!-->内で表示=1 表示=2）*/
        hostview := 1;

        htmlw:=true;
//* 外部書き込み禁止にする?(する=1,しない=0) */
//define("GAIBU", 0);

//* 使用するファイルロックのタイプ（mkdir=1 flock=2 使わない=0）*/
//define("LOCKEY", 2); 		//通常は2でOK
//* mkdirロックを使う時はlockという名でディレクトリを作成して777にしてください */
//define("LOCK" , "lock/plock");	//lockの中に作るロックファイル名
        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"';
        html:=TStringList.Create;
end;

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

procedure TWebModule2.WebModuleBeforeDispatch(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  i: integer;
begin
  with ASQLite3Query1 do
  begin
        ExecSQL;
        SQL.Clear;
        SQL.Add('CREATE TABLE if not exists pass(week integer, pass text);');
        ExecSQL;
  end;
        ASQLite3Table1.Active:=true;;
  with ASQLite3Table3 do
  begin
        Active:=true;
  if RecordCount = 0 then
  begin
    for i:=1 to 7 do
    begin
        AppendRecord([i,'full']);
    end;
  end;
  end;
        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 loginlist.IndexOf(Request.InternalPathInfo) = -1 then
  begin
    with Response.Cookies.Add do
    begin
        Name:='admin_pass';
        Value:='';
//        Secure:=true;
    end;
  end else
  with ASQLite3Table3 do
  begin
        First;
        i:=DayOfWeek(Now);
    while Eof = false do
    begin
      if i = FieldByName('week').AsInteger then
      begin
                admin_pass:=FieldByName('pass').AsString;
                break;
      end;
        Next;
    end;
  end;
  for i:=0 to no_host.Count-1 do
  begin
    if AnsiContainsText(Request.URL,no_host[i]) = true then
    begin
                Response.StatusCode:=204;
                Handled:=true;
                break;
    end;
  end;
end;

procedure TWebModule2.WebModule2indexAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
        r_name:=Request.CookieFields.Values['name'];
        pos:=StrToIntDef(Request.Query,-1);
  if (htmlw = true)and(pos <= -1) then
  begin
    if FileExists('index.html') = false then
    begin
        html.Text:=PageProducer2.Content;
        html.SaveToFile('index.html');
    end else
    begin
        html.LoadFromFile('index.html');
    end;
        Response.Content:=html.Text;
  end else
  begin
        Response.Content:=PageProducer2.Content;
  end;
end;

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

procedure TWebModule2.PageProducer2HTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
var
  s: string;
  count: integer;
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)or((pos+1)*page_def > ASQLite3Table1.RecordCount) then
    begin
        ASQLite3Table1.Last;
      if pos <= -1 then
      begin
                pos:=-1;
      end else
      begin
                pos:=ASQLite3Table1.RecordCount div page_def;
      end;
    end else
    begin
        ASQLite3Table1.RecNo:=(pos+1)*page_def;
    end;
        count:=0;
    while (ASQLite3Table1.Bof = false)and((pos = -1)or(ASQLite3Table1.RecNo > pos*page_def)) do
    begin
      if count > page_def then
      begin
                break;
      end;
        s:=s+DataSetPageProducer2.Content;
        ASQLite3Table1.Prior;
        inc(count);
    end;
        ReplaceText:=s;
  end;
  if TagString = 'title2' then
  begin
        ReplaceText:=title2;
  end;
  if TagString = 'r_name' then
  begin
        ReplaceText:=r_name;
  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: string;
  l_name, pass, sub, com: string;
  x: TDateTime;
  y: Int64;
  procedure linecount;
  var
    j: integer;
    t: WideString;
    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
                t:=temp[j];
          while Length(t) > maxw do
          begin
                com:=com+'<br>'+Copy(t,1,maxw);
                Delete(t,1,maxw);
          end;
                com:=com+'<br>'+t;
        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.ContentFields.Values['name'];
    end;
        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;
        l_name:=Request.ContentFields.Values['name'];
        sub:=Request.ContentFields.Values['sub'];
        com:=Request.ContentFields.Values['com'];
        pass:=Request.ContentFields.Values['password'];
  if l_name = '' then
  begin
        l_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;
        ASQLite3Table1.Last;
        x:=Now;
        y:=SecondsBetween(x,ASQLite3Table1.FieldByName('date').AsFloat);
  if (ASQLite3Table1.FieldByName('com').AsString = com)and
    (ASQLite3Table1.FieldByName('name').AsString = name) then
  begin
        Response.SendRedirect(home);
        Exit;
  end;
  if y < w_regist then
  begin
        s:=s+'混み合っています　残り'+IntToStr(w_regist-y)+'秒<br>';
  end;
        linecount;
        cookie;
  if s <> '' then
  begin
        Response.Content:=head+s+'ブラウザの戻るで移動してください。</body></html>';
  end else
  begin
    if Request.ContentFields.Values['property'] = 'view' then
    begin
      with ASQLite3Query1 do
      begin
        SQL.Text:='CREATE TABLE if NOT EXISTS view(pass text, no integer, date real, name text, sub text, com text);';
        ExecSQL;
      end;
      with ASQLite3Table2 do
      begin
        Active:=true;
      if RecordCount > 0 then
      begin
                Last;
                i:=FieldByName('no').AsInteger+1;
      end else
      begin
                i:=1;
      end;
        AppendRecord([pass,i,Now,l_name,sub,com]);
        Active:=false;
      end;
        Response.Content:='<table border=1><tr><td>名前</td><td>'+l_name+'</td></tr><tr><td>タイトル</td><td>'+
          sub+'</td></tr><tr><td>コメント</td><td>'+com+'</td></tr></table><form method=post action='+home+
          'view?'+IntToStr(i)+'><input type=submit value="決定">書き直す場合はブラウザの戻る';
        Exit;
    end;
        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,l_name,sub,com]);
    if htmlw = true then
    begin
        html.Text:=PageProducer2.Content;
        html.SaveToFile('index.html');
    end;
        Response.SendRedirect(home);
  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 else
  begin
        ReplaceText:=ASQLite3Table1.FieldByName(TagString).AsString;
  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);
var
  count: integer;
begin
  if TagString = 'home' then
  begin
        ReplaceText:=home;
  end;
  if TagString = 'main' then
  begin
    with ASQLite3Table1 do
    begin
    if (pos = -1)or((pos+1)*page_def > RecordCount) then
    begin
        Last;
      if pos <> -1 then
      begin
                pos:=ASQLite3Table1.RecordCount div page_def;
      end;
    end else
    begin
        RecNo:=(pos+1)*page_def;
    end;
        count:=0;
    while (Bof = false)and((pos = -1)or(RecNo > pos*page_def)) do
    begin
      if count > page_def then
      begin
                break;
      end;
        ReplaceText:=ReplaceText+DataSetPageProducer1.Content;
        Prior;
        inc(count);
    end;
    end;
  end;
  if TagString = 'pos' then
  begin
        ReplaceText:=IntToStr(pos);
  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 (Request.ContentFields.IndexOfName('apass') = -1)or(Request.MethodType <> mtPost) then
  begin
        pwd:=Request.CookieFields.Values['admin_pass'];
  end else
  begin
        pwd:=Request.ContentFields.Values['apass'];
  end;
  if (admin_pass = pwd)and(admin_pass <> '') then
  begin
        pos:=StrToIntDef(Request.Query,-1);
        Response.Content:=PageProducer1.Content+footer('admin2');
    with Response.Cookies.Add do
    begin
        Name:='admin_pass';
        Value:=pwd;
//        Secure:=true;
    end;
  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, j: integer;
  s: string;
begin
  if (admin_pass <> '')and(Request.CookieFields.Values['pass'] = admin_pass) then
  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;
      if htmlw = true then
      begin
                j:=pos;
                pos:=-1;
                html.Text:=PageProducer2.Content;
                html.SaveToFile('index.html');
                pos:=j;
      end;
    end;

  end;
        Response.SendRedirect(home+'admin2?'+Request.Query);
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;

function TWebModule2.footer(path: string): string;
var
  s, t, u: string;
  i: integer;
begin
  if pos <= -1 then
  begin
        s:='<hr size=1>最新%d件の記事を表示<br><center>Pages:[<b>';
        page:='<<'+LinkContent(path)+'>>]　最新<br></center>';
        result:=Format(s,[page_def])+page+foot;
  end else
  begin
    if pos = 0 then
    begin
        t:='?0';
        u:='?'+IntToStr(pos+1);
    end else
    begin
        i:=ASQLite3Table1.RecordCount div page_def;
        t:='?'+IntToStr(pos-1);
      if pos = i then
      begin
                u:='?'+IntToStr(i);
      end else
      begin
                u:='?'+IntToStr(pos+1);
      end;
    end;
        page:='<a href="'+home+path+t+'"><<</a>'+LinkContent(path)+
                '<a href="'+home+path+u+'">>></a>]　<a href="'+home+path+'">最新</a></b></center>';
        s:='<hr size=1>%d　件中<br> %d 番目から %d 番目の記事を表示<br><center>Page:[<b>';
        result:=Format(s,[ASQLite3Table1.RecordCount,pos*page_def,(pos+1)*page_def-1])+page+foot;
  end;
end;

procedure TWebModule2.WebModule2viewAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  i: integer;
  x: Boolean;
  p, n, d, s, c: string;
begin
        i:=StrToIntDef(Request.Query,0);
  if i > 0 then
  begin
    with ASQLite3Table2 do
    begin
        Active:=true;
        x:=false;
        Last;
    while Bof = false do
    begin
      if FieldByName('no').AsInteger = i then
      begin
                x:=true;
                p:=FieldByName('pass').AsString;
                n:=FieldByName('name').AsString;
                d:=FieldByName('date').AsString;
                s:=FieldByName('sub').AsString;
                c:=FieldByName('com').AsString;
                Delete;
                break;
      end;
        Prior;
    end;
        Active:=false;
    end;
    if x = true then
    begin
      with ASQLite3Table1 do
      begin
      if RecordCount = 0 then
      begin
                i:=0;
      end else
      begin
                Last;
                i:=FieldByName('no').AsInteger+1;
      end;
        AppendRecord([p,i,d,n,s,c]);
      end;
      if htmlw = true then
      begin
                html.Text:=PageProducer2.Content;
                html.SaveToFile('index.html');
      end;
    end;
  end;
        Response.SendRedirect(home);
end;

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

end.
