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