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