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 + tagstr, FDTable1.FieldByName('dbnum').AsInteger,
 312     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     with FDTable4 do
 503     begin
 504       First;
 505       while Eof = false do
 506       begin
 507         i := FieldByName('dbname').AsInteger;
 508         j := FieldByName('posnum').AsInteger;
 509         if FDTable2.Locate('dbnum;number', VarArrayOf([i, j])) = true then
 510           alert.Tag := 0
 511         else
 512           alert.Tag := 1;
 513         ReplaceText := ReplaceText + alert.ContentFromString(alert.Content);
 514         Next;
 515       end;
 516       if ReplaceText <> '' then
 517         ReplaceText := '<table border=1 align=center>' + ReplaceText +
 518           '</table>';
 519     end;
 520 end;
 521
 522 function TWebModule1.mente: Boolean;
 523 var
 524   s: string;
 525 begin
 526   if FDTable3.FieldByName('mente').AsInteger = 1 then
 527   begin
 528     s := Request.QueryFields.Values['db'];
 529     if s <> '' then
 530       s := '?db=' + s;
 531     result := true;
 532     Response.Content :=
 533       '<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>' +
 534       Format('<p style=text-align:center><a href=%s/admin%s>\8aÇ\97\9d\8eÒ\97p\83\8d\83O\83C\83\93</a>',
 535       [Request.ScriptName, s]);
 536   end
 537   else
 538     result := false;
 539 end;
 540
 541 procedure TWebModule1.pages(count: Integer; var page: Integer);
 542 var
 543   max: Integer;
 544 begin
 545   max := FDTable3.FieldByName('count').AsInteger;
 546   if (page > -1) and (count < max * (page - 1)) then
 547   begin
 548     page := (count div max) + 1;
 549     if count mod max = 0 then
 550       dec(page);
 551   end;
 552   case page of
 553     - 1:
 554       begin
 555         FDTable2.Last;
 556         FDTable2.MoveBy(1 - max);
 557       end;
 558   else
 559     FDTable2.First;
 560     FDTable2.MoveBy(max * (page - 1));
 561   end;
 562 end;
 563
 564 procedure TWebModule1.mailHTMLTag(Sender: TObject; Tag: TTag;
 565   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 566 begin
 567   if TagString = 'pr' then
 568     ReplaceText := promotion
 569   else if TagString = 'uri' then
 570     ReplaceText := Request.ScriptName
 571   else if TagString = 'content' then
 572     ReplaceText := articles.Content
 573   else if TagString = 'query' then
 574     ReplaceText := '?' + Request.Query
 575   else if TagString = 'number' then
 576     ReplaceText := Request.QueryFields.Values['num'];
 577 end;
 578
 579 function TWebModule1.scan(text: string): string;
 580 var
 581   reg: TRegEx;
 582   coll: TMatchCollection;
 583   i, j: Integer;
 584   s, t, str: string;
 585 begin
 586   i := Request.QueryFields.Values['db'].ToInteger;
 587   s := Request.ScriptName;
 588   text := TNetEncoding.HTML.Encode(text);
 589   str := TNetEncoding.HTML.Encode('>>');
 590   reg := TRegEx.Create(str + '(\d+)');
 591   coll := reg.Matches(text);
 592   for j := coll.count - 1 downto 0 do
 593   begin
 594     Delete(text, coll[j].index, coll[j].Length);
 595     t := Copy(coll[j].Value, Length(str) + 1, coll[j].Length);
 596     result := Format
 597       ('<a class=minpreview data-preview-url=%s/link?db=%d&num=%s href=%s/jump?db=%d&num=%s>>>%s</a>',
 598       [s, i, t, s, i, t, t]);
 599     Insert(result, text, coll[j].index);
 600   end;
 601   result := text;
 602 end;
 603
 604 procedure TWebModule1.searchHTMLTag(Sender: TObject; Tag: TTag;
 605   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 606 var
 607   s: TStringList;
 608   str: string;
 609   procedure sub;
 610   var
 611     i: Integer;
 612     j: Integer;
 613   label jump;
 614   begin
 615     FDTable2.First;
 616     while FDTable2.Eof = false do
 617     begin
 618       s.text := FDTable2.FieldByName('raw').AsString;
 619       ss.DelimitedText := Request.ContentFields.Values['word1'];
 620       for j := 0 to ss.count - 1 do
 621         for i := 0 to s.count - 1 do
 622           if Pos(ss[j], s[i]) > 0 then
 623             if Self.Tag = 0 then
 624             begin
 625               ReplaceText := ReplaceText + items.Content;
 626               goto jump;
 627             end
 628             else
 629             begin
 630               if j = ss.count - 1 then
 631               begin
 632                 ReplaceText := ReplaceText + items.Content;
 633                 goto jump;
 634               end
 635               else
 636                 break;
 637             end
 638           else if i = s.count - 1 then
 639             goto jump;
 640     jump:
 641       FDTable2.Next;
 642     end;
 643   end;
 644
 645 begin
 646   if TagString = 'pr' then
 647     ReplaceText := promotion
 648   else if TagString = 'uri' then
 649     ReplaceText := Request.ScriptName
 650   else if TagString = 'select' then
 651   begin
 652     str := Request.QueryFields.Values['db'];
 653     if str = '' then
 654       ReplaceText := Request.ScriptName + '/'
 655     else
 656       ReplaceText := Request.ScriptName + '/index?db=' + str;
 657   end
 658   else if (Request.MethodType = mtPost) and (TagString = 'items') then
 659   begin
 660     if Request.ContentFields.Values['type'] = 'OR' then
 661       Self.Tag := 0
 662     else
 663       Self.Tag := 1;
 664     s := TStringList.Create;
 665     ss := TStringList.Create;
 666     try
 667       ss.Delimiter := ' ';
 668       ss.StrictDelimiter := false;
 669       if Request.QueryFields.Values['db'] = '' then
 670       begin
 671         FDTable1.First;
 672         while FDTable1.Eof = false do
 673         begin
 674           sub;
 675           FDTable1.Next;
 676         end;
 677       end
 678       else
 679         sub;
 680     finally
 681       s.Free;
 682       ss.Free;
 683     end;
 684   end
 685   else if TagString = 'query' then
 686   begin
 687     ReplaceText := Request.Query;
 688     if ReplaceText <> '' then
 689       ReplaceText := '?' + ReplaceText;
 690   end
 691   else if TagString = 'css' then
 692     ReplaceText := css2.Content
 693   else if TagString = 'dbnum' then
 694     ReplaceText := Request.QueryFields.Values['dbnum'];
 695 end;
 696
 697 procedure TWebModule1.setLastArticle;
 698 begin
 699   FDTable2.Last;
 700 end;
 701
 702 procedure TWebModule1.strsCheck(var Error: string; list: TStringList);
 703 var
 704   s: TStringList;
 705   i, j: Integer;
 706   x: Boolean;
 707 begin
 708   x := false;
 709   s := TStringList.Create;
 710   try
 711     s.DelimitedText := FDTable3.FieldByName('ng').AsString;
 712     for i := 0 to s.count - 1 do
 713       for j := 0 to list.count - 1 do
 714         if Pos(s[i], list[j]) > 0 then
 715         begin
 716           x := true;
 717           break;
 718         end;
 719     for i := 0 to list.count - 1 do
 720       list[i] := '<p>' + scan(list[i]);
 721   finally
 722     s.Free;
 723   end;
 724   if x = true then
 725     Error := Error + '<p>\8bÖ\8e~\8cê\8bå\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82Ü\82·.';
 726 end;
 727
 728 procedure TWebModule1.tiHTMLTag(Sender: TObject; Tag: TTag;
 729   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 730 begin
 731   if TagString = 'uri' then
 732     ReplaceText := Request.ScriptName
 733   else if TagString = 'count' then
 734     ReplaceText := FDTable2.RecordCount.toString
 735   else if TagString = 'database' then
 736     ReplaceText := FDTable1.FieldByName('database').AsString
 737   else if TagString = 'date' then
 738     ReplaceText := FDQuery1.FieldByName('max(date)').AsString;
 739 end;
 740
 741 procedure TWebModule1.titleHTMLTag(Sender: TObject; Tag: TTag;
 742   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 743 begin
 744   if TagString = 'pr' then
 745     ReplaceText := promotion
 746   else if TagString = 'uri' then
 747     ReplaceText := Request.ScriptName
 748   else if TagString = 'js' then
 749     ReplaceText := detail(TagString, TagParams.Values['id'])
 750   else if TagString = 'main' then
 751   begin
 752     FDQuery1.Open;
 753     while FDQuery1.Eof = false do
 754     begin
 755       FDTable1.Locate('dbnum', FDQuery1.FieldByName('dbnum').AsInteger);
 756       ReplaceText := ReplaceText + ti.Content;
 757       FDQuery1.Next;
 758     end;
 759     FDQuery1.Close;
 760   end;
 761 end;
 762
 763 procedure TWebModule1.topHTMLTag(Sender: TObject; Tag: TTag;
 764   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 765 var
 766   s, t: string;
 767   i, j, k: Integer;
 768 begin
 769   if TagString = 'pr' then
 770     ReplaceText := promotion
 771   else if TagString = 'uri' then
 772     ReplaceText := Request.ScriptName
 773   else if TagString = 'list' then
 774   begin
 775     i := FDTable3.FieldByName('info').AsInteger;
 776     for k := 0 to tcnt do
 777     begin
 778       if FDTable1.Eof = true then
 779         break;
 780       t := '';
 781       j := FDTable1.FieldByName('dbnum').AsInteger;
 782       s := FDTable1.FieldByName('database').AsString;
 783       if (i = j) or (s = 'master') then
 784       begin
 785         FDTable1.Next;
 786         continue;
 787       end;
 788       FDTable2.Last;
 789       if (Now - FDTable2.FieldByName('date').AsDateTime < 1) and
 790         (FDTable2.RecordCount > 0) then
 791         t := 'background-color:aqua;';
 792       if FDTable2.RecordCount >= 10 * FDTable3.FieldByName('count').AsInteger
 793       then
 794         t := t + 'color:red;';
 795       if t <> '' then
 796         t := ' style=' + t;
 797       ReplaceText := ReplaceText +
 798         Format('<p><a%s target=_blank href="%s/index?db=%d">%s</a><br></p>',
 799         [t, Request.ScriptName, j, s]);
 800       FDTable1.Next;
 801     end;
 802     ReplaceText :=
 803       '<div class="carousel-caption text-left" style="text-align:bottom;font-size:1.5rem">'
 804       + ReplaceText + '</div>';
 805   end
 806   else if TagString = 'info' then
 807     ReplaceText := FDTable1.Lookup('dbnum', FDTable3.FieldByName('info')
 808       .AsInteger, 'database')
 809   else if TagString = 'dbnum' then
 810     ReplaceText := FDTable3.FieldByName('info').AsString
 811   else if (TagString = 'css') or (TagString = 'js') then
 812     ReplaceText := detail(TagString, TagParams.Values['id'])
 813   else if TagString = 'slide' then
 814   begin
 815     s := ' active';
 816     for i := 1 to (FDTable1.RecordCount div tcnt) + 1 do
 817     begin
 818       ReplaceText := ReplaceText +
 819         Format('<div class="carousel-item%s"><img src="%s/src?name=slide%d.jpg"',
 820         [s, Request.ScriptName, i]) +
 821         ' class="d-sm-block d-none" style=float:right;height:465px><div style=height:465px></div><#list></div>';
 822       s := '';
 823     end;
 824   end
 825   else if TagString = 'indicator' then
 826   begin
 827     s := ' class="active"';
 828     for i := 0 to (FDTable1.RecordCount div tcnt) do
 829     begin
 830       ReplaceText := ReplaceText +
 831         Format('<li data-target="#slide-1" data-slide-to=%d%s></li>', [i, s]);
 832       s := '';
 833     end;
 834   end;
 835 end;
 836
 837 procedure TWebModule1.WebModule1admdelAction(Sender: TObject;
 838   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 839 var
 840   i, j, k, m: Integer;
 841   reg: TRegEx;
 842   match: TMatch;
 843 begin
 844   j := 0;
 845   FDTable1.Locate('dbnum', Request.QueryFields.Values['db']);
 846   for i := 0 to Request.ContentFields.count - 1 do
 847   begin
 848     reg := TRegEx.Create('\d+');
 849     match := reg.match(Request.ContentFields[i]);
 850     if match.Success = true then
 851     begin
 852       k := match.Value.ToInteger - j - 1;
 853       j := match.Value.ToInteger;
 854       for m := 1 to k do
 855         FDTable2.Next;
 856       FDTable2.Delete;
 857     end;
 858   end;
 859   WebModule1adminAction(nil, Request, Response, Handled);
 860 end;
 861
 862 procedure TWebModule1.WebModule1adminAction(Sender: TObject;
 863   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 864 var
 865   s, t: string;
 866   i: Integer;
 867 begin
 868   s := Request.CookieFields.Values['user'];
 869   if (s = '') or (loginCheck = false) then
 870   begin
 871     WebModule1loginAction(nil, Request, Response, Handled);
 872     Exit;
 873   end;
 874   admin.MaxRows := FDTable3.FieldByName('count').AsInteger;
 875   t := Request.QueryFields.Values['db'];
 876   if t <> '' then
 877     FDTable1.Locate('dbnum', t, []);
 878   s := Request.QueryFields.Values['num'];
 879   i := StrToIntDef(s, -1);
 880   pages(FDTable2.RecordCount, i);
 881   index.Tag := i;
 882   tagstr := '/admin';
 883   admin.header.text := adhead.Content;
 884   admin.footer.Clear;
 885   admin.footer.Add
 886     ('<input type=submit value=\8dí\8f\9c\82·\82é><input type=reset value=\83\8a\83Z\83b\83g></form>');
 887   admin.footer.Add(footer.Content);
 888   if t <> '' then
 889     t := '?db=' + t;
 890   admin.footer.Add
 891     (Format('<p style=text-align:center><a href="%s/index%s">\96ß\82é</a>',
 892     [Request.ScriptName, t]));
 893   Response.ContentType := 'text/html;charset=utf-8';
 894   Response.Content := admin.Content;
 895 end;
 896
 897 procedure TWebModule1.WebModule1adminsetAction(Sender: TObject;
 898   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 899 var
 900   s: string;
 901   i: Integer;
 902 begin
 903   s := Request.ContentFields.Values['pass'];
 904   with FDTable3 do
 905   begin
 906     Edit;
 907     if Request.ContentFields.Values['mente'] = 'on' then
 908       i := 1
 909     else
 910       i := 0;
 911     FieldByName('mente').AsInteger := i;
 912     if (s <> '') and (s = Request.ContentFields.Values['pass2']) then
 913     begin
 914       s := hash(s);
 915       FieldByName('password').AsString := hash(s);
 916       with Response.Cookies.Add do
 917       begin
 918         Name := 'user';
 919         Value := s;
 920         Expires := Now + 14;
 921         Secure := true;
 922       end;
 923     end;
 924     Post;
 925   end;
 926   WebModule1adminAction(nil, Request, Response, Handled);
 927 end;
 928
 929 procedure TWebModule1.WebModule1alertAction(Sender: TObject;
 930   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 931 var
 932   num1, num2, i: Integer;
 933   s: string;
 934 begin
 935   num1 := Request.QueryFields.Values['db'].ToInteger;
 936   num2 := StrToIntDef(Request.QueryFields.Values['num'], -1);
 937   if num2 = -1 then
 938     Exit;
 939   if Request.MethodType = mtGet then
 940   begin
 941     FDTable1.Locate('dbnum', num1);
 942     FDTable2.Locate('number', num2);
 943     Response.ContentType := 'text/html;charset=utf-8';
 944     Response.Content := mail.Content;
 945   end
 946   else
 947   begin
 948     with FDTable4 do
 949     begin
 950       Last;
 951       i := FieldByName('id').AsInteger + 1;
 952       s := Request.ContentFields.Values['request'];
 953       if s = '' then
 954         s := '(No Comment)';
 955       AppendRecord([i, num1, num2, Now, s]);
 956     end;
 957     WebModule1jumpAction(nil, Request, Response, Handled);
 958   end;
 959 end;
 960
 961 procedure TWebModule1.WebModule1deleteAction(Sender: TObject;
 962   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 963 var
 964   num: Integer;
 965   s: string;
 966 begin
 967   s := Request.ContentFields.Values['num'];
 968   if s = '' then
 969     Exit;
 970   num := s.ToInteger;
 971   s := hash(Request.ContentFields.Values['password']);
 972   with FDTable2 do
 973     if Locate('number;pass', VarArrayOf([num, s])) = true then
 974     begin
 975       Edit;
 976       FieldByName('title').AsString := '';
 977       FieldByName('name').AsString := ' - - - ';
 978       FieldByName('comment').AsString := '<em>\93\8a\8de\8eÒ\82É\82æ\82è\8dí\8f\9c\82³\82ê\82Ü\82µ\82½.</em>';
 979       FieldByName('raw').AsString := '';
 980       FieldByName('date').AsDateTime := Now;
 981       Post;
 982       WebModule1jumpAction(nil, Request, Response, Handled);
 983     end
 984     else
 985       WebModule1indexpageAction(nil, Request, Response, Handled);
 986 end;
 987
 988 procedure TWebModule1.WebModule1fileAction(Sender: TObject;
 989   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 990 var
 991   s: string;
 992 begin
 993   s := Request.QueryFields.Values['type'];
 994   if s = 'js' then
 995     Response.ContentType := 'text/javascript'
 996   else if s = 'css' then
 997     Response.ContentType := 'text/css';
 998   Response.Content := detail(s, Request.QueryFields.Values['id']);
 999 end;
1000
1001 procedure TWebModule1.WebModule1helpAction(Sender: TObject;
1002   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1003 var
1004   k: Integer;
1005   s: string;
1006 begin
1007   Response.ContentType := 'text/html;charset=utf-8';
1008   if Request.MethodType = mtPost then
1009   begin
1010     s := Request.ContentFields.Values['help'];
1011     FDTable4.Last;
1012     k := FDTable4.FieldByName('id').AsInteger + 1;
1013     FDTable4.AppendRecord([k, -1, -1, Now, s]);
1014     help.Tag := 1;
1015   end
1016   else
1017     help.Tag := 0;
1018   Response.Content := help.Content;
1019 end;
1020
1021 procedure TWebModule1.WebModule1imgAction(Sender: TObject; Request: TWebRequest;
1022   Response: TWebResponse; var Handled: Boolean);
1023 var
1024   s: string;
1025   p: TBytes;
1026   res: TMemoryStream;
1027 begin
1028   with FDTable5 do
1029   begin
1030     s := Request.QueryFields.Values['name'];
1031     if ExtractFileExt(s) = '.ico' then
1032       Response.ContentType:='image/x-ico'
1033     else
1034       Response.ContentType := 'image/jpeg';
1035     if Locate('name', s) = true then
1036     begin
1037       s := FieldByName('source').AsString;
1038       p := TNetEncoding.Base64.DecodeStringToBytes(s);
1039       res := TMemoryStream.Create;
1040       res.WriteBuffer(p, Length(p));
1041       Response.ContentStream := res;
1042     end
1043     else
1044       Response.ContentStream := nil;
1045   end;
1046 end;
1047
1048 procedure TWebModule1.WebModule1indexpageAction(Sender: TObject;
1049   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1050 var
1051   i: Integer;
1052   s: string;
1053 begin
1054   Response.ContentType := 'text/html; charset="utf-8"';
1055   if mente = true then
1056     Exit;
1057   s := Request.QueryFields.Values['db'];
1058   if s <> '' then
1059     FDTable1.Locate('dbnum', s, []);
1060   i := StrToIntDef(Request.QueryFields.Values['num'], -1);
1061   isInfo;
1062   pages(FDTable2.RecordCount, i);
1063   index.Tag := i;
1064   tagstr := '/index';
1065   Response.Content := index.Content;
1066 end;
1067
1068 procedure TWebModule1.WebModule1jumpAction(Sender: TObject;
1069   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1070 var
1071   DB, s: string;
1072   i: Integer;
1073 begin
1074   DB := Request.QueryFields.Values['db'];
1075   s := Request.QueryFields.Values['num'];
1076   if s = '' then
1077     s := Request.ContentFields.Values['num'];
1078   i := 10;
1079   pages(s.ToInteger, i);
1080   Response.SendRedirect(Format('%s/index?db=%s&num=%d#%s', [Request.ScriptName,
1081     DB, i, s]));
1082 end;
1083
1084 procedure TWebModule1.WebModule1linkAction(Sender: TObject;
1085   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1086 var
1087   s: string;
1088 begin
1089   s := Request.QueryFields.Values['db'];
1090   if (s = '') or (FDTable1.Locate('dbnum', s.ToInteger) = false) then
1091     Exit;
1092   s := Request.QueryFields.Values['num'];
1093   if (s <> '') and (FDTable2.Locate('number', s.ToInteger) = true) then
1094   begin
1095     Response.ContentType := 'text/html;charset=utf-8';
1096     Response.Content := articles.Content;
1097   end;
1098 end;
1099
1100 procedure TWebModule1.WebModule1loginAction(Sender: TObject;
1101   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1102 var
1103   v: Variant;
1104   i: Integer;
1105   s, t: string;
1106 begin
1107   if Request.MethodType = mtGet then
1108   begin
1109     Response.ContentType := 'text/html;charset=utf-8';
1110     Response.Content := login.Content;
1111     Exit;
1112   end;
1113   s := Request.ContentFields.Values['record'];
1114   v := FDTable1.Lookup('database', s, 'dbnum');
1115   t := hash(Request.ContentFields.Values['password']);
1116   if (VarIsNull(v) = false) and (hash(t) = FDTable3.FieldByName('password')
1117     .AsString) then
1118   begin
1119     with Response.Cookies.Add do
1120     begin
1121       Name := 'user';
1122       Value := t;
1123       Expires := Now + 14;
1124       // Secure := true;
1125     end;
1126     i := v;
1127     if s = 'master' then
1128       Response.SendRedirect(Request.ScriptName + '/master')
1129     else
1130       Response.SendRedirect(Request.ScriptName + '/admin?db=' + i.toString);
1131   end
1132   else if VarIsNull(v) = false then
1133   begin
1134     t := v;
1135     Response.SendRedirect(Request.ScriptName + '/login?db=' + t);
1136   end
1137   else
1138     Response.SendRedirect(Request.ScriptName + '/login');
1139 end;
1140
1141 procedure TWebModule1.WebModule1logoutAction(Sender: TObject;
1142   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1143 var
1144   i: Integer;
1145   s: string;
1146   x: Boolean;
1147 begin
1148   with Response.Cookies.Add do
1149   begin
1150     Name := 'user';
1151     Expires := Now - 1;
1152   end;
1153   s := Request.QueryFields.Values['db'];
1154   i := StrToIntDef(s, -1);
1155   x := FDTable1.Locate('dbnum', i);
1156   if (x = true) and (FDTable1.FieldByName('database').AsString = 'master') then
1157     x := false;
1158   if x = false then
1159     Response.SendRedirect(Request.ScriptName + '/')
1160   else
1161     Response.SendRedirect(Request.ScriptName + '/index?db=' + s);
1162 end;
1163
1164 procedure TWebModule1.WebModule1masterAction(Sender: TObject;
1165   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1166 var
1167   s: string;
1168   i: Integer;
1169 begin
1170   if loginCheck = false then
1171   begin
1172     Request.QueryFields.Values['db'] := FDTable1.Lookup('database',
1173       'master', 'dbnum');
1174     WebModule1loginAction(nil, Request, Response, Handled);
1175     Exit;
1176   end;
1177   if Request.MethodType = mtPost then
1178   begin
1179     s := Request.ContentFields.Values['delete'];
1180     FDTable4.First;
1181     with FDTable4 do
1182       if s = 'all' then
1183         while not((Bof = true) and (Eof = true)) do
1184           Delete
1185       else
1186         while Eof = false do
1187         begin
1188           i := FieldByName('dbname').AsInteger;
1189           if FDTable1.Locate('dbnum', i) = true then
1190           begin
1191             i := FieldByName('posnum').AsInteger;
1192             if FDTable2.Locate('number', i) = false then
1193               Delete
1194             else
1195               Next;
1196           end
1197           else
1198             Delete;
1199         end;
1200   end;
1201   FDTable4.First;
1202   Response.ContentType := 'text/html;charset=utf-8';
1203   Response.Content := master.Content;
1204 end;
1205
1206 procedure TWebModule1.WebModule1registAction(Sender: TObject;
1207   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1208 var
1209   number, i: Integer;
1210   title, na, raw, pass, kotoba, Error, temp: string;
1211   comment: TStringList;
1212   review: Boolean;
1213 begin
1214   Error := '';
1215   temp := Request.ContentFields.Values['preview'];
1216   if temp = '' then
1217   begin
1218     kotoba := Request.ContentFields.Values['aikotoba'];
1219     if kotoba <> '\82°\82ñ\82«' then
1220       Error := Error + '<p>\8d\87\8c¾\97t\82ª\82¿\82ª\82¢\82Ü\82·.';
1221     with Request.ContentFields do
1222     begin
1223       title := Values['title'];
1224       na := Values['name'];
1225       raw := Values['comment'];
1226       Values['comment'] := '';
1227       pass := hash(Values['password']);
1228     end;
1229     if title = '' then
1230       title := '\83^\83C\83g\83\8b\82È\82µ.';
1231     with Response.Cookies.Add do
1232     begin
1233       Name := 'name';
1234       if na = '' then
1235         Value := '\92N\82©\82³\82ñ.'
1236       else
1237         Value := na;
1238       Expires := Now + 14;
1239     end;
1240     if Error = '' then
1241       with Response.Cookies.Add do
1242       begin
1243         Name := 'aikotoba';
1244         Value := kotoba;
1245         Expires := Now + 14;
1246       end;
1247     comment := TStringList.Create;
1248     try
1249       comment.text := raw;
1250       strsCheck(Error, comment);
1251       temp := comment.text;
1252     finally
1253       comment.Free;
1254     end;
1255     review := false;
1256   end
1257   else
1258     review := true;
1259   Request.ContentFields.Values['raw'] := raw;
1260   if Error <> '' then
1261     Request.ContentFields.Values['preview'] := '<section style=color:red>' +
1262       Error + '</section>'
1263   else if Request.ContentFields.Values['show'] = 'true' then
1264   begin
1265     if review = false then
1266       Error := '<p style=font-size:2.3em;color:blue>\81«\81«\83v\83\8c\83r\83\85\81[\81«\81«<p>' + temp
1267     else
1268       Error := temp;
1269     Request.ContentFields.Values['preview'] := Error;
1270     Request.ContentFields.Values['show'] := 'false';
1271   end
1272   else
1273   begin
1274     i := StrToIntDef(Request.QueryFields.Values['db'], -1);
1275     if FDTable1.Locate('dbnum', i) = false then
1276       Response.SendRedirect(Request.ScriptName + '/')
1277     else
1278     begin
1279       setLastArticle;
1280       number := FDTable2.FieldByName('number').AsInteger + 1;
1281       FDTable2.AppendRecord([i, number, title, na, temp, raw, Now, pass]);
1282       Response.SendRedirect(Request.ScriptName + '/index?db=' + i.toString +
1283         '#article');
1284     end;
1285     Exit;
1286   end;
1287   WebModule1indexpageAction(nil, Request, Response, Handled);
1288 end;
1289
1290 procedure TWebModule1.WebModule1searchAction(Sender: TObject;
1291   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1292 begin
1293   Response.ContentType := 'text/html;charset=utf-8';
1294   Response.Content := search.Content;
1295 end;
1296
1297 procedure TWebModule1.WebModule1titleAction(Sender: TObject;
1298   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1299 begin
1300   Response.ContentType := 'text/html;charset=utf-8';
1301   Response.Content := title.Content;
1302 end;
1303
1304 procedure TWebModule1.WebModule1topAction(Sender: TObject; Request: TWebRequest;
1305   Response: TWebResponse; var Handled: Boolean);
1306 begin
1307   Response.ContentType := 'text/html;charset=utf-8';
1308   FDTable1.First;
1309   if mente = false then
1310     Response.Content := top.ContentFromString(top.Content);
1311 end;
1312
1313 procedure TWebModule1.WebModule1usrdelAction(Sender: TObject;
1314   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1315 var
1316   s, t, p: string;
1317 begin
1318   s := Request.QueryFields.Values['db'];
1319   t := Request.ContentFields.Values['num'];
1320   p := Request.ContentFields.Values['password'];
1321   if FDTable2.Locate('dbnum;number;pass',
1322     VarArrayOf([s.ToInteger, t.ToInteger, p])) = true then
1323     FDTable2.Delete;
1324   WebModule1indexpageAction(nil, Request, Response, Handled);
1325 end;
1326
1327 procedure TWebModule1.WebModuleCreate(Sender: TObject);
1328 var
1329   i: Integer;
1330   s: string;
1331 begin
1332   if FDTable1.Exists = false then
1333     FDTable1.CreateTable;
1334   if FDTable2.Exists = false then
1335     FDTable2.CreateTable;
1336   if FDTable3.Exists = false then
1337     FDTable3.CreateTable;
1338   if FDTable4.Exists = false then
1339     FDTable4.CreateTable;
1340   if FDTable5.Exists = false then
1341     FDTable5.CreateTable;
1342   FDTable1.Open;
1343   FDTable2.Open;
1344   FDTable3.Open;
1345   FDTable4.Open;
1346   FDTable5.Open;
1347   FDTable1.Refresh;
1348   FDTable3.Refresh;
1349   FDTable4.Refresh;
1350   FDTable5.Refresh;
1351   if (FDTable1.Bof = true) and (FDTable1.Eof = true) then
1352   begin
1353     FDTable1.AppendRecord([0, 'info']);
1354     FDTable1.AppendRecord([1, 'master']);
1355     for i := 1 to 10 do
1356       FDTable1.AppendRecord([i + 1, '\8cf\8e¦\94Â' + i.toString]);
1357   end;
1358   if (FDTable3.Bof = true) and (FDTable3.Eof = true) then
1359   begin
1360     i := FDTable1.Lookup('database', 'info', 'dbnum');
1361     s := '\88¢\95Û,\94n\8e,\8e\80\82Ë';
1362     FDTable3.AppendRecord
1363       (['\82Æ\82é\82Ë\81`\82Ç\8d\86',
1364       '<h1 style=color:maron;text-align:center;font-style:italic>\82Æ\82é\82Ë\81`\82Ç\8d\86</h1>',
1365       0, i, 30, hash(hash('admin')), s]);
1366   end;
1367   admin.MaxRows := FDTable3.FieldByName('count').AsInteger;
1368 end;
1369
1370 end.