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