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