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