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 (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 var
 503   s: string;
 504 begin
 505   if FDTable3.FieldByName('mente').AsInteger = 1 then
 506   begin
 507     s := Request.QueryFields.Values['db'];
 508     if s <> '' then
 509       s := '?db=' + s;
 510     result := true;
 511     Response.Content :=
 512       '<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>' +
 513       Format('<p style=text-align:center><a href=%s/admin%s>\8aÇ\97\9d\8eÒ\97p\83\8d\83O\83C\83\93</a>',
 514       [Request.ScriptName, s]);
 515   end
 516   else
 517     result := false;
 518 end;
 519
 520 procedure TWebModule1.pages(count: Integer; var page: Integer);
 521 var
 522   max: Integer;
 523 begin
 524   max := FDTable3.FieldByName('count').AsInteger;
 525   if (page > -1) and (count < max * (page - 1)) then
 526   begin
 527     page := (count div max) + 1;
 528     if count mod max = 0 then
 529       dec(page);
 530   end;
 531   case page of
 532     - 1:
 533       begin
 534         FDTable2.Last;
 535         FDTable2.MoveBy(1 - max);
 536       end;
 537   else
 538     FDTable2.First;
 539     FDTable2.MoveBy(max * (page - 1));
 540   end;
 541 end;
 542
 543 procedure TWebModule1.mailHTMLTag(Sender: TObject; Tag: TTag;
 544   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 545 begin
 546   if TagString = 'pr' then
 547     ReplaceText := promotion
 548   else if TagString = 'uri' then
 549     ReplaceText := Request.ScriptName
 550   else if TagString = 'content' then
 551     ReplaceText := articles.Content
 552   else if TagString = 'query' then
 553     ReplaceText := '?' + Request.Query
 554   else if TagString = 'number' then
 555     ReplaceText := Request.QueryFields.Values['num'];
 556 end;
 557
 558 function TWebModule1.scan(text: string): string;
 559 var
 560   reg: TRegEx;
 561   coll: TMatchCollection;
 562   i, j: Integer;
 563   s, t, str: string;
 564 begin
 565   i := Request.QueryFields.Values['db'].ToInteger;
 566   s := Request.ScriptName;
 567   text := TNetEncoding.HTML.Encode(text);
 568   str := TNetEncoding.HTML.Encode('>>');
 569   reg := TRegEx.Create(str + '(\d+)');
 570   coll := reg.Matches(text);
 571   for j := coll.count - 1 downto 0 do
 572   begin
 573     Delete(text, coll[j].index, coll[j].Length);
 574     t := Copy(coll[j].Value, Length(str) + 1, coll[j].Length);
 575     result := Format
 576       ('<a class=minpreview data-preview-url=%s/link?db=%d&num=%s href=%s/jump?db=%d&num=%s>>>%s</a>',
 577       [s, i, t, s, i, t, t]);
 578     Insert(result, text, coll[j].index);
 579   end;
 580   result := text;
 581 end;
 582
 583 procedure TWebModule1.searchHTMLTag(Sender: TObject; Tag: TTag;
 584   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 585 var
 586   s: TStringList;
 587   str: string;
 588   procedure sub;
 589   var
 590     i: Integer;
 591     j: Integer;
 592   label jump;
 593   begin
 594     FDTable2.First;
 595     while FDTable2.Eof = false do
 596     begin
 597       s.text := FDTable2.FieldByName('raw').AsString;
 598       ss.DelimitedText := Request.ContentFields.Values['word1'];
 599       for j := 0 to ss.count - 1 do
 600         for i := 0 to s.count - 1 do
 601           if Pos(ss[j], s[i]) > 0 then
 602             if Self.Tag = 0 then
 603             begin
 604               ReplaceText := ReplaceText + items.Content;
 605               goto jump;
 606             end
 607             else
 608             begin
 609               if j = ss.count - 1 then
 610               begin
 611                 ReplaceText := ReplaceText + items.Content;
 612                 goto jump;
 613               end
 614               else
 615                 break;
 616             end
 617           else if i = s.count - 1 then
 618             goto jump;
 619     jump:
 620       FDTable2.Next;
 621     end;
 622   end;
 623
 624 begin
 625   if TagString = 'pr' then
 626     ReplaceText := promotion
 627   else if TagString = 'uri' then
 628     ReplaceText := Request.ScriptName
 629   else if TagString = 'select' then
 630   begin
 631     str := Request.QueryFields.Values['db'];
 632     if str = '' then
 633       ReplaceText := Request.ScriptName + '/'
 634     else
 635       ReplaceText := Request.ScriptName + '/index?db=' + str;
 636   end
 637   else if (Request.MethodType = mtPost) and (TagString = 'items') then
 638   begin
 639     if Request.ContentFields.Values['type'] = 'OR' then
 640       Self.Tag := 0
 641     else
 642       Self.Tag := 1;
 643     s := TStringList.Create;
 644     ss := TStringList.Create;
 645     try
 646       ss.Delimiter := ' ';
 647       ss.StrictDelimiter := false;
 648       if Request.QueryFields.Values['db'] = '' then
 649       begin
 650         FDTable1.First;
 651         while FDTable1.Eof = false do
 652         begin
 653           sub;
 654           FDTable1.Next;
 655         end;
 656       end
 657       else
 658         sub;
 659     finally
 660       s.Free;
 661       ss.Free;
 662     end;
 663   end
 664   else if TagString = 'query' then
 665   begin
 666     ReplaceText := Request.Query;
 667     if ReplaceText <> '' then
 668       ReplaceText := '?' + ReplaceText;
 669   end
 670   else if TagString = 'css' then
 671     ReplaceText := css2.Content
 672   else if TagString = 'dbnum' then
 673     ReplaceText := Request.QueryFields.Values['dbnum'];
 674 end;
 675
 676 procedure TWebModule1.setLastArticle;
 677 begin
 678   FDTable2.Last;
 679 end;
 680
 681 procedure TWebModule1.strsCheck(var Error: string; list: TStringList);
 682 var
 683   s: TStringList;
 684   i, j: Integer;
 685   x: Boolean;
 686 begin
 687   x := false;
 688   s := TStringList.Create;
 689   try
 690     s.DelimitedText := FDTable3.FieldByName('ng').AsString;
 691     for i := 0 to s.count - 1 do
 692       for j := 0 to list.count - 1 do
 693         if Pos(s[i], list[j]) > 0 then
 694         begin
 695           x := true;
 696           break;
 697         end;
 698     for i := 0 to list.count - 1 do
 699       list[i] := '<p>' + scan(list[i]);
 700   finally
 701     s.Free;
 702   end;
 703   if x = true then
 704     Error := Error + '<p>\8bÖ\8e~\8cê\8bå\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82Ü\82·.';
 705 end;
 706
 707 procedure TWebModule1.tiHTMLTag(Sender: TObject; Tag: TTag;
 708   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 709 begin
 710   if TagString = 'uri' then
 711     ReplaceText := Request.ScriptName
 712   else if TagString = 'count' then
 713     ReplaceText := FDTable2.RecordCount.ToString
 714   else if TagString = 'database' then
 715     ReplaceText := FDTable1.FieldByName('database').AsString
 716   else if TagString = 'date' then
 717     ReplaceText := FDQuery1.FieldByName('max(date)').AsString;
 718 end;
 719
 720 procedure TWebModule1.titleHTMLTag(Sender: TObject; Tag: TTag;
 721   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 722 begin
 723   if TagString = 'pr' then
 724     ReplaceText := promotion
 725   else if TagString = 'uri' then
 726     ReplaceText := Request.ScriptName
 727   else if TagString = 'js' then
 728     ReplaceText := detail(TagString, TagParams.Values['id'])
 729   else if TagString = 'main' then
 730   begin
 731     FDQuery1.Open;
 732     while FDQuery1.Eof = false do
 733     begin
 734       FDTable1.Locate('dbnum', FDQuery1.FieldByName('dbnum').AsInteger);
 735       ReplaceText := ReplaceText + ti.Content;
 736       FDQuery1.Next;
 737     end;
 738     FDQuery1.Close;
 739   end;
 740 end;
 741
 742 procedure TWebModule1.topHTMLTag(Sender: TObject; Tag: TTag;
 743   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 744 var
 745   s, t: string;
 746   i, j, k: Integer;
 747 begin
 748   if TagString = 'pr' then
 749     ReplaceText := promotion
 750   else if TagString = 'uri' then
 751     ReplaceText := Request.ScriptName
 752   else if TagString = 'list' then
 753   begin
 754     i := FDTable3.FieldByName('info').AsInteger;
 755     for k := 0 to tcnt do
 756     begin
 757       if FDTable1.Eof = true then
 758         break;
 759       t := '';
 760       j := FDTable1.FieldByName('dbnum').AsInteger;
 761       s := FDTable1.FieldByName('database').AsString;
 762       if (i = j) or (s = 'master') then
 763       begin
 764         FDTable1.Next;
 765         continue;
 766       end;
 767       FDTable2.Last;
 768       if (Now - FDTable2.FieldByName('date').AsDateTime < 1) and
 769         (FDTable2.RecordCount > 0) then
 770         t := 'background-color:aqua;';
 771       if FDTable2.RecordCount >= 10 * FDTable3.FieldByName('count').AsInteger
 772       then
 773         t := t + 'color:red;';
 774       if t <> '' then
 775         t := ' style=' + t;
 776       ReplaceText := ReplaceText +
 777         Format('<p><a%s target=_blank href="%s/index?db=%d">%s</a><br></p>',
 778         [t, Request.ScriptName, j, s]);
 779       FDTable1.Next;
 780     end;
 781   end
 782   else if TagString = 'info' then
 783     ReplaceText := FDTable1.Lookup('dbnum', FDTable3.FieldByName('info')
 784       .AsInteger, 'database')
 785   else if TagString = 'dbnum' then
 786     ReplaceText := FDTable3.FieldByName('info').AsString
 787   else if (TagString = 'css') or (TagString = 'js') then
 788     ReplaceText := detail(TagString, TagParams.Values['id'])
 789   else if TagString = 'slide' then
 790   begin
 791     for i := 1 to (FDTable1.RecordCount div tcnt) + 1 do
 792       ReplaceText := ReplaceText +
 793         Format('<div class="slide"><img src="%s/src?name=slide%d.jpg"',
 794         [Request.ScriptName, i]) +
 795         ' style=float:right;height:465px><#list></div>';
 796   end;
 797 end;
 798
 799 procedure TWebModule1.WebModule1admdelAction(Sender: TObject;
 800   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 801 var
 802   i, j, k, m: Integer;
 803   reg: TRegEx;
 804   match: TMatch;
 805 begin
 806   j := 0;
 807   FDTable1.Locate('dbnum', Request.QueryFields.Values['db']);
 808   for i := 0 to Request.ContentFields.count - 1 do
 809   begin
 810     reg := TRegEx.Create('\d+');
 811     match := reg.match(Request.ContentFields[i]);
 812     if match.Success = true then
 813     begin
 814       k := match.Value.ToInteger - j - 1;
 815       j := match.Value.ToInteger;
 816       for m := 1 to k do
 817         FDTable2.Next;
 818       FDTable2.Delete;
 819     end;
 820   end;
 821   WebModule1adminAction(nil, Request, Response, Handled);
 822 end;
 823
 824 procedure TWebModule1.WebModule1adminAction(Sender: TObject;
 825   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 826 var
 827   s, t: string;
 828   i: Integer;
 829 begin
 830   s := Request.CookieFields.Values['user'];
 831   if (s = '') or (loginCheck = false) then
 832   begin
 833     WebModule1loginAction(nil, Request, Response, Handled);
 834     Exit;
 835   end;
 836   admin.MaxRows := FDTable3.FieldByName('count').AsInteger;
 837   t := Request.QueryFields.Values['db'];
 838   if t <> '' then
 839     FDTable1.Locate('dbnum', t, []);
 840   s := Request.QueryFields.Values['num'];
 841   i := StrToIntDef(s, -1);
 842   pages(FDTable2.RecordCount, i);
 843   index.Tag := i;
 844   tagstr := '/admin';
 845   Self.Tag := Integer(@tagstr);
 846   admin.header.text := adhead.Content;
 847   admin.footer.Clear;
 848   admin.footer.Add
 849     ('<input type=submit value=\8dí\8f\9c\82·\82é><input type=reset value=\83\8a\83Z\83b\83g></form>');
 850   admin.footer.Add(footer.Content);
 851   if t <> '' then
 852     t := '?db=' + t;
 853   admin.footer.Add
 854     (Format('<p style=text-align:center><a href="%s/index%s">\96ß\82é</a>',
 855     [Request.ScriptName, t]));
 856   Response.ContentType := 'text/html;charset=utf-8';
 857   Response.Content := admin.Content;
 858 end;
 859
 860 procedure TWebModule1.WebModule1adminsetAction(Sender: TObject;
 861   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 862 var
 863   s: string;
 864   i: Integer;
 865 begin
 866   s := Request.ContentFields.Values['pass'];
 867   with FDTable3 do
 868   begin
 869     Edit;
 870     if Request.ContentFields.Values['mente'] = 'on' then
 871       i := 1
 872     else
 873       i := 0;
 874     FieldByName('mente').AsInteger := i;
 875     if s <> '' then
 876     begin
 877       s := hash(s);
 878       FieldByName('password').AsString := hash(s);
 879       with Response.Cookies.Add do
 880       begin
 881         Name := 'user';
 882         Value := s;
 883         Expires := Now + 14;
 884         Secure := true;
 885       end;
 886     end;
 887     Post;
 888   end;
 889   WebModule1adminAction(nil, Request, Response, Handled);
 890 end;
 891
 892 procedure TWebModule1.WebModule1alertAction(Sender: TObject;
 893   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 894 var
 895   num1, num2, i: Integer;
 896   s: string;
 897 begin
 898   num1 := Request.QueryFields.Values['db'].ToInteger;
 899   num2 := StrToIntDef(Request.QueryFields.Values['num'], -1);
 900   if num2 = -1 then
 901     Exit;
 902   if Request.MethodType = mtGet then
 903   begin
 904     FDTable1.Locate('dbnum', num1);
 905     FDTable2.Locate('number', num2);
 906     Response.ContentType := 'text/html;charset=utf-8';
 907     Response.Content := mail.Content;
 908   end
 909   else
 910   begin
 911     with FDTable4 do
 912     begin
 913       Last;
 914       i := FieldByName('id').AsInteger + 1;
 915       s := Request.ContentFields.Values['request'];
 916       if s = '' then
 917         s := '(No Comment)';
 918       AppendRecord([i, num1, num2, Now, s]);
 919     end;
 920     WebModule1jumpAction(nil, Request, Response, Handled);
 921   end;
 922 end;
 923
 924 procedure TWebModule1.WebModule1deleteAction(Sender: TObject;
 925   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 926 var
 927   num: Integer;
 928   s: string;
 929 begin
 930   s := Request.ContentFields.Values['num'];
 931   if s = '' then
 932     Exit;
 933   num := s.ToInteger;
 934   s := hash(Request.ContentFields.Values['password']);
 935   with FDTable2 do
 936     if Locate('number;pass', VarArrayOf([num, s])) = true then
 937     begin
 938       Edit;
 939       FieldByName('title').AsString := '';
 940       FieldByName('name').AsString := ' - - - ';
 941       FieldByName('comment').AsString := '<em>\93\8a\8de\8eÒ\82É\82æ\82è\8dí\8f\9c\82³\82ê\82Ü\82µ\82½.</em>';
 942       FieldByName('raw').AsString := '';
 943       FieldByName('date').AsDateTime := Now;
 944       Post;
 945       WebModule1jumpAction(nil, Request, Response, Handled);
 946     end
 947     else
 948       WebModule1indexpageAction(nil, Request, Response, Handled);
 949 end;
 950
 951 procedure TWebModule1.WebModule1fileAction(Sender: TObject;
 952   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 953 var
 954   s: string;
 955 begin
 956   s := Request.QueryFields.Values['type'];
 957   if s = 'js' then
 958     Response.ContentType := 'text/javascript'
 959   else if s = 'css' then
 960     Response.ContentType := 'text/css';
 961   Response.Content := detail(s, Request.QueryFields.Values['id']);
 962 end;
 963
 964 procedure TWebModule1.WebModule1helpAction(Sender: TObject;
 965   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 966 var
 967   k: Integer;
 968   s: string;
 969 begin
 970   Response.ContentType := 'text/html;charset=utf-8';
 971   if Request.MethodType = mtPost then
 972   begin
 973     s := Request.ContentFields.Values['help'];
 974     FDTable4.Last;
 975     k := FDTable4.FieldByName('id').AsInteger + 1;
 976     FDTable4.AppendRecord([k, -1, -1, Now, s]);
 977     help.Tag := 1;
 978   end
 979   else
 980     help.Tag := 0;
 981   Response.Content := help.Content;
 982 end;
 983
 984 procedure TWebModule1.WebModule1imgAction(Sender: TObject; Request: TWebRequest;
 985   Response: TWebResponse; var Handled: Boolean);
 986 var
 987   s: string;
 988   res: TStream;
 989 begin
 990   with FDTable5 do
 991   begin
 992     s := Request.QueryFields.Values['name'];
 993     Response.ContentType := 'image/jpeg';
 994     if Locate('name', s) = true then
 995     begin
 996       res := CreateBlobStream(FieldByName('source'), bmRead);
 997       Response.ContentStream := res;
 998     end
 999     else if s = 'sprites.png' then
1000     begin
1001       Response.ContentType := 'image/png';
1002       res := TResourceStream.Create(HInstance, 'PngImage_1', RT_RCDATA);
1003       Response.ContentStream := res;
1004     end
1005     else
1006       Response.ContentStream := nil;
1007   end;
1008 end;
1009
1010 procedure TWebModule1.WebModule1indexpageAction(Sender: TObject;
1011   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1012 var
1013   i: Integer;
1014   s: string;
1015 begin
1016   Response.ContentType := 'text/html; charset="utf-8"';
1017   if mente = true then
1018     Exit;
1019   s := Request.QueryFields.Values['db'];
1020   if s <> '' then
1021     FDTable1.Locate('dbnum', s, []);
1022   i := StrToIntDef(Request.QueryFields.Values['num'], -1);
1023   isInfo;
1024   pages(FDTable2.RecordCount, i);
1025   index.Tag := i;
1026   tagstr := '/index';
1027   Self.Tag := Integer(@tagstr);
1028   Response.Content := index.Content;
1029 end;
1030
1031 procedure TWebModule1.WebModule1jumpAction(Sender: TObject;
1032   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1033 var
1034   DB, s: string;
1035   i: Integer;
1036 begin
1037   DB := Request.QueryFields.Values['db'];
1038   s := Request.QueryFields.Values['num'];
1039   if s = '' then
1040     s := Request.ContentFields.Values['num'];
1041   i := 10;
1042   pages(s.ToInteger, i);
1043   Response.SendRedirect(Format('%s/index?db=%s&num=%d#%s', [Request.ScriptName,
1044     DB, i, s]));
1045 end;
1046
1047 procedure TWebModule1.WebModule1linkAction(Sender: TObject;
1048   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1049 var
1050   s: string;
1051 begin
1052   s := Request.QueryFields.Values['db'];
1053   if (s = '') or (FDTable1.Locate('dbnum', s.ToInteger) = false) then
1054     Exit;
1055   s := Request.QueryFields.Values['num'];
1056   if (s <> '') and (FDTable2.Locate('number', s.ToInteger) = true) then
1057   begin
1058     Response.ContentType := 'text/html;charset=utf-8';
1059     Response.Content := articles.Content;
1060   end;
1061 end;
1062
1063 procedure TWebModule1.WebModule1loginAction(Sender: TObject;
1064   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1065 var
1066   v: Variant;
1067   i: Integer;
1068   s, t: string;
1069 begin
1070   if Request.MethodType = mtGet then
1071   begin
1072     Response.ContentType := 'text/html;charset=utf-8';
1073     Response.Content := login.Content;
1074     Exit;
1075   end;
1076   s := Request.ContentFields.Values['record'];
1077   v := FDTable1.Lookup('database', s, 'dbnum');
1078   t := hash(Request.ContentFields.Values['password']);
1079   if (VarIsNull(v) = false) and (hash(t) = FDTable3.FieldByName('password')
1080     .AsString) then
1081   begin
1082     with Response.Cookies.Add do
1083     begin
1084       Name := 'user';
1085       Value := t;
1086       Expires := Now + 14;
1087       // Secure := true;
1088     end;
1089     i := v;
1090     if s = 'master' then
1091       Response.SendRedirect(Request.ScriptName + '/master')
1092     else
1093       Response.SendRedirect(Request.ScriptName + '/admin?db=' + i.ToString);
1094   end
1095   else if VarIsNull(v) = false then
1096   begin
1097     t := v;
1098     Response.SendRedirect(Request.ScriptName + '/login?db=' + t);
1099   end
1100   else
1101     Response.SendRedirect(Request.ScriptName + '/login');
1102 end;
1103
1104 procedure TWebModule1.WebModule1logoutAction(Sender: TObject;
1105   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1106 var
1107   i: Integer;
1108   s: string;
1109   x: Boolean;
1110 begin
1111   with Response.Cookies.Add do
1112   begin
1113     Name := 'user';
1114     Expires := Now - 1;
1115   end;
1116   s := Request.QueryFields.Values['db'];
1117   i := StrToIntDef(s, -1);
1118   x := FDTable1.Locate('dbnum', i);
1119   if (x = true) and (FDTable1.FieldByName('database').AsString = 'master') then
1120     x := false;
1121   if x = false then
1122     Response.SendRedirect(Request.ScriptName + '/')
1123   else
1124     Response.SendRedirect(Request.ScriptName + '/index?db=' + s);
1125 end;
1126
1127 procedure TWebModule1.WebModule1masterAction(Sender: TObject;
1128   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1129 var
1130   s: string;
1131   i: Integer;
1132 begin
1133   if loginCheck = false then
1134   begin
1135     Request.QueryFields.Values['db'] := FDTable1.Lookup('database',
1136       'master', 'dbnum');
1137     WebModule1loginAction(nil, Request, Response, Handled);
1138     Exit;
1139   end;
1140   if Request.MethodType = mtPost then
1141   begin
1142     s := Request.ContentFields.Values['delete'];
1143     with FDTable4 do
1144       if s = 'all' then
1145         while not((Bof = true) and (Eof = true)) do
1146           Delete
1147       else
1148       begin
1149         First;
1150         while Eof = false do
1151         begin
1152           i := FieldByName('dbname').AsInteger;
1153           if FDTable1.Locate('dbnum', i) = true then
1154           begin
1155             i := FieldByName('posnum').AsInteger;
1156             if FDTable2.Locate('number', i) = false then
1157               Delete
1158             else
1159               Next;
1160           end
1161           else
1162             Delete;
1163         end;
1164       end;
1165   end;
1166   FDTable4.First;
1167   Response.ContentType := 'text/html;charset=utf-8';
1168   Response.Content := master.Content;
1169 end;
1170
1171 procedure TWebModule1.WebModule1registAction(Sender: TObject;
1172   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1173 var
1174   number, i: Integer;
1175   title, na, raw, pass, kotoba, Error, temp: string;
1176   comment: TStringList;
1177   review: Boolean;
1178 begin
1179   Error := '';
1180   temp := Request.ContentFields.Values['preview'];
1181   if temp = '' then
1182   begin
1183     kotoba := Request.ContentFields.Values['aikotoba'];
1184     if kotoba <> '\82°\82ñ\82«' then
1185       Error := Error + '<p>\8d\87\8c¾\97t\82ª\82¿\82ª\82¢\82Ü\82·.';
1186     with Request.ContentFields do
1187     begin
1188       title := Values['title'];
1189       na := Values['name'];
1190       raw := Values['comment'];
1191       Values['comment'] := '';
1192       pass := hash(Values['password']);
1193     end;
1194     if title = '' then
1195       title := '\83^\83C\83g\83\8b\82È\82µ.';
1196     with Response.Cookies.Add do
1197     begin
1198       Name := 'name';
1199       if na = '' then
1200         Value := '\92N\82©\82³\82ñ.'
1201       else
1202         Value := na;
1203       Expires := Now + 14;
1204     end;
1205     if Error = '' then
1206       with Response.Cookies.Add do
1207       begin
1208         Name := 'aikotoba';
1209         Value := kotoba;
1210         Expires := Now + 14;
1211       end;
1212     comment := TStringList.Create;
1213     try
1214       comment.text := raw;
1215       strsCheck(Error, comment);
1216       temp := comment.text;
1217     finally
1218       comment.Free;
1219     end;
1220     review := false;
1221   end
1222   else
1223     review := true;
1224   Request.ContentFields.Values['raw'] := raw;
1225   if Error <> '' then
1226     Request.ContentFields.Values['preview'] := '<section style=color:red>' +
1227       Error + '</section>'
1228   else if Request.ContentFields.Values['show'] = 'true' then
1229   begin
1230     if review = false then
1231       Error := '<p style=font-size:2.3em;color:blue>\81«\81«\83v\83\8c\83r\83\85\81[\81«\81«<p>' + temp
1232     else
1233       Error := temp;
1234     Request.ContentFields.Values['preview'] := Error;
1235     Request.ContentFields.Values['show'] := 'false';
1236   end
1237   else
1238   begin
1239     i := StrToIntDef(Request.QueryFields.Values['db'], -1);
1240     if FDTable1.Locate('dbnum', i) = false then
1241       Response.SendRedirect(Request.ScriptName + '/')
1242     else
1243     begin
1244       setLastArticle;
1245       number := FDTable2.FieldByName('number').AsInteger + 1;
1246       FDTable2.AppendRecord([i, number, title, na, temp, raw, Now, pass]);
1247       Response.SendRedirect(Request.ScriptName + '/index?db=' + i.ToString +
1248         '#article');
1249     end;
1250     Exit;
1251   end;
1252   WebModule1indexpageAction(nil, Request, Response, Handled);
1253 end;
1254
1255 procedure TWebModule1.WebModule1searchAction(Sender: TObject;
1256   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1257 begin
1258   Response.ContentType := 'text/html;charset=utf-8';
1259   Response.Content := search.Content;
1260 end;
1261
1262 procedure TWebModule1.WebModule1titleAction(Sender: TObject;
1263   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1264 begin
1265   Response.ContentType := 'text/html;charset=utf-8';
1266   Response.Content := title.Content;
1267 end;
1268
1269 procedure TWebModule1.WebModule1topAction(Sender: TObject; Request: TWebRequest;
1270   Response: TWebResponse; var Handled: Boolean);
1271 begin
1272   Response.ContentType := 'text/html;charset=utf-8';
1273   FDTable1.First;
1274   if mente = false then
1275     Response.Content := top.ContentFromString(top.Content);
1276 end;
1277
1278 procedure TWebModule1.WebModule1usrdelAction(Sender: TObject;
1279   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1280 var
1281   s, t, p: string;
1282 begin
1283   s := Request.QueryFields.Values['db'];
1284   t := Request.ContentFields.Values['num'];
1285   p := Request.ContentFields.Values['password'];
1286   if FDTable2.Locate('dbnum;number;pass',
1287     VarArrayOf([s.ToInteger, t.ToInteger, p])) = true then
1288     FDTable2.Delete;
1289   WebModule1indexpageAction(nil, Request, Response, Handled);
1290 end;
1291
1292 procedure TWebModule1.WebModuleCreate(Sender: TObject);
1293 var
1294   i: Integer;
1295   s: string;
1296 begin
1297   if FDTable1.Exists = false then
1298     FDTable1.CreateTable;
1299   if FDTable2.Exists = false then
1300     FDTable2.CreateTable;
1301   if FDTable3.Exists = false then
1302     FDTable3.CreateTable;
1303   if FDTable4.Exists = false then
1304     FDTable4.CreateTable;
1305   if FDTable5.Exists = false then
1306     FDTable5.CreateTable;
1307   FDTable1.Open;
1308   FDTable2.Open;
1309   FDTable3.Open;
1310   FDTable4.Open;
1311   FDTable5.Open;
1312   FDTable1.Refresh;
1313   FDTable3.Refresh;
1314   FDTable4.Refresh;
1315   FDTable5.Refresh;
1316   if (FDTable1.Bof = true) and (FDTable1.Eof = true) then
1317   begin
1318     FDTable1.AppendRecord([0, 'info']);
1319     FDTable1.AppendRecord([1, 'master']);
1320     for i := 1 to 10 do
1321       FDTable1.AppendRecord([i + 1, '\8cf\8e¦\94Â' + i.ToString]);
1322   end;
1323   if (FDTable3.Bof = true) and (FDTable3.Eof = true) then
1324   begin
1325     i := FDTable1.Lookup('database', 'info', 'dbnum');
1326     s := '\88¢\95Û,\94n\8e,\8e\80\82Ë';
1327     FDTable3.AppendRecord
1328       (['\82Æ\82é\82Ë\81`\82Ç\8d\86',
1329       '<h1 style=color:maron;text-align:center;font-style:italic>\82Æ\82é\82Ë\81`\82Ç\8d\86</h1>',
1330       0, i, 30, hash(hash('admin')), s]);
1331   end;
1332 end;
1333
1334 end.