WebModuleUnit1.pas

   1 unit WebModuleUnit1;
   2
   3 interface
   4
   5 uses System.SysUtils, System.Classes, Web.HTTPApp, Web.DSProd, Web.HTTPProd,
   6   Web.DBWeb, System.Variants, System.NetEncoding, System.RegularExpressions,
   7   Data.DB, Web.DBXpressWeb, System.Types, FireDAC.Stan.Intf,
   8   FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS,
   9   FireDAC.Phys.Intf, FireDAC.DApt.Intf, FireDAC.Stan.Async, FireDAC.DApt,
  10   FireDAC.Comp.DataSet, FireDAC.Comp.Client, FireDAC.UI.Intf, FireDAC.Stan.Def,
  11   FireDAC.Stan.Pool, FireDAC.Phys, FireDAC.Phys.FB, FireDAC.Phys.FBDef,
  12   FireDAC.Phys.MySQL, FireDAC.Phys.MySQLDef, FireDAC.VCLUI.Wait,
  13   FireDAC.Comp.UI;
  14
  15 type
  16   TWebModule1 = class(TWebModule)
  17     articles: TDataSetPageProducer;
  18     index: TDataSetPageProducer;
  19     admin: TDataSetTableProducer;
  20     search: TPageProducer;
  21     items: TDataSetPageProducer;
  22     help: TPageProducer;
  23     top: TPageProducer;
  24     master: TPageProducer;
  25     alert: TDataSetPageProducer;
  26     mail: TPageProducer;
  27     css2: TPageProducer;
  28     css3: TPageProducer;
  29     css4: TPageProducer;
  30     header: TDataSetPageProducer;
  31     js1: TPageProducer;
  32     js2: TPageProducer;
  33     adhead: TPageProducer;
  34     js5: TPageProducer;
  35     title: TPageProducer;
  36     ti: TDataSetPageProducer;
  37     FDTable2: TFDTable;
  38     FDTable2DBNUM: TIntegerField;
  39     FDTable2NUMBER: TIntegerField;
  40     FDTable2TITLE: TWideStringField;
  41     FDTable2NAME: TWideStringField;
  42     FDTable2COMMENT: TWideMemoField;
  43     FDTable2RAW: TWideMemoField;
  44     FDTable2DATE: TDateField;
  45     FDTable2PASS: TWideStringField;
  46     FDTable5: TFDTable;
  47     FDTable4: TFDTable;
  48     FDTable4ID: TIntegerField;
  49     FDTable4DBNAME: TIntegerField;
  50     FDTable4POSNUM: TIntegerField;
  51     FDTable4DATE: TDateField;
  52     FDTable4REQUEST: TWideMemoField;
  53     DataSource1: TDataSource;
  54     FDTable3: TFDTable;
  55     FDTable3TITLE: TWideStringField;
  56     FDTable3TITLE2: TWideStringField;
  57     FDTable3INFO: TIntegerField;
  58     FDTable3COUNT: TIntegerField;
  59     FDTable3password: TWideStringField;
  60     FDTable3ng: TWideStringField;
  61     FDConnection1: TFDConnection;
  62     FDTable1: TFDTable;
  63     FDTable1DBNUM: TIntegerField;
  64     FDTable1DATABASE: TWideStringField;
  65     login: TPageProducer;
  66     footer: TPageProducer;
  67     FDGUIxWaitCursor1: TFDGUIxWaitCursor;
  68     FDQuery1: TFDQuery;
  69     FDTable3mente: TSmallintField;
  70     FDTable5id: TIntegerField;
  71     FDTable5name: TWideStringField;
  72     FDTable5source: TWideMemoField;
  73     procedure indexHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
  74       TagParams: TStrings; var ReplaceText: string);
  75     procedure WebModule1indexpageAction(Sender: TObject; Request: TWebRequest;
  76       Response: TWebResponse; var Handled: Boolean);
  77     procedure WebModule1registAction(Sender: TObject; Request: TWebRequest;
  78       Response: TWebResponse; var Handled: Boolean);
  79     procedure WebModuleCreate(Sender: TObject);
  80     procedure WebModule1adminAction(Sender: TObject; Request: TWebRequest;
  81       Response: TWebResponse; var Handled: Boolean);
  82     procedure WebModule1topAction(Sender: TObject; Request: TWebRequest;
  83       Response: TWebResponse; var Handled: Boolean);
  84     procedure itemsHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
  85       TagParams: TStrings; var ReplaceText: string);
  86     procedure topHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
  87       TagParams: TStrings; var ReplaceText: string);
  88     procedure WebModule1searchAction(Sender: TObject; Request: TWebRequest;
  89       Response: TWebResponse; var Handled: Boolean);
  90     procedure WebModule1helpAction(Sender: TObject; Request: TWebRequest;
  91       Response: TWebResponse; var Handled: Boolean);
  92     procedure searchHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
  93       TagParams: TStrings; var ReplaceText: string);
  94     procedure masterHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
  95       TagParams: TStrings; var ReplaceText: string);
  96     procedure articlesHTMLTag(Sender: TObject; Tag: TTag;
  97       const TagString: string; TagParams: TStrings; var ReplaceText: string);
  98     procedure footerHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
  99       TagParams: TStrings; var ReplaceText: string);
 100     procedure WebModule1alertAction(Sender: TObject; Request: TWebRequest;
 101       Response: TWebResponse; var Handled: Boolean);
 102     procedure WebModule1masterAction(Sender: TObject; Request: TWebRequest;
 103       Response: TWebResponse; var Handled: Boolean);
 104     procedure mailHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
 105       TagParams: TStrings; var ReplaceText: string);
 106     procedure alertHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
 107       TagParams: TStrings; var ReplaceText: string);
 108     procedure WebModule1deleteAction(Sender: TObject; Request: TWebRequest;
 109       Response: TWebResponse; var Handled: Boolean);
 110     procedure WebModule1jumpAction(Sender: TObject; Request: TWebRequest;
 111       Response: TWebResponse; var Handled: Boolean);
 112     procedure WebModule1linkAction(Sender: TObject; Request: TWebRequest;
 113       Response: TWebResponse; var Handled: Boolean);
 114     procedure headerHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
 115       TagParams: TStrings; var ReplaceText: string);
 116     procedure adminFormatCell(Sender: TObject; CellRow, CellColumn: Integer;
 117       var BgColor: THTMLBgColor; var Align: THTMLAlign; var VAlign: THTMLVAlign;
 118       var CustomAttrs, CellData: string);
 119     procedure WebModule1admdelAction(Sender: TObject; Request: TWebRequest;
 120       Response: TWebResponse; var Handled: Boolean);
 121     procedure WebModule1loginAction(Sender: TObject; Request: TWebRequest;
 122       Response: TWebResponse; var Handled: Boolean);
 123     procedure WebModule1adminsetAction(Sender: TObject; Request: TWebRequest;
 124       Response: TWebResponse; var Handled: Boolean);
 125     procedure adheadHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
 126       TagParams: TStrings; var ReplaceText: string);
 127     procedure WebModule1logoutAction(Sender: TObject; Request: TWebRequest;
 128       Response: TWebResponse; var Handled: Boolean);
 129     procedure WebModule1imgAction(Sender: TObject; Request: TWebRequest;
 130       Response: TWebResponse; var Handled: Boolean);
 131     procedure WebModule1fileAction(Sender: TObject; Request: TWebRequest;
 132       Response: TWebResponse; var Handled: Boolean);
 133     procedure titleHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
 134       TagParams: TStrings; var ReplaceText: string);
 135     procedure WebModule1titleAction(Sender: TObject; Request: TWebRequest;
 136       Response: TWebResponse; var Handled: Boolean);
 137     procedure tiHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
 138       TagParams: TStrings; var ReplaceText: string);
 139     procedure helpHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
 140       TagParams: TStrings; var ReplaceText: string);
 141     procedure loginHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
 142       TagParams: TStrings; var ReplaceText: string);
 143     procedure css1HTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
 144       TagParams: TStrings; var ReplaceText: string);
 145     procedure WebModule1usrdelAction(Sender: TObject; Request: TWebRequest;
 146       Response: TWebResponse; var Handled: Boolean);
 147   private
 148     { private \90é\8c¾ }
 149     ss: TStringList;
 150     tagstr: string;
 151     procedure pages(count: Integer; var page: Integer);
 152     procedure strsCheck(var Error: string; list: TStringList);
 153     procedure setLastArticle;
 154     function footerLink(Data: array of const): string;
 155     function isInfo: Boolean;
 156     function loginCheck: Boolean;
 157     function hash(str: string): string;
 158     function mente: Boolean;
 159     function detail(ts, pid: string): string;
 160     function scan(text: string): string;
 161   public
 162     { public \90é\8c¾ }
 163   end;
 164
 165 var
 166   WebModuleClass: TComponentClass = TWebModule1;
 167
 168 implementation
 169
 170 { %CLASSGROUP 'Vcl.Controls.TControl' }
 171
 172 uses IdHashSHA, IdGlobal, IdHash, IdHashMessageDigest, Jpeg, Graphics;
 173
 174 {$R *.dfm}
 175
 176 const
 177   promotion = '\8dL\8d\90:';
 178   tcnt = 7;
 179
 180 procedure TWebModule1.adheadHTMLTag(Sender: TObject; Tag: TTag;
 181   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 182 begin
 183   if TagString = 'pr' then
 184     ReplaceText := promotion
 185   else if TagString = 'uri' then
 186     ReplaceText := Request.ScriptName
 187   else if (TagString = 'mente') and (FDTable3.FieldByName('mente').AsInteger = 1)
 188   then
 189     ReplaceText := 'checked="checked"'
 190   else if TagString = 'database' then
 191     ReplaceText := Request.QueryFields.Values['db'];
 192 end;
 193
 194 procedure TWebModule1.adminFormatCell(Sender: TObject;
 195   CellRow, CellColumn: Integer; var BgColor: THTMLBgColor;
 196   var Align: THTMLAlign; var VAlign: THTMLVAlign;
 197   var CustomAttrs, CellData: string);
 198 begin
 199   if CellRow = 0 then
 200   begin
 201     BgColor:='Silver';
 202     Exit;
 203   end;
 204   if CellRow mod 2 = 0 then
 205     BgColor:='snow';
 206   case CellColumn of
 207     0:
 208       CellData := Format('<input name=check%d type=checkbox>', [CellRow]);
 209     1:
 210       CellData := '<b>' + CellData + '</b>';
 211     2:
 212       CellData := '<p style=color:red>' + CellData + '</p>';
 213     3:
 214       CellData := '<p style=color:green>' + CellData + '</p>';
 215   end;
 216 end;
 217
 218 procedure TWebModule1.alertHTMLTag(Sender: TObject; Tag: TTag;
 219   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 220 var
 221   s: TStringList;
 222   i: Integer;
 223 begin
 224   if (TagString = 'plus') and (alert.Tag = 0) then
 225     ReplaceText := '<a href=' + Request.ScriptName +
 226       '/jump?db=<#dbname>&num=<#posnum>>[ <#dbname>-<#posnum> ]</a>'
 227   else if TagString = 'article' then
 228   begin
 229     if alert.Tag = 1 then
 230     begin
 231       ReplaceText := '<p>\83\8a\83N\83G\83X\83g';
 232       Exit;
 233     end;
 234     s := TStringList.Create;
 235     try
 236       s.text := articles.Content;
 237       for i := 1 to 2 do
 238         s.Delete(1);
 239       for i := s.count - 1 downto 0 do
 240         if Copy(s[i], 1, 18) = '<section id=master' then
 241         begin
 242           s.Delete(i);
 243           break;
 244         end;
 245       ReplaceText := s.text;
 246     finally
 247       s.Free;
 248     end;
 249   end;
 250 end;
 251
 252 procedure TWebModule1.articlesHTMLTag(Sender: TObject; Tag: TTag;
 253   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 254 begin
 255   if TagString = 'uri' then
 256     ReplaceText := Request.ScriptName
 257   else if TagString = 'comment' then
 258     ReplaceText := FDTable2.FieldByName('comment').AsString;
 259 end;
 260
 261 procedure TWebModule1.css1HTMLTag(Sender: TObject; Tag: TTag;
 262   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 263 begin
 264   if TagString = 'uri' then
 265     ReplaceText := Request.ScriptName;
 266 end;
 267
 268 function TWebModule1.detail(ts, pid: string): string;
 269 var
 270   i: Integer;
 271 begin
 272   for i := 0 to ComponentCount - 1 do
 273     if Components[i].Name = ts + pid then
 274       result := (Components[i] as TPageProducer).Content;
 275 end;
 276
 277 procedure TWebModule1.footerHTMLTag(Sender: TObject; Tag: TTag;
 278   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 279 var
 280   i: Integer;
 281   s: shortstring;
 282   x: Boolean;
 283 begin
 284   if TagString = 'link' then
 285   begin
 286     for i := 1 to 10 do
 287     begin
 288       x := i = index.Tag;
 289       ReplaceText := ReplaceText + footerLink([i, i, x]);
 290     end;
 291     x := index.Tag = -1;
 292     s:='\82³\82¢\82²';
 293     ReplaceText := ReplaceText + footerLink([-1, s, x]);
 294   end;
 295 end;
 296
 297 function TWebModule1.footerLink(Data: array of const): string;
 298 var
 299   s, t: string;
 300 begin
 301   if data[1].VType = vtInteger then
 302     t:=data[1].VInteger.toString
 303   else
 304     t:=data[1].VString^;
 305   if Data[2].VBoolean = true then
 306     s := ' active'
 307   else
 308     s := '';
 309   result := Format
 310     ('<li class="page-item%s"><a class=page-link href="%s?db=%d&num=%d">%s</a></li>',
 311     [s, Request.ScriptName + PString(Self.Tag)^, FDTable1.FieldByName('dbnum')
 312     .AsInteger, Data[0].VInteger, t]);
 313 end;
 314
 315 function TWebModule1.hash(str: string): string;
 316 begin
 317   with TIdHashSHA1.Create do
 318   begin
 319     try
 320       result := HashStringAsHex(str);
 321     finally
 322       Free;
 323     end;
 324   end;
 325 end;
 326
 327 procedure TWebModule1.headerHTMLTag(Sender: TObject; Tag: TTag;
 328   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 329 var
 330   s: string;
 331 begin
 332   if TagString = 'uri' then
 333     ReplaceText := Request.ScriptName
 334   else if TagString = 'cookie' then
 335   begin
 336     s := TagParams.Values['param'];
 337     ReplaceText := TNetEncoding.URL.Decode(Request.CookieFields.Values[s]);
 338   end
 339   else if (TagString = 'check') and
 340     (Request.ContentFields.Values['show'] <> 'false') then
 341     ReplaceText := 'checked'
 342   else if TagString = 'preview' then
 343     ReplaceText := Request.ContentFields.Values['preview']
 344   else if TagString = 'raw' then
 345     ReplaceText := Request.ContentFields.Values['raw']
 346   else if TagString = 'pass' then
 347     ReplaceText := Request.ContentFields.Values['password']
 348   else if TagString = 'title' then
 349     ReplaceText := Request.ContentFields.Values['title'];
 350 end;
 351
 352 procedure TWebModule1.helpHTMLTag(Sender: TObject; Tag: TTag;
 353   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 354 begin
 355   if TagString = 'pr' then
 356     ReplaceText := promotion
 357   else if TagString = 'uri' then
 358     ReplaceText := Request.ScriptName
 359   else if TagString = 'area' then
 360     if help.Tag = 0 then
 361     begin
 362       ss := TStringList.Create;
 363       try
 364         ss.Add('<form action=' + Request.ScriptName +
 365           '/help method=post><p>\82¨\96â\82¢\8d\87\82í\82¹<\8dí\8f\9c\88Ë\97\8a\82È\82Ç\89½\82Å\82à></p>');
 366         ss.Add('<textarea name=help style=height:100px;width:250px>\93\8a\8de\8eÒ\96¼\82È\82Ç\81F');
 367         ss.Add('\91\8a\92k\93à\97e\81F');
 368         ss.Add('\82»\82Ì\91¼\81F</textarea><br>');
 369         ss.Add('<input type=submit value="\91\97\90M"></form>');
 370         ReplaceText := ss.text;
 371       finally
 372         ss.Free;
 373       end;
 374     end
 375     else
 376       ReplaceText :=
 377         '<p style=color:yellow;background-color:aqua>\82²\95ñ\8d\90\82 \82è\82ª\82Æ\82¤\82²\82´\82¢\82Ü\82·.';
 378 end;
 379
 380 procedure TWebModule1.indexHTMLTag(Sender: TObject; Tag: TTag;
 381   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 382 var
 383   i: Integer;
 384 begin
 385   if TagString = 'pr' then
 386     ReplaceText := promotion
 387   else if TagString = 'uri' then
 388     ReplaceText := Request.ScriptName
 389   else if TagString = 'article' then
 390   begin
 391     for i := 1 to FDTable3.FieldByName('count').AsInteger do
 392     begin
 393       if FDTable2.Eof = true then
 394         break;
 395       if isInfo = false then
 396         ReplaceText := ReplaceText + articles.Content
 397       else
 398         ReplaceText := articles.Content + ReplaceText;
 399       FDTable2.Next;
 400     end;
 401   end
 402   else if TagString = 'footer' then
 403     ReplaceText := footer.Content
 404   else if TagString = 'header' then
 405     if (FDTable1.FieldByName('dbnum').AsInteger = FDTable3.FieldByName('info')
 406       .AsInteger) and (loginCheck = false) then
 407       ReplaceText := '<h1 style=text-align:center>\8aÇ\97\9d\90l\82©\82ç\82¨\92m\82ç\82¹\82ª\82 \82è\82Ü\82·.</h1>'
 408     else
 409     begin
 410       i := FDTable3.FieldByName('count').AsInteger;
 411       if 10 * i <= FDTable2.RecordCount then
 412         ReplaceText := '<h1>\82±\82ê\88È\8fã\93\8a\8de\82Å\82«\82Ü\82¹\82ñ.</h1>'
 413       else
 414         ReplaceText := header.Content;
 415     end
 416   else if (TagString = 'css') or (TagString = 'js') then
 417     ReplaceText := detail(TagString, TagParams.Values['id'])
 418   else if TagString = 'dbnum' then
 419     ReplaceText := FDTable1.FieldByName('dbnum').AsString
 420   else if TagString = 'database' then
 421     ReplaceText := FDTable1.FieldByName('database').AsString;
 422 end;
 423
 424 function TWebModule1.isInfo: Boolean;
 425 begin
 426   result := FDTable1.FieldByName('dbnum').AsInteger = FDTable3.FieldByName
 427     ('info').AsInteger;
 428 end;
 429
 430 procedure TWebModule1.itemsHTMLTag(Sender: TObject; Tag: TTag;
 431   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 432 var
 433   s: TStringList;
 434   t, str: string;
 435   i, j: Integer;
 436 begin
 437   if TagString = 'item' then
 438   begin
 439     s := TStringList.Create;
 440     try
 441       s.text := FDTable2.FieldByName('raw').AsString;
 442       for i := 0 to s.count - 1 do
 443         for j := 0 to ss.count - 1 do
 444           if Pos(ss[j], s[i]) > 0 then
 445             if Self.Tag = 0 then
 446               s[i] := '<p style=background-color:aqua>' + s[i]
 447             else
 448               s[i] := '<p style=background-color:yellow>' + s[i];
 449       with FDTable2 do
 450       begin
 451         i := FieldByName('dbnum').AsInteger;
 452         j := FieldByName('number').AsInteger;
 453         str := Request.QueryFields.Values['db'];
 454         if str = '' then
 455           t := Format('<a href="%s/jump?db=%d&num=%d">[ %d-%d ]</a>',
 456             [Request.ScriptName, i, j, i, j])
 457         else
 458           t := Format('<a href="%s/jump?db=%s&num=%d">[ %d ]</a>',
 459             [Request.ScriptName, str, j, j]);
 460       end;
 461       ReplaceText := t + s.text;
 462     finally
 463       s.Free;
 464     end;
 465   end;
 466 end;
 467
 468 function TWebModule1.loginCheck: Boolean;
 469 begin
 470   result := hash(Request.CookieFields.Values['user']) = FDTable3.FieldByName
 471     ('password').AsString;
 472 end;
 473
 474 procedure TWebModule1.loginHTMLTag(Sender: TObject; Tag: TTag;
 475   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 476 var
 477   i: Integer;
 478 begin
 479   if TagString = 'pr' then
 480     ReplaceText := promotion
 481   else if TagString = 'uri' then
 482     ReplaceText := Request.ScriptName
 483   else if TagString = 'database' then
 484   begin
 485     i := StrToIntDef(Request.QueryFields.Values['db'],
 486       FDTable3.FieldByName('info').AsInteger);
 487     if FDTable1.Locate('dbnum', i) = true then
 488       ReplaceText := FDTable1.FieldByName('database').AsString;
 489   end;
 490 end;
 491
 492 procedure TWebModule1.masterHTMLTag(Sender: TObject; Tag: TTag;
 493   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 494 var
 495   i, j: Integer;
 496 begin
 497   if TagString = 'pr' then
 498     ReplaceText := promotion
 499   else if TagString = 'uri' then
 500     ReplaceText := Request.ScriptName
 501   else if TagString = 'request' then
 502   begin
 503     FDTable1.Close;
 504     with FDTable4 do
 505     begin
 506       First;
 507       while Eof = false do
 508       begin
 509         i := FieldByName('dbname').AsInteger;
 510         j := FieldByName('posnum').AsInteger;
 511         if FDTable2.Locate('dbnum;number', VarArrayOf([i, j])) = true then
 512           alert.Tag := 0
 513         else
 514           alert.Tag := 1;
 515         ReplaceText := ReplaceText + alert.ContentFromString(alert.Content);
 516         Next;
 517       end;
 518       if ReplaceText <> '' then
 519         ReplaceText := '<table border=1 align=center>' + ReplaceText +
 520           '</table>';
 521     end;
 522     FDTable1.Open;
 523     FDTable1.Refresh;
 524   end;
 525 end;
 526
 527 function TWebModule1.mente: Boolean;
 528 var
 529   s: string;
 530 begin
 531   if FDTable3.FieldByName('mente').AsInteger = 1 then
 532   begin
 533     s := Request.QueryFields.Values['db'];
 534     if s <> '' then
 535       s := '?db=' + s;
 536     result := true;
 537     Response.Content :=
 538       '<p><br><h1 style=text-align:center>\82½\82¾\82¢\82Ü\83\81\83\93\83e\83i\83\93\83X\92\86\82Å\82·^_^</h1>' +
 539       Format('<p style=text-align:center><a href=%s/admin%s>\8aÇ\97\9d\8eÒ\97p\83\8d\83O\83C\83\93</a>',
 540       [Request.ScriptName, s]);
 541   end
 542   else
 543     result := false;
 544 end;
 545
 546 procedure TWebModule1.pages(count: Integer; var page: Integer);
 547 var
 548   max: Integer;
 549 begin
 550   max := FDTable3.FieldByName('count').AsInteger;
 551   if (page > -1) and (count < max * (page - 1)) then
 552   begin
 553     page := (count div max) + 1;
 554     if count mod max = 0 then
 555       dec(page);
 556   end;
 557   case page of
 558     - 1:
 559       begin
 560         FDTable2.Last;
 561         FDTable2.MoveBy(1 - max);
 562       end;
 563   else
 564     FDTable2.First;
 565     FDTable2.MoveBy(max * (page - 1));
 566   end;
 567 end;
 568
 569 procedure TWebModule1.mailHTMLTag(Sender: TObject; Tag: TTag;
 570   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 571 begin
 572   if TagString = 'pr' then
 573     ReplaceText := promotion
 574   else if TagString = 'uri' then
 575     ReplaceText := Request.ScriptName
 576   else if TagString = 'content' then
 577     ReplaceText := articles.Content
 578   else if TagString = 'query' then
 579     ReplaceText := '?' + Request.Query
 580   else if TagString = 'number' then
 581     ReplaceText := Request.QueryFields.Values['num'];
 582 end;
 583
 584 function TWebModule1.scan(text: string): string;
 585 var
 586   reg: TRegEx;
 587   coll: TMatchCollection;
 588   i, j: Integer;
 589   s, t, str: string;
 590 begin
 591   i := Request.QueryFields.Values['db'].ToInteger;
 592   s := Request.ScriptName;
 593   text := TNetEncoding.HTML.Encode(text);
 594   str := TNetEncoding.HTML.Encode('>>');
 595   reg := TRegEx.Create(str + '(\d+)');
 596   coll := reg.Matches(text);
 597   for j := coll.count - 1 downto 0 do
 598   begin
 599     Delete(text, coll[j].index, coll[j].Length);
 600     t := Copy(coll[j].Value, Length(str) + 1, coll[j].Length);
 601     result := Format
 602       ('<a class=minpreview data-preview-url=%s/link?db=%d&num=%s href=%s/jump?db=%d&num=%s>>>%s</a>',
 603       [s, i, t, s, i, t, t]);
 604     Insert(result, text, coll[j].index);
 605   end;
 606   result := text;
 607 end;
 608
 609 procedure TWebModule1.searchHTMLTag(Sender: TObject; Tag: TTag;
 610   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 611 var
 612   s: TStringList;
 613   str: string;
 614   procedure sub;
 615   var
 616     i: Integer;
 617     j: Integer;
 618   label jump;
 619   begin
 620     FDTable2.First;
 621     while FDTable2.Eof = false do
 622     begin
 623       s.text := FDTable2.FieldByName('raw').AsString;
 624       ss.DelimitedText := Request.ContentFields.Values['word1'];
 625       for j := 0 to ss.count - 1 do
 626         for i := 0 to s.count - 1 do
 627           if Pos(ss[j], s[i]) > 0 then
 628             if Self.Tag = 0 then
 629             begin
 630               ReplaceText := ReplaceText + items.Content;
 631               goto jump;
 632             end
 633             else
 634             begin
 635               if j = ss.count - 1 then
 636               begin
 637                 ReplaceText := ReplaceText + items.Content;
 638                 goto jump;
 639               end
 640               else
 641                 break;
 642             end
 643           else if i = s.count - 1 then
 644             goto jump;
 645     jump:
 646       FDTable2.Next;
 647     end;
 648   end;
 649
 650 begin
 651   if TagString = 'pr' then
 652     ReplaceText := promotion
 653   else if TagString = 'uri' then
 654     ReplaceText := Request.ScriptName
 655   else if TagString = 'select' then
 656   begin
 657     str := Request.QueryFields.Values['db'];
 658     if str = '' then
 659       ReplaceText := Request.ScriptName + '/'
 660     else
 661       ReplaceText := Request.ScriptName + '/index?db=' + str;
 662   end
 663   else if (Request.MethodType = mtPost) and (TagString = 'items') then
 664   begin
 665     if Request.ContentFields.Values['type'] = 'OR' then
 666       Self.Tag := 0
 667     else
 668       Self.Tag := 1;
 669     s := TStringList.Create;
 670     ss := TStringList.Create;
 671     try
 672       ss.Delimiter := ' ';
 673       ss.StrictDelimiter := false;
 674       if Request.QueryFields.Values['db'] = '' then
 675       begin
 676         FDTable1.First;
 677         while FDTable1.Eof = false do
 678         begin
 679           sub;
 680           FDTable1.Next;
 681         end;
 682       end
 683       else
 684         sub;
 685     finally
 686       s.Free;
 687       ss.Free;
 688     end;
 689   end
 690   else if TagString = 'query' then
 691   begin
 692     ReplaceText := Request.Query;
 693     if ReplaceText <> '' then
 694       ReplaceText := '?' + ReplaceText;
 695   end
 696   else if TagString = 'css' then
 697     ReplaceText := css2.Content
 698   else if TagString = 'dbnum' then
 699     ReplaceText := Request.QueryFields.Values['dbnum'];
 700 end;
 701
 702 procedure TWebModule1.setLastArticle;
 703 begin
 704   FDTable2.Last;
 705 end;
 706
 707 procedure TWebModule1.strsCheck(var Error: string; list: TStringList);
 708 var
 709   s: TStringList;
 710   i, j: Integer;
 711   x: Boolean;
 712 begin
 713   x := false;
 714   s := TStringList.Create;
 715   try
 716     s.DelimitedText := FDTable3.FieldByName('ng').AsString;
 717     for i := 0 to s.count - 1 do
 718       for j := 0 to list.count - 1 do
 719         if Pos(s[i], list[j]) > 0 then
 720         begin
 721           x := true;
 722           break;
 723         end;
 724     for i := 0 to list.count - 1 do
 725       list[i] := '<p>' + scan(list[i]);
 726   finally
 727     s.Free;
 728   end;
 729   if x = true then
 730     Error := Error + '<p>\8bÖ\8e~\8cê\8bå\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82Ü\82·.';
 731 end;
 732
 733 procedure TWebModule1.tiHTMLTag(Sender: TObject; Tag: TTag;
 734   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 735 begin
 736   if TagString = 'uri' then
 737     ReplaceText := Request.ScriptName
 738   else if TagString = 'count' then
 739     ReplaceText := FDTable2.RecordCount.ToString
 740   else if TagString = 'database' then
 741     ReplaceText := FDTable1.FieldByName('database').AsString
 742   else if TagString = 'date' then
 743     ReplaceText := FDQuery1.FieldByName('max(date)').AsString;
 744 end;
 745
 746 procedure TWebModule1.titleHTMLTag(Sender: TObject; Tag: TTag;
 747   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 748 begin
 749   if TagString = 'pr' then
 750     ReplaceText := promotion
 751   else if TagString = 'uri' then
 752     ReplaceText := Request.ScriptName
 753   else if TagString = 'js' then
 754     ReplaceText := detail(TagString, TagParams.Values['id'])
 755   else if TagString = 'main' then
 756   begin
 757     FDQuery1.Open;
 758     while FDQuery1.Eof = false do
 759     begin
 760       FDTable1.Locate('dbnum', FDQuery1.FieldByName('dbnum').AsInteger);
 761       ReplaceText := ReplaceText + ti.Content;
 762       FDQuery1.Next;
 763     end;
 764     FDQuery1.Close;
 765   end;
 766 end;
 767
 768 procedure TWebModule1.topHTMLTag(Sender: TObject; Tag: TTag;
 769   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 770 var
 771   s, t: string;
 772   i, j, k: Integer;
 773 begin
 774   if TagString = 'pr' then
 775     ReplaceText := promotion
 776   else if TagString = 'uri' then
 777     ReplaceText := Request.ScriptName
 778   else if TagString = 'list' then
 779   begin
 780     i := FDTable3.FieldByName('info').AsInteger;
 781     for k := 0 to tcnt do
 782     begin
 783       if FDTable1.Eof = true then
 784         break;
 785       t := '';
 786       j := FDTable1.FieldByName('dbnum').AsInteger;
 787       s := FDTable1.FieldByName('database').AsString;
 788       if (i = j) or (s = 'master') then
 789       begin
 790         FDTable1.Next;
 791         continue;
 792       end;
 793       FDTable2.Last;
 794       if (Now - FDTable2.FieldByName('date').AsDateTime < 1) and
 795         (FDTable2.RecordCount > 0) then
 796         t := 'background-color:aqua;';
 797       if FDTable2.RecordCount >= 10 * FDTable3.FieldByName('count').AsInteger
 798       then
 799         t := t + 'color:red;';
 800       if t <> '' then
 801         t := ' style=' + t;
 802       ReplaceText := ReplaceText +
 803         Format('<p><a%s target=_blank href="%s/index?db=%d">%s</a><br></p>',
 804         [t, Request.ScriptName, j, s]);
 805       FDTable1.Next;
 806     end;
 807     ReplaceText :=
 808       '<div class="carousel-caption text-left" style="text-align:bottom;font-size:1.5rem">'
 809       + ReplaceText + '</div>';
 810   end
 811   else if TagString = 'info' then
 812     ReplaceText := FDTable1.Lookup('dbnum', FDTable3.FieldByName('info')
 813       .AsInteger, 'database')
 814   else if TagString = 'dbnum' then
 815     ReplaceText := FDTable3.FieldByName('info').AsString
 816   else if (TagString = 'css') or (TagString = 'js') then
 817     ReplaceText := detail(TagString, TagParams.Values['id'])
 818   else if TagString = 'slide' then
 819   begin
 820     s := ' active';
 821     for i := 1 to (FDTable1.RecordCount div tcnt) + 1 do
 822     begin
 823       ReplaceText := ReplaceText +
 824         Format('<div class="carousel-item%s"><img src="%s/src?name=slide%d.jpg"',
 825         [s, Request.ScriptName, i]) +
 826         ' class="d-sm-block d-none" style=float:right;height:465px><div style=height:465px></div><#list></div>';
 827       s := '';
 828     end;
 829   end
 830   else if TagString = 'indicator' then
 831   begin
 832     s := ' class="active"';
 833     for i := 0 to (FDTable1.RecordCount div tcnt) do
 834     begin
 835       ReplaceText := ReplaceText +
 836         Format('<li data-target="#slide-1" data-slide-to=%d%s></li>', [i, s]);
 837       s := '';
 838     end;
 839   end;
 840 end;
 841
 842 procedure TWebModule1.WebModule1admdelAction(Sender: TObject;
 843   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 844 var
 845   i, j, k, m: Integer;
 846   reg: TRegEx;
 847   match: TMatch;
 848 begin
 849   j := 0;
 850   FDTable1.Locate('dbnum', Request.QueryFields.Values['db']);
 851   for i := 0 to Request.ContentFields.count - 1 do
 852   begin
 853     reg := TRegEx.Create('\d+');
 854     match := reg.match(Request.ContentFields[i]);
 855     if match.Success = true then
 856     begin
 857       k := match.Value.ToInteger - j - 1;
 858       j := match.Value.ToInteger;
 859       for m := 1 to k do
 860         FDTable2.Next;
 861       FDTable2.Delete;
 862     end;
 863   end;
 864   WebModule1adminAction(nil, Request, Response, Handled);
 865 end;
 866
 867 procedure TWebModule1.WebModule1adminAction(Sender: TObject;
 868   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 869 var
 870   s, t: string;
 871   i: Integer;
 872 begin
 873   s := Request.CookieFields.Values['user'];
 874   if (s = '') or (loginCheck = false) then
 875   begin
 876     WebModule1loginAction(nil, Request, Response, Handled);
 877     Exit;
 878   end;
 879   admin.MaxRows := FDTable3.FieldByName('count').AsInteger;
 880   t := Request.QueryFields.Values['db'];
 881   if t <> '' then
 882     FDTable1.Locate('dbnum', t, []);
 883   s := Request.QueryFields.Values['num'];
 884   i := StrToIntDef(s, -1);
 885   pages(FDTable2.RecordCount, i);
 886   index.Tag := i;
 887   tagstr := '/admin';
 888   Self.Tag := Integer(@tagstr);
 889   admin.header.text := adhead.Content;
 890   admin.footer.Clear;
 891   admin.footer.Add
 892     ('<input type=submit value=\8dí\8f\9c\82·\82é><input type=reset value=\83\8a\83Z\83b\83g></form>');
 893   admin.footer.Add(footer.Content);
 894   if t <> '' then
 895     t := '?db=' + t;
 896   admin.footer.Add
 897     (Format('<p style=text-align:center><a href="%s/index%s">\96ß\82é</a>',
 898     [Request.ScriptName, t]));
 899   Response.ContentType := 'text/html;charset=utf-8';
 900   Response.Content := admin.Content;
 901 end;
 902
 903 procedure TWebModule1.WebModule1adminsetAction(Sender: TObject;
 904   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 905 var
 906   s: string;
 907   i: Integer;
 908 begin
 909   s := Request.ContentFields.Values['pass'];
 910   with FDTable3 do
 911   begin
 912     Edit;
 913     if Request.ContentFields.Values['mente'] = 'on' then
 914       i := 1
 915     else
 916       i := 0;
 917     FieldByName('mente').AsInteger := i;
 918     if (s <> '') and (s = Request.ContentFields.Values['pass2']) then
 919     begin
 920       s := hash(s);
 921       FieldByName('password').AsString := hash(s);
 922       with Response.Cookies.Add do
 923       begin
 924         Name := 'user';
 925         Value := s;
 926         Expires := Now + 14;
 927         Secure := true;
 928       end;
 929     end;
 930     Post;
 931   end;
 932   WebModule1adminAction(nil, Request, Response, Handled);
 933 end;
 934
 935 procedure TWebModule1.WebModule1alertAction(Sender: TObject;
 936   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 937 var
 938   num1, num2, i: Integer;
 939   s: string;
 940 begin
 941   num1 := Request.QueryFields.Values['db'].ToInteger;
 942   num2 := StrToIntDef(Request.QueryFields.Values['num'], -1);
 943   if num2 = -1 then
 944     Exit;
 945   if Request.MethodType = mtGet then
 946   begin
 947     FDTable1.Locate('dbnum', num1);
 948     FDTable2.Locate('number', num2);
 949     Response.ContentType := 'text/html;charset=utf-8';
 950     Response.Content := mail.Content;
 951   end
 952   else
 953   begin
 954     with FDTable4 do
 955     begin
 956       Last;
 957       i := FieldByName('id').AsInteger + 1;
 958       s := Request.ContentFields.Values['request'];
 959       if s = '' then
 960         s := '(No Comment)';
 961       AppendRecord([i, num1, num2, Now, s]);
 962     end;
 963     WebModule1jumpAction(nil, Request, Response, Handled);
 964   end;
 965 end;
 966
 967 procedure TWebModule1.WebModule1deleteAction(Sender: TObject;
 968   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 969 var
 970   num: Integer;
 971   s: string;
 972 begin
 973   s := Request.ContentFields.Values['num'];
 974   if s = '' then
 975     Exit;
 976   num := s.ToInteger;
 977   s := hash(Request.ContentFields.Values['password']);
 978   with FDTable2 do
 979     if Locate('number;pass', VarArrayOf([num, s])) = true then
 980     begin
 981       Edit;
 982       FieldByName('title').AsString := '';
 983       FieldByName('name').AsString := ' - - - ';
 984       FieldByName('comment').AsString := '<em>\93\8a\8de\8eÒ\82É\82æ\82è\8dí\8f\9c\82³\82ê\82Ü\82µ\82½.</em>';
 985       FieldByName('raw').AsString := '';
 986       FieldByName('date').AsDateTime := Now;
 987       Post;
 988       WebModule1jumpAction(nil, Request, Response, Handled);
 989     end
 990     else
 991       WebModule1indexpageAction(nil, Request, Response, Handled);
 992 end;
 993
 994 procedure TWebModule1.WebModule1fileAction(Sender: TObject;
 995   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 996 var
 997   s: string;
 998 begin
 999   s := Request.QueryFields.Values['type'];
1000   if s = 'js' then
1001     Response.ContentType := 'text/javascript'
1002   else if s = 'css' then
1003     Response.ContentType := 'text/css';
1004   Response.Content := detail(s, Request.QueryFields.Values['id']);
1005 end;
1006
1007 procedure TWebModule1.WebModule1helpAction(Sender: TObject;
1008   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1009 var
1010   k: Integer;
1011   s: string;
1012 begin
1013   Response.ContentType := 'text/html;charset=utf-8';
1014   if Request.MethodType = mtPost then
1015   begin
1016     s := Request.ContentFields.Values['help'];
1017     FDTable4.Last;
1018     k := FDTable4.FieldByName('id').AsInteger + 1;
1019     FDTable4.AppendRecord([k, -1, -1, Now, s]);
1020     help.Tag := 1;
1021   end
1022   else
1023     help.Tag := 0;
1024   Response.Content := help.Content;
1025 end;
1026
1027 procedure TWebModule1.WebModule1imgAction(Sender: TObject; Request: TWebRequest;
1028   Response: TWebResponse; var Handled: Boolean);
1029 var
1030   s: string;
1031   p: TBytes;
1032   res: TMemoryStream;
1033 begin
1034   with FDTable5 do
1035   begin
1036     s := Request.QueryFields.Values['name'];
1037     Response.ContentType := 'image/jpeg';
1038     if Locate('name', s) = true then
1039     begin
1040       s := FieldByName('source').AsString;
1041       p := TNetEncoding.Base64.DecodeStringToBytes(s);
1042       res := TMemoryStream.Create;
1043       res.WriteBuffer(p, Length(p));
1044       Response.ContentStream := res;
1045     end
1046     else
1047       Response.ContentStream := nil;
1048   end;
1049 end;
1050
1051 procedure TWebModule1.WebModule1indexpageAction(Sender: TObject;
1052   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1053 var
1054   i: Integer;
1055   s: string;
1056 begin
1057   Response.ContentType := 'text/html; charset="utf-8"';
1058   if mente = true then
1059     Exit;
1060   s := Request.QueryFields.Values['db'];
1061   if s <> '' then
1062     FDTable1.Locate('dbnum', s, []);
1063   i := StrToIntDef(Request.QueryFields.Values['num'], -1);
1064   isInfo;
1065   pages(FDTable2.RecordCount, i);
1066   index.Tag := i;
1067   tagstr := '/index';
1068   Self.Tag := Integer(@tagstr);
1069   Response.Content := index.Content;
1070 end;
1071
1072 procedure TWebModule1.WebModule1jumpAction(Sender: TObject;
1073   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1074 var
1075   DB, s: string;
1076   i: Integer;
1077 begin
1078   DB := Request.QueryFields.Values['db'];
1079   s := Request.QueryFields.Values['num'];
1080   if s = '' then
1081     s := Request.ContentFields.Values['num'];
1082   i := 10;
1083   pages(s.ToInteger, i);
1084   Response.SendRedirect(Format('%s/index?db=%s&num=%d#%s', [Request.ScriptName,
1085     DB, i, s]));
1086 end;
1087
1088 procedure TWebModule1.WebModule1linkAction(Sender: TObject;
1089   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1090 var
1091   s: string;
1092 begin
1093   s := Request.QueryFields.Values['db'];
1094   if (s = '') or (FDTable1.Locate('dbnum', s.ToInteger) = false) then
1095     Exit;
1096   s := Request.QueryFields.Values['num'];
1097   if (s <> '') and (FDTable2.Locate('number', s.ToInteger) = true) then
1098   begin
1099     Response.ContentType := 'text/html;charset=utf-8';
1100     Response.Content := articles.Content;
1101   end;
1102 end;
1103
1104 procedure TWebModule1.WebModule1loginAction(Sender: TObject;
1105   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1106 var
1107   v: Variant;
1108   i: Integer;
1109   s, t: string;
1110 begin
1111   if Request.MethodType = mtGet then
1112   begin
1113     Response.ContentType := 'text/html;charset=utf-8';
1114     Response.Content := login.Content;
1115     Exit;
1116   end;
1117   s := Request.ContentFields.Values['record'];
1118   v := FDTable1.Lookup('database', s, 'dbnum');
1119   t := hash(Request.ContentFields.Values['password']);
1120   if (VarIsNull(v) = false) and (hash(t) = FDTable3.FieldByName('password')
1121     .AsString) then
1122   begin
1123     with Response.Cookies.Add do
1124     begin
1125       Name := 'user';
1126       Value := t;
1127       Expires := Now + 14;
1128       // Secure := true;
1129     end;
1130     i := v;
1131     if s = 'master' then
1132       Response.SendRedirect(Request.ScriptName + '/master')
1133     else
1134       Response.SendRedirect(Request.ScriptName + '/admin?db=' + i.ToString);
1135   end
1136   else if VarIsNull(v) = false then
1137   begin
1138     t := v;
1139     Response.SendRedirect(Request.ScriptName + '/login?db=' + t);
1140   end
1141   else
1142     Response.SendRedirect(Request.ScriptName + '/login');
1143 end;
1144
1145 procedure TWebModule1.WebModule1logoutAction(Sender: TObject;
1146   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1147 var
1148   i: Integer;
1149   s: string;
1150   x: Boolean;
1151 begin
1152   with Response.Cookies.Add do
1153   begin
1154     Name := 'user';
1155     Expires := Now - 1;
1156   end;
1157   s := Request.QueryFields.Values['db'];
1158   i := StrToIntDef(s, -1);
1159   x := FDTable1.Locate('dbnum', i);
1160   if (x = true) and (FDTable1.FieldByName('database').AsString = 'master') then
1161     x := false;
1162   if x = false then
1163     Response.SendRedirect(Request.ScriptName + '/')
1164   else
1165     Response.SendRedirect(Request.ScriptName + '/index?db=' + s);
1166 end;
1167
1168 procedure TWebModule1.WebModule1masterAction(Sender: TObject;
1169   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1170 var
1171   s: string;
1172   i: Integer;
1173 begin
1174   if loginCheck = false then
1175   begin
1176     Request.QueryFields.Values['db'] := FDTable1.Lookup('database',
1177       'master', 'dbnum');
1178     WebModule1loginAction(nil, Request, Response, Handled);
1179     Exit;
1180   end;
1181   if Request.MethodType = mtPost then
1182   begin
1183     s := Request.ContentFields.Values['delete'];
1184     with FDTable4 do
1185       if s = 'all' then
1186         while not((Bof = true) and (Eof = true)) do
1187           Delete
1188       else
1189       begin
1190         First;
1191         while Eof = false do
1192         begin
1193           i := FieldByName('dbname').AsInteger;
1194           if FDTable1.Locate('dbnum', i) = true then
1195           begin
1196             i := FieldByName('posnum').AsInteger;
1197             if FDTable2.Locate('number', i) = false then
1198               Delete
1199             else
1200               Next;
1201           end
1202           else
1203             Delete;
1204         end;
1205       end;
1206   end;
1207   FDTable4.First;
1208   Response.ContentType := 'text/html;charset=utf-8';
1209   Response.Content := master.Content;
1210 end;
1211
1212 procedure TWebModule1.WebModule1registAction(Sender: TObject;
1213   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1214 var
1215   number, i: Integer;
1216   title, na, raw, pass, kotoba, Error, temp: string;
1217   comment: TStringList;
1218   review: Boolean;
1219 begin
1220   Error := '';
1221   temp := Request.ContentFields.Values['preview'];
1222   if temp = '' then
1223   begin
1224     kotoba := Request.ContentFields.Values['aikotoba'];
1225     if kotoba <> '\82°\82ñ\82«' then
1226       Error := Error + '<p>\8d\87\8c¾\97t\82ª\82¿\82ª\82¢\82Ü\82·.';
1227     with Request.ContentFields do
1228     begin
1229       title := Values['title'];
1230       na := Values['name'];
1231       raw := Values['comment'];
1232       Values['comment'] := '';
1233       pass := hash(Values['password']);
1234     end;
1235     if title = '' then
1236       title := '\83^\83C\83g\83\8b\82È\82µ.';
1237     with Response.Cookies.Add do
1238     begin
1239       Name := 'name';
1240       if na = '' then
1241         Value := '\92N\82©\82³\82ñ.'
1242       else
1243         Value := na;
1244       Expires := Now + 14;
1245     end;
1246     if Error = '' then
1247       with Response.Cookies.Add do
1248       begin
1249         Name := 'aikotoba';
1250         Value := kotoba;
1251         Expires := Now + 14;
1252       end;
1253     comment := TStringList.Create;
1254     try
1255       comment.text := raw;
1256       strsCheck(Error, comment);
1257       temp := comment.text;
1258     finally
1259       comment.Free;
1260     end;
1261     review := false;
1262   end
1263   else
1264     review := true;
1265   Request.ContentFields.Values['raw'] := raw;
1266   if Error <> '' then
1267     Request.ContentFields.Values['preview'] := '<section style=color:red>' +
1268       Error + '</section>'
1269   else if Request.ContentFields.Values['show'] = 'true' then
1270   begin
1271     if review = false then
1272       Error := '<p style=font-size:2.3em;color:blue>\81«\81«\83v\83\8c\83r\83\85\81[\81«\81«<p>' + temp
1273     else
1274       Error := temp;
1275     Request.ContentFields.Values['preview'] := Error;
1276     Request.ContentFields.Values['show'] := 'false';
1277   end
1278   else
1279   begin
1280     i := StrToIntDef(Request.QueryFields.Values['db'], -1);
1281     if FDTable1.Locate('dbnum', i) = false then
1282       Response.SendRedirect(Request.ScriptName + '/')
1283     else
1284     begin
1285       setLastArticle;
1286       number := FDTable2.FieldByName('number').AsInteger + 1;
1287       FDTable2.AppendRecord([i, number, title, na, temp, raw, Now, pass]);
1288       Response.SendRedirect(Request.ScriptName + '/index?db=' + i.ToString +
1289         '#article');
1290     end;
1291     Exit;
1292   end;
1293   WebModule1indexpageAction(nil, Request, Response, Handled);
1294 end;
1295
1296 procedure TWebModule1.WebModule1searchAction(Sender: TObject;
1297   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1298 begin
1299   Response.ContentType := 'text/html;charset=utf-8';
1300   Response.Content := search.Content;
1301 end;
1302
1303 procedure TWebModule1.WebModule1titleAction(Sender: TObject;
1304   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1305 begin
1306   Response.ContentType := 'text/html;charset=utf-8';
1307   Response.Content := title.Content;
1308 end;
1309
1310 procedure TWebModule1.WebModule1topAction(Sender: TObject; Request: TWebRequest;
1311   Response: TWebResponse; var Handled: Boolean);
1312 begin
1313   Response.ContentType := 'text/html;charset=utf-8';
1314   FDTable1.First;
1315   if mente = false then
1316     Response.Content := top.ContentFromString(top.Content);
1317 end;
1318
1319 procedure TWebModule1.WebModule1usrdelAction(Sender: TObject;
1320   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1321 var
1322   s, t, p: string;
1323 begin
1324   s := Request.QueryFields.Values['db'];
1325   t := Request.ContentFields.Values['num'];
1326   p := Request.ContentFields.Values['password'];
1327   if FDTable2.Locate('dbnum;number;pass',
1328     VarArrayOf([s.ToInteger, t.ToInteger, p])) = true then
1329     FDTable2.Delete;
1330   WebModule1indexpageAction(nil, Request, Response, Handled);
1331 end;
1332
1333 procedure TWebModule1.WebModuleCreate(Sender: TObject);
1334 var
1335   i: Integer;
1336   s: string;
1337 begin
1338   if FDTable1.Exists = false then
1339     FDTable1.CreateTable;
1340   if FDTable2.Exists = false then
1341     FDTable2.CreateTable;
1342   if FDTable3.Exists = false then
1343     FDTable3.CreateTable;
1344   if FDTable4.Exists = false then
1345     FDTable4.CreateTable;
1346   if FDTable5.Exists = false then
1347     FDTable5.CreateTable;
1348   FDTable1.Open;
1349   FDTable2.Open;
1350   FDTable3.Open;
1351   FDTable4.Open;
1352   FDTable5.Open;
1353   FDTable1.Refresh;
1354   FDTable3.Refresh;
1355   FDTable4.Refresh;
1356   FDTable5.Refresh;
1357   if (FDTable1.Bof = true) and (FDTable1.Eof = true) then
1358   begin
1359     FDTable1.AppendRecord([0, 'info']);
1360     FDTable1.AppendRecord([1, 'master']);
1361     for i := 1 to 10 do
1362       FDTable1.AppendRecord([i + 1, '\8cf\8e¦\94Â' + i.ToString]);
1363   end;
1364   if (FDTable3.Bof = true) and (FDTable3.Eof = true) then
1365   begin
1366     i := FDTable1.Lookup('database', 'info', 'dbnum');
1367     s := '\88¢\95Û,\94n\8e,\8e\80\82Ë';
1368     FDTable3.AppendRecord
1369       (['\82Æ\82é\82Ë\81`\82Ç\8d\86',
1370       '<h1 style=color:maron;text-align:center;font-style:italic>\82Æ\82é\82Ë\81`\82Ç\8d\86</h1>',
1371       0, i, 30, hash(hash('admin')), s]);
1372   end;
1373   admin.MaxRows := FDTable3.FieldByName('count').AsInteger;
1374 end;
1375
1376 end.