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