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