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     js1: TPageProducer;
  33     js2: TPageProducer;
  34     js3: TPageProducer;
  35     js4: TPageProducer;
  36     adhead: TPageProducer;
  37     js5: TPageProducer;
  38     title: TPageProducer;
  39     ti: TDataSetPageProducer;
  40     FDTable2: TFDTable;
  41     FDTable2DBNUM: TIntegerField;
  42     FDTable2NUMBER: TIntegerField;
  43     FDTable2TITLE: TWideStringField;
  44     FDTable2NAME: TWideStringField;
  45     FDTable2COMMENT: TWideMemoField;
  46     FDTable2RAW: TWideMemoField;
  47     FDTable2DATE: TDateField;
  48     FDTable2PASS: TWideStringField;
  49     FDTable5: TFDTable;
  50     FDQuery1: TFDQuery;
  51     FDTable4: TFDTable;
  52     FDTable4ID: TIntegerField;
  53     FDTable4DBNAME: TIntegerField;
  54     FDTable4POSNUM: TIntegerField;
  55     FDTable4DATE: TDateField;
  56     FDTable4REQUEST: TWideMemoField;
  57     DataSource1: TDataSource;
  58     FDTable3: TFDTable;
  59     FDTable3TITLE: TWideStringField;
  60     FDTable3TITLE2: TWideStringField;
  61     FDTable3mente: TBooleanField;
  62     FDTable3INFO: TIntegerField;
  63     FDTable3COUNT: TIntegerField;
  64     FDTable3password: TWideStringField;
  65     FDTable3ng: TWideStringField;
  66     FDConnection1: TFDConnection;
  67     FDTable1: TFDTable;
  68     FDTable1DBNUM: TIntegerField;
  69     FDTable1DATABASE: TWideStringField;
  70     FDTable5ID: TIntegerField;
  71     FDTable5NAME: TWideStringField;
  72     FDTable5SOURCE: TBlobField;
  73     login: 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; 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 var
 450   i: Integer;
 451 begin
 452   if TagString = 'pr' then
 453     ReplaceText := promotion
 454   else if TagString = 'uri' then
 455     ReplaceText := Request.ScriptName
 456   else if TagString = 'database' then
 457   begin
 458     i := StrToIntDef(Request.QueryFields.Values['db'], -1);
 459     if FDTable1.Locate('dbnum', i) = true then
 460       ReplaceText := FDTable1.FieldByName('database').AsString;
 461   end;
 462 end;
 463
 464 procedure TWebModule1.masterHTMLTag(Sender: TObject; Tag: TTag;
 465   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 466 begin
 467   if TagString = 'pr' then
 468     ReplaceText := promotion
 469   else if TagString = 'uri' then
 470     ReplaceText := Request.ScriptName
 471   else if TagString = 'request' then
 472     with FDTable4 do
 473     begin
 474       First;
 475       ReplaceText := '<table border=1 align=center>';
 476       while Eof = false do
 477       begin
 478         if FieldByName('posnum').AsInteger = -1 then
 479           alert.Tag := 1
 480         else
 481           alert.Tag := 0;
 482         ReplaceText := ReplaceText + alert.ContentFromString(alert.Content);
 483         Next;
 484       end;
 485       ReplaceText := ReplaceText + '</table>';
 486     end;
 487 end;
 488
 489 function TWebModule1.mente: Boolean;
 490 begin
 491   if FDTable3.FieldByName('mente').AsBoolean = true then
 492   begin
 493     result := true;
 494     Response.Content :=
 495       '<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>' +
 496       Format('<p style=text-align:center><a href=%s/admin>\8aÇ\97\9d\8eÒ\97p\83\8d\83O\83C\83\93</a>',
 497       [Request.ScriptName]);
 498   end
 499   else
 500     result := false;
 501 end;
 502
 503 procedure TWebModule1.pages(count: Integer; var page: Integer);
 504 var
 505   max: Integer;
 506 begin
 507   max := FDTable3.FieldByName('count').AsInteger;
 508   if (page > -1) and (count < max * (page - 1)) then
 509   begin
 510     page := (count div max) + 1;
 511     if count mod max = 0 then
 512       dec(page);
 513   end;
 514   case page of
 515     - 1:
 516       begin
 517         FDTable2.Last;
 518         FDTable2.MoveBy(1 - max);
 519       end;
 520   else
 521     FDTable2.First;
 522     FDTable2.MoveBy(max * (page - 1));
 523   end;
 524 end;
 525
 526 procedure TWebModule1.mailHTMLTag(Sender: TObject; Tag: TTag;
 527   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 528 begin
 529   if TagString = 'pr' then
 530     ReplaceText := promotion
 531   else if TagString = 'uri' then
 532     ReplaceText := Request.ScriptName
 533   else if TagString = 'content' then
 534     ReplaceText := articles.Content
 535   else if TagString = 'query' then
 536     ReplaceText := '?' + Request.Query
 537   else if TagString = 'number' then
 538     ReplaceText := Request.QueryFields.Values['num'];
 539 end;
 540
 541 procedure TWebModule1.searchHTMLTag(Sender: TObject; Tag: TTag;
 542   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 543 var
 544   s: TStringList;
 545   str: string;
 546   procedure sub;
 547   var
 548     i: Integer;
 549     j: Integer;
 550   label jump;
 551   begin
 552     FDTable2.First;
 553     while FDTable2.Eof = false do
 554     begin
 555       s.Text := FDTable2.FieldByName('raw').AsString;
 556       ss.DelimitedText := Request.ContentFields.Values['word1'];
 557       for j := 0 to ss.count - 1 do
 558         for i := 0 to s.count - 1 do
 559           if Pos(ss[j], s[i]) > 0 then
 560             if Self.Tag = 0 then
 561             begin
 562               ReplaceText := ReplaceText + items.Content;
 563               goto jump;
 564             end
 565             else
 566             begin
 567               if j = ss.count - 1 then
 568               begin
 569                 ReplaceText := ReplaceText + items.Content;
 570                 goto jump;
 571               end
 572               else
 573                 break;
 574             end
 575           else if i = s.count - 1 then
 576             goto jump;
 577     jump:
 578       FDTable2.Next;
 579     end;
 580   end;
 581
 582 begin
 583   if TagString = 'pr' then
 584     ReplaceText := promotion
 585   else if TagString = 'uri' then
 586     ReplaceText := Request.ScriptName
 587   else if TagString = 'select' then
 588   begin
 589     str := Request.QueryFields.Values['db'];
 590     if str = '' then
 591       ReplaceText := Request.ScriptName + '/'
 592     else
 593       ReplaceText := Request.ScriptName + '/index?db=' + str;
 594   end
 595   else if (Request.MethodType = mtPost) and (TagString = 'items') then
 596   begin
 597     if Request.ContentFields.Values['type'] = 'OR' then
 598       Self.Tag := 0
 599     else
 600       Self.Tag := 1;
 601     s := TStringList.Create;
 602     ss := TStringList.Create;
 603     try
 604       ss.Delimiter := ' ';
 605       ss.StrictDelimiter := false;
 606       if Request.QueryFields.Values['db'] = '' then
 607       begin
 608         FDTable1.First;
 609         while FDTable1.Eof = false do
 610         begin
 611           sub;
 612           FDTable1.Next;
 613         end;
 614       end
 615       else
 616         sub;
 617     finally
 618       s.Free;
 619       ss.Free;
 620     end;
 621   end
 622   else if TagString = 'query' then
 623   begin
 624     ReplaceText := Request.Query;
 625     if ReplaceText <> '' then
 626       ReplaceText := '?' + ReplaceText;
 627   end
 628   else if TagString = 'css' then
 629     ReplaceText := css2.Content
 630   else if TagString = 'dbnum' then
 631     ReplaceText := Request.QueryFields.Values['dbnum'];
 632 end;
 633
 634 procedure TWebModule1.setLastArticle;
 635 begin
 636   FDTable2.Last;
 637 end;
 638
 639 procedure TWebModule1.strsCheck(var Error: string; var list: TStringList);
 640 var
 641   s: TStringList;
 642   i, j: Integer;
 643   x: Boolean;
 644 begin
 645   x := false;
 646   s := TStringList.Create;
 647   try
 648     s.DelimitedText := FDTable3.FieldByName('ng').AsString;
 649     for i := 0 to s.count - 1 do
 650       for j := 0 to list.count - 1 do
 651       begin
 652         if Pos(s[i], list[j]) > 0 then
 653           x := true;
 654         list[j] := '<p>' + list[j];
 655       end;
 656   finally
 657     s.Free;
 658   end;
 659   if x = true then
 660     Error := Error + '<p>\8bÖ\8e~\8cê\8bå\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82Ü\82·.';
 661 end;
 662
 663 procedure TWebModule1.tiHTMLTag(Sender: TObject; Tag: TTag;
 664   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 665 begin
 666   if TagString = 'uri' then
 667     ReplaceText := Request.ScriptName
 668   else if TagString = 'count' then
 669     ReplaceText := FDTable2.RecordCount.ToString
 670   else if TagString = 'database' then
 671     ReplaceText := FDTable1.FieldByName('database').AsString
 672   else if TagString = 'date' then
 673     with FDTable2 do
 674     begin
 675       Last;
 676       ReplaceText := FieldByName('date').AsString;
 677     end;
 678 end;
 679
 680 procedure TWebModule1.titleHTMLTag(Sender: TObject; Tag: TTag;
 681   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 682 begin
 683   if TagString = 'pr' then
 684     ReplaceText := promotion
 685   else if TagString = 'uri' then
 686     ReplaceText := Request.ScriptName
 687   else if TagString = 'js' then
 688     ReplaceText := detail(TagString, TagParams.Values['id'])
 689   else if TagString = 'main' then
 690   begin
 691     FDQuery1.Open;
 692     FDTable1.First;
 693     while (FDQuery1.Eof = false) and (FDTable1.Eof = false) do
 694     begin
 695       if FDTable1.FieldByName('dbnum').AsInteger = FDQuery1.FieldByName('dbnum')
 696         .AsInteger then
 697       begin
 698         ReplaceText := ReplaceText + ti.Content;
 699         FDQuery1.Next;
 700       end
 701       else if FDTable2.Eof = false then
 702         ReplaceText := ReplaceText + ti.Content;
 703       FDTable1.Next;
 704     end;
 705     FDQuery1.Close;
 706   end;
 707 end;
 708
 709 procedure TWebModule1.topHTMLTag(Sender: TObject; Tag: TTag;
 710   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 711 var
 712   s, t: string;
 713   i, j, k: Integer;
 714 begin
 715   if TagString = 'pr' then
 716     ReplaceText := promotion
 717   else if TagString = 'uri' then
 718     ReplaceText := Request.ScriptName
 719   else if TagString = 'list' then
 720   begin
 721     i := FDTable3.FieldByName('info').AsInteger;
 722     for k := 0 to tcnt do
 723     begin
 724       if FDTable1.Eof = true then
 725         break;
 726       t := '';
 727       j := FDTable1.FieldByName('dbnum').AsInteger;
 728       s := FDTable1.FieldByName('database').AsString;
 729       if (i = j) or (s = 'master') then
 730       begin
 731         FDTable1.Next;
 732         continue;
 733       end;
 734       FDTable2.Last;
 735       if (Now - FDTable2.FieldByName('date').AsDateTime < 1) and
 736         (FDTable2.RecordCount > 0) then
 737         t := 'background-color:aqua;';
 738       if FDTable2.RecordCount >= 10 * FDTable3.FieldByName('count').AsInteger
 739       then
 740         t := t + 'color:red;';
 741       if t <> '' then
 742         t := ' style=' + t;
 743       ReplaceText := ReplaceText +
 744         Format('<p><a%s target=_blank href="%s/index?db=%d">%s</a><br></p>',
 745         [t, Request.ScriptName, j, s]);
 746       FDTable1.Next;
 747     end;
 748   end
 749   else if TagString = 'info' then
 750     ReplaceText := FDTable1.Lookup('dbnum', FDTable3.FieldByName('info')
 751       .AsInteger, 'database')
 752   else if TagString = 'dbnum' then
 753     ReplaceText := FDTable3.FieldByName('info').AsString
 754   else if (TagString = 'css') or (TagString = 'js') then
 755     ReplaceText := detail(TagString, TagParams.Values['id'])
 756   else if TagString = 'slide' then
 757   begin
 758     for i := 1 to (FDTable1.RecordCount div tcnt) + 1 do
 759       ReplaceText := ReplaceText +
 760         Format('<div class="slide"><img src="%s/src?name=slide%d.jpg"',
 761         [Request.ScriptName, i]) +
 762         ' style=float:right;height:465px><#list></div>';
 763   end;
 764 end;
 765
 766 procedure TWebModule1.WebModule1admdelAction(Sender: TObject;
 767   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 768 var
 769   i, j, k, m: Integer;
 770   reg: TRegEx;
 771   match: TMatch;
 772 begin
 773   j := 0;
 774   FDTable1.Locate('dbnum',Request.QueryFields.Values['db']);
 775   for i := 0 to Request.ContentFields.count - 1 do
 776   begin
 777     reg := TRegEx.Create('\d+');
 778     match := reg.match(Request.ContentFields[i]);
 779     if match.Success = true then
 780     begin
 781       k := match.Value.ToInteger - j - 1;
 782       j := match.Value.ToInteger;
 783       for m := 1 to k do
 784         FDTable2.Next;
 785       FDTable2.Delete;
 786     end;
 787   end;
 788   WebModule1adminAction(nil, Request, Response, Handled);
 789 end;
 790
 791 procedure TWebModule1.WebModule1adminAction(Sender: TObject;
 792   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 793 var
 794   s, t: string;
 795   i: Integer;
 796 begin
 797   s := Request.CookieFields.Values['user'];
 798   if (s = '') or (loginCheck = false) then
 799   begin
 800     WebModule1loginAction(nil, Request, Response, Handled);
 801     Exit;
 802   end;
 803   admin.MaxRows := FDTable3.FieldByName('count').AsInteger;
 804   t := Request.QueryFields.Values['db'];
 805   if t <> '' then
 806     FDTable1.Locate('dbnum', t, []);
 807   s := Request.QueryFields.Values['num'];
 808   i := StrToIntDef(s, -1);
 809   pages(FDTable2.RecordCount, i);
 810   index.Tag := i;
 811   tagstr := '/admin';
 812   Self.Tag := Integer(@tagstr);
 813   admin.header.Text := adhead.Content;
 814   admin.footer.Clear;
 815   admin.footer.Add
 816     ('<input type=submit value=\8dí\8f\9c\82·\82é><input type=reset value=\83\8a\83Z\83b\83g></form>');
 817   admin.footer.Add(footer.Content);
 818   if t <> '' then
 819     t := '?db=' + t;
 820   admin.footer.Add
 821     (Format('<p style=text-align:center><a href="%s/index%s">\96ß\82é</a>',
 822     [Request.ScriptName, t]));
 823   admin.Tag := FDTable2.RecNo;
 824   Response.ContentType := 'text/html;charset=utf-8';
 825   Response.Content := admin.Content;
 826 end;
 827
 828 procedure TWebModule1.WebModule1adminsetAction(Sender: TObject;
 829   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 830 var
 831   s: string;
 832 begin
 833   s := Request.ContentFields.Values['pass'];
 834   with FDTable3 do
 835   begin
 836     Edit;
 837     FieldByName('mente').AsBoolean := Request.ContentFields.Values
 838       ['mente'] = 'on';
 839     if s <> '' then
 840     begin
 841       s := hash(s);
 842       FieldByName('password').AsString := hash(s);
 843       with Response.Cookies.Add do
 844       begin
 845         Name := 'user';
 846         Value := s;
 847         Expires := Now + 14;
 848         Secure := true;
 849       end;
 850     end;
 851     Post;
 852   end;
 853   WebModule1adminAction(nil,Request,Response,Handled);
 854 end;
 855
 856 procedure TWebModule1.WebModule1alertAction(Sender: TObject;
 857   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 858 var
 859   num1, num2, i: Integer;
 860   s: string;
 861 begin
 862   num1 := FDTable1.FieldByName('dbnum').AsInteger;
 863   num2 := StrToIntDef(Request.QueryFields.Values['num'], -1);
 864   if num2 = -1 then
 865     num1 := -1;
 866   if Request.MethodType = mtGet then
 867   begin
 868     FDTable2.Locate('number', num2, []);
 869     Response.ContentType := 'text/html;charset=utf-8';
 870     Response.Content := mail.Content;
 871   end
 872   else
 873   begin
 874     with FDTable4 do
 875     begin
 876       Last;
 877       i := FieldByName('id').AsInteger + 1;
 878       s := Request.ContentFields.Values['request'];
 879       if s = '' then
 880         s := '(No Comment)';
 881       AppendRecord([i, num1, num2, Now, s]);
 882     end;
 883     if num1 > -1 then
 884       Response.SendRedirect(Format('%s/index?db=%d&num=%d#%d',
 885         [Request.ScriptName, num1, num2, num2]))
 886     else
 887       Response.SendRedirect('/');
 888   end;
 889 end;
 890
 891 procedure TWebModule1.WebModule1deleteAction(Sender: TObject;
 892   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 893 var
 894   num: Integer;
 895   s: string;
 896 begin
 897   s := Request.ContentFields.Values['num'];
 898   if s = '' then
 899     Exit;
 900   num := s.ToInteger;
 901   s := hash(Request.ContentFields.Values['password']);
 902   with FDTable2 do
 903     if Locate('number;pass', VarArrayOf([num, s])) = true then
 904     begin
 905       Edit;
 906       FieldByName('title').AsString := '';
 907       FieldByName('name').AsString := ' - - - ';
 908       FieldByName('comment').AsString := '<em>\93\8a\8de\8eÒ\82É\82æ\82è\8dí\8f\9c\82³\82ê\82Ü\82µ\82½.</em>';
 909       FieldByName('raw').AsString := '';
 910       FieldByName('date').AsDateTime := Now;
 911       Post;
 912       WebModule1jumpAction(nil, Request, Response, Handled);
 913     end
 914     else
 915       WebModule1indexpageAction(nil, Request, Response, Handled);
 916 end;
 917
 918 procedure TWebModule1.WebModule1fileAction(Sender: TObject;
 919   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 920 var
 921   s: string;
 922 begin
 923   s := Request.QueryFields.Values['type'];
 924   if s = 'js' then
 925     Response.ContentType := 'text/javascript'
 926   else if s = 'css' then
 927     Response.ContentType := 'text/css';
 928   Response.Content := detail(s, Request.QueryFields.Values['id']);
 929 end;
 930
 931 procedure TWebModule1.WebModule1helpAction(Sender: TObject;
 932   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 933 var
 934   k: Integer;
 935   s: string;
 936 begin
 937   Response.ContentType := 'text/html;charset=utf-8';
 938   if Request.MethodType = mtPost then
 939   begin
 940     s := Request.ContentFields.Values['help'];
 941     FDTable4.Last;
 942     k := FDTable4.FieldByName('id').AsInteger + 1;
 943     FDTable4.AppendRecord([k, -1, -1, Now, s]);
 944     help.Tag := 1;
 945   end
 946   else
 947     help.Tag := 0;
 948   Response.Content := help.Content;
 949 end;
 950
 951 procedure TWebModule1.WebModule1imgAction(Sender: TObject; Request: TWebRequest;
 952   Response: TWebResponse; var Handled: Boolean);
 953 var
 954   s: string;
 955   res: TStream;
 956 begin
 957   with FDTable5 do
 958   begin
 959     s := Request.ContentFields.Values['name'];
 960     Response.ContentType := 'image/jpeg';
 961     if Locate('name', s) = true then
 962     begin
 963       res := CreateBlobStream(FieldByName('source'), bmRead);
 964       Response.ContentStream := res;
 965     end
 966     else if s = 'sprites.png' then
 967     begin
 968       Response.ContentType := 'image/png';
 969       res := TResourceStream.Create(HInstance, 'PngImage_1', RT_RCDATA);
 970       Response.ContentStream := res;
 971     end
 972     else
 973       Response.ContentStream := nil;
 974   end;
 975 end;
 976
 977 procedure TWebModule1.WebModule1indexpageAction(Sender: TObject;
 978   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 979 var
 980   i: Integer;
 981   s: string;
 982 begin
 983   s := Request.QueryFields.Values['db'];
 984   if s <> '' then
 985     FDTable1.Locate('dbnum', s, []);
 986   i := StrToIntDef(Request.QueryFields.Values['num'], -1);
 987   isInfo;
 988   pages(FDTable2.RecordCount, i);
 989   index.Tag := i;
 990   tagstr := '/index';
 991   Self.Tag := Integer(@tagstr);
 992   Response.ContentType := 'text/html; charset="utf-8"';
 993   if mente = false then
 994     Response.Content := index.Content;
 995 end;
 996
 997 procedure TWebModule1.WebModule1jumpAction(Sender: TObject;
 998   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 999 var
1000   DB, s: string;
1001   page: Integer;
1002 begin
1003   DB := Request.QueryFields.Values['db'];
1004   s := Request.ContentFields.Values['num'];
1005   if DB <> '' then
1006     FDTable1.Locate('dbnum', DB.ToInteger, []);
1007   FDTable2.Locate('number', s.ToInteger, []);
1008   page := 10;
1009   pages(FDTable2.RecNo, page);
1010   Response.SendRedirect(Format('%s/index?db=%s&num=%d#%s', [Request.ScriptName,
1011     DB, page, s]));
1012 end;
1013
1014 procedure TWebModule1.WebModule1linkAction(Sender: TObject;
1015   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1016 var
1017   num: Integer;
1018   s: string;
1019 begin
1020   s := Request.QueryFields.Values['num'];
1021   if s = '' then
1022     Exit;
1023   num := s.ToInteger;
1024   if FDTable2.Locate('number', num, []) = true then
1025   begin
1026     Response.ContentType := 'text/html;charset=utf-8';
1027     Response.Content := articles.Content;
1028   end;
1029 end;
1030
1031 procedure TWebModule1.WebModule1loginAction(Sender: TObject;
1032   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1033 var
1034   v: Variant;
1035   i: Integer;
1036   s: string;
1037 begin
1038   if Request.MethodType = mtGet then
1039   begin
1040     Response.ContentType := 'text/html;charset=utf-8';
1041     Response.Content := login.Content;
1042     Exit;
1043   end;
1044   s := Request.ContentFields.Values['record'];
1045   v := FDTable1.Lookup('database', s, 'dbnum');
1046   if VarIsNull(v) = false then
1047   begin
1048     with Response.Cookies.Add do
1049     begin
1050       Name := 'user';
1051       Value := hash(Request.ContentFields.Values['password']);
1052       Expires := Now + 14;
1053       // Secure := true;
1054     end;
1055     i := v;
1056     if s = 'master' then
1057       Response.SendRedirect(Request.ScriptName + '/master')
1058     else
1059       Response.SendRedirect(Request.ScriptName + '/admin?db=' + i.ToString);
1060   end
1061   else
1062   begin
1063     Response.ContentType := 'text/html;charset=utf-8';
1064     Response.Content := login.Content;
1065   end;
1066 end;
1067
1068 procedure TWebModule1.WebModule1logoutAction(Sender: TObject;
1069   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1070 var
1071   i: Integer;
1072   s: string;
1073   x: Boolean;
1074 begin
1075   with Response.Cookies.Add do
1076   begin
1077     Name := 'user';
1078     Expires := Now - 1;
1079   end;
1080   s := Request.QueryFields.Values['db'];
1081   i := StrToIntDef(s, -1);
1082   x := FDTable1.Locate('dbnum', i);
1083   if (x = true) and (FDTable1.FieldByName('database').AsString = 'master') then
1084     x := false;
1085   if x = false then
1086     Response.SendRedirect(Request.ScriptName + '/')
1087   else
1088     Response.SendRedirect(Request.ScriptName + '/index?db=' + s);
1089 end;
1090
1091 procedure TWebModule1.WebModule1masterAction(Sender: TObject;
1092   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1093 var
1094   s: string;
1095   i: Integer;
1096 begin
1097   if loginCheck = false then
1098   begin
1099     with FDTable1 do
1100       if Locate('database', 'master') = false then
1101       begin
1102         Last;
1103         i := FieldByName('dbnum').AsInteger + 1;
1104         AppendRecord([i, 'master']);
1105       end;
1106     WebModule1loginAction(nil, Request, Response, Handled);
1107     Exit;
1108   end;
1109   if Request.MethodType = mtPost then
1110   begin
1111     s := Request.ContentFields.Values['delete'];
1112     if s = 'all' then
1113       with FDTable4 do
1114         while (Bof = false) or (Eof = false) do
1115           Delete
1116     else
1117     begin
1118       FDTable4.First;
1119       while FDTable4.Eof = false do
1120       begin
1121         i := FDTable4.FieldByName('dbname').AsInteger;
1122         if FDTable1.Locate('dbnum', i) = true then
1123         begin
1124           i := FDTable4.FieldByName('posnum').AsInteger;
1125           if FDTable2.Locate('number', i) = false then
1126             FDTable4.Delete
1127           else
1128             FDTable4.Next;
1129         end
1130         else
1131           FDTable4.Delete;
1132       end;
1133     end;
1134   end;
1135   Response.ContentType := 'text/html;charset=utf-8';
1136   Response.Content := master.Content;
1137 end;
1138
1139 procedure TWebModule1.WebModule1registAction(Sender: TObject;
1140   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1141 var
1142   number, i: Integer;
1143   title, na, raw, pass, kotoba, Error: string;
1144   comment: TStringList;
1145   function scan(Text: string): string;
1146   var
1147     reg: TRegEx;
1148     coll: TMatchCollection;
1149     j: Integer;
1150     s, t: string;
1151   begin
1152     Text := TNetEncoding.HTML.Encode(Text);
1153     s := TNetEncoding.HTML.Encode('>>');
1154     reg := TRegEx.Create(s + '(\d+)');
1155     coll := reg.Matches(Text);
1156     for j := coll.count - 1 downto 0 do
1157     begin
1158       Delete(Text, coll[j].index, coll[j].Length);
1159       t := Copy(coll[j].Value, Length(s) + 1, coll[j].Length);
1160       result := Format
1161         ('<a class=minpreview data-preview-url=%s/link?num=%s href=/jump?num=%s>>>%s</a>',
1162         [Request.ScriptName, t, t, t]);
1163       Insert(result, Text, coll[j].index);
1164     end;
1165     result := Text;
1166   end;
1167
1168 begin
1169   kotoba := Request.ContentFields.Values['aikotoba'];
1170   Error := '';
1171   if kotoba <> '\82°\82ñ\82«' then
1172     Error := Error + '<p>\8d\87\8c¾\97t\82ª\82¿\82ª\82¢\82Ü\82·.';
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 := StrToIntDef(Request.QueryFields.Values['db'], -1);
1216       if FDTable1.Locate('dbnum', i) = false then
1217         Response.SendRedirect(Request.ScriptName + '/')
1218       else
1219       begin
1220         setLastArticle;
1221         number := FDTable2.FieldByName('number').AsInteger + 1;
1222         FDTable2.AppendRecord([i, number, title, na, comment.Text, raw,
1223           Now, pass]);
1224         Response.SendRedirect(Request.ScriptName + '/index?db=' + i.ToString +
1225           '#article');
1226       end;
1227       Exit;
1228     end;
1229   finally
1230     comment.Free;
1231   end;
1232   WebModule1indexpageAction(nil, Request, Response, Handled);
1233 end;
1234
1235 procedure TWebModule1.WebModule1searchAction(Sender: TObject;
1236   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1237 begin
1238   Response.ContentType := 'text/html;charset=utf-8';
1239   Response.Content := search.Content;
1240 end;
1241
1242 procedure TWebModule1.WebModule1titleAction(Sender: TObject;
1243   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1244 begin
1245   Response.ContentType := 'text/html;charset=utf-8';
1246   Response.Content := title.Content;
1247 end;
1248
1249 procedure TWebModule1.WebModule1topAction(Sender: TObject; Request: TWebRequest;
1250   Response: TWebResponse; var Handled: Boolean);
1251 begin
1252   Response.ContentType := 'text/html;charset=utf-8';
1253   FDTable1.First;
1254   if mente = false then
1255     Response.Content := top.ContentFromString(top.Content);
1256 end;
1257
1258 procedure TWebModule1.WebModuleCreate(Sender: TObject);
1259 var
1260   i: Integer;
1261   s: string;
1262 begin
1263   if FDTable1.Exists = false then
1264     FDTable1.CreateTable;
1265   if FDTable2.Exists = false then
1266     FDTable2.CreateTable;
1267   if FDTable3.Exists = false then
1268     FDTable3.CreateTable;
1269   if FDTable4.Exists = false then
1270     FDTable4.CreateTable;
1271   if FDTable5.Exists = false then
1272     FDTable5.CreateTable;
1273   FDTable1.Open;
1274   FDTable2.Open;
1275   FDTable3.Open;
1276   FDTable4.Open;
1277   FDTable5.Open;
1278   if FDTable1.Bof and FDTable1.Eof then
1279   begin
1280     FDTable1.AppendRecord([0, 'info']);
1281     for i := 1 to 10 do
1282       FDTable1.AppendRecord([i, '\8cf\8e¦\94Â' + i.ToString]);
1283   end;
1284   if FDTable3.Bof and FDTable3.Eof then
1285   begin
1286     i := FDTable1.Lookup('database', 'info', 'dbnum');
1287     s := '\88¢\95Û,\94n\8e,\8e\80\82Ë';
1288     FDTable3.AppendRecord
1289       (['\82Æ\82é\82Ë\81`\82Ç\8d\86',
1290       '<h1 style=color:maron;text-align:center;font-style:italic>\82Æ\82é\82Ë\81`\82Ç\8d\86</h1>',
1291       false, i, 30, hash(hash('admin')), s]);
1292   end;
1293 end;
1294
1295 end.