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