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