OSDN Git Service

pngファイルはリソースで読む
[newbbs/newbbs.git] / WebModuleUnit1.pas
index 3c8f858..7625c79 100644 (file)
@@ -4,7 +4,7 @@ interface
 
 uses System.SysUtils, System.Classes, Web.HTTPApp, Web.DSProd, Web.HTTPProd,
   Web.DBWeb, System.Variants, System.NetEncoding, System.RegularExpressions,
-  IdHashSHA, IdGlobal;
+  Data.DB, Web.DBXpressWeb, System.Types;
 
 type
   TTWebModule1 = class(TWebModule)
@@ -29,9 +29,10 @@ type
     js2: TPageProducer;
     js3: TPageProducer;
     js4: TPageProducer;
+    adhead: TPageProducer;
     js5: TPageProducer;
-    js6: TPageProducer;
-    adhead: TDataSetPageProducer;
+    title: TPageProducer;
+    ti: TDataSetPageProducer;
     procedure indexHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
     procedure TWebModule1indexpageAction(Sender: TObject; Request: TWebRequest;
@@ -88,13 +89,27 @@ type
       TagParams: TStrings; var ReplaceText: string);
     procedure TWebModule1logoutAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
+    procedure TWebModule1imgAction(Sender: TObject; Request: TWebRequest;
+      Response: TWebResponse; var Handled: Boolean);
+    procedure TWebModule1fileAction(Sender: TObject; Request: TWebRequest;
+      Response: TWebResponse; var Handled: Boolean);
+    procedure titleHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
+      TagParams: TStrings; var ReplaceText: string);
+    procedure TWebModule1titleAction(Sender: TObject; Request: TWebRequest;
+      Response: TWebResponse; var Handled: Boolean);
+    procedure tiHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
+      TagParams: TStrings; var ReplaceText: string);
+    procedure helpHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
+      TagParams: TStrings; var ReplaceText: string);
+    procedure loginHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
+      TagParams: TStrings; var ReplaceText: string);
   private
     { private \90é\8c¾ }
     ss: TStringList;
     procedure pages(count: Integer; var page: Integer);
-    function getdbname: string;
     function hash(str: string): string;
     function mente: Boolean;
+    function detail(ts, pid: string): string;
   public
     { public \90é\8c¾ }
   end;
@@ -106,16 +121,24 @@ implementation
 
 { %CLASSGROUP 'Vcl.Controls.TControl' }
 
-uses Unit1;
+uses Unit1, IdHashSHA, IdGlobal, IdHash, IdHashMessageDigest;
 
 {$R *.dfm}
 
+const
+  promotion = '\8dL\8d\90:';
+  tcnt = 7;
+
 procedure TTWebModule1.adheadHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 begin
-  if (TagString = 'mente') and (DataModule1.FDTable3.FieldByName('mente')
-    .AsBoolean = true) then
-    ReplaceText := 'checked';
+  if TagString = 'pr' then
+    ReplaceText := promotion
+  else if (TagString = 'mente') and
+    (DataModule1.FDTable3.FieldByName('mente').AsBoolean = true) then
+    ReplaceText := 'checked'
+  else if TagString = 'password' then
+    ReplaceText := Request.CookieFields.Values['user'];
 end;
 
 procedure TTWebModule1.adminFormatCell(Sender: TObject;
@@ -143,6 +166,8 @@ begin
     s := TStringList.Create;
     try
       s.Text := articles.Content;
+      for i := 1 to 2 do
+        s.Delete(1);
       for i := s.count - 1 downto 0 do
         if Copy(s[i], 1, 18) = '<section id=master' then
         begin
@@ -161,12 +186,19 @@ end;
 procedure TTWebModule1.articlesHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 begin
-  if TagString = 'database' then
-    ReplaceText := Request.QueryFields.Values['db']
-  else if TagString = 'comment' then
+  if TagString = 'comment' then
     ReplaceText := DataModule1.FDTable2.FieldByName('comment').AsString;
 end;
 
+function TTWebModule1.detail(ts, pid: string): string;
+var
+  i: Integer;
+begin
+  for i := 0 to ComponentCount - 1 do
+    if Components[i].Name = ts + pid then
+      result := (Components[i] as TPageProducer).Content;
+end;
+
 procedure TTWebModule1.footerHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 var
@@ -179,41 +211,29 @@ begin
         ReplaceText := ReplaceText + ' ' + i.ToString + ' '
       else
         ReplaceText := ReplaceText +
-          Format(' <a style=text-decoration-line:none href=%s?db=%s&num=%d>%d</a> ',
-          [PString(Self.Tag)^, DataModule1.FDTable1.FieldByName('database')
-          .AsString, i, i]);
+          Format(' <a style=text-decoration-line:none href="%s?db=%d&num=%d">%d</a> ',
+          [PString(Self.Tag)^, DataModule1.FDTable1.FieldByName('dbnum')
+          .AsInteger, i, i]);
   end
   else if TagString = 'recent' then
     if index.Tag = -1 then
       ReplaceText := TagString
     else
-      ReplaceText := '<a style=text-decoration-line:none href=' +
-        PString(Self.Tag)^ + '?db=' + DataModule1.FDTable1.FieldByName
-        ('database').AsString + '>recent</a>';
-end;
-
-function TTWebModule1.getdbname: string;
-begin
-  result := Request.ContentFields.Values['db'];
-  if result = '' then
-    result := TNetEncoding.URL.Encode
-      (DataModule1.FDTable1.FieldByName('database').AsString)
-  else if DataModule1.FDTable1.Locate('database', result, []) = false then
-    result := '';
+      ReplaceText := '<a style=text-decoration-line:none href="' +
+        PString(Self.Tag)^ + '?db=' + DataModule1.FDTable1.FieldByName('dbnum')
+        .AsString + '">recent</a>';
 end;
 
 function TTWebModule1.hash(str: string): string;
-var
-  s: TIdHashSHA512;
 begin
-  s := TIdHashSHA512.Create;
-  try
-    result := s.HashStringAsHex(str, IndyTextEncoding_UTF8);
-  finally;
-    s.Free;
+  with TIdHashSHA1.Create do
+  begin
+    try
+      result := HashStringAsHex(str);
+    finally
+      Free;
+    end;
   end;
-  if result = '' then
-    result := 'admin';
 end;
 
 procedure TTWebModule1.headerHTMLTag(Sender: TObject; Tag: TTag;
@@ -232,7 +252,18 @@ begin
   else if TagString = 'preview' then
     ReplaceText := Request.ContentFields.Values['preview']
   else if TagString = 'raw' then
-    ReplaceText := Request.ContentFields.Values['raw'];
+    ReplaceText := Request.ContentFields.Values['raw']
+  else if TagString = 'pass' then
+    ReplaceText := Request.ContentFields.Values['password']
+  else if TagString = 'title' then
+    ReplaceText := Request.ContentFields.Values['title'];
+end;
+
+procedure TTWebModule1.helpHTMLTag(Sender: TObject; Tag: TTag;
+  const TagString: string; TagParams: TStrings; var ReplaceText: string);
+begin
+  if TagString = 'pr' then
+    ReplaceText := promotion;
 end;
 
 procedure TTWebModule1.indexHTMLTag(Sender: TObject; Tag: TTag;
@@ -240,19 +271,10 @@ procedure TTWebModule1.indexHTMLTag(Sender: TObject; Tag: TTag;
 var
   i: Integer;
   x: Boolean;
-  function detail: string;
-  var
-    s: string;
-    j: Integer;
-  begin
-    s := TagParams.Values['id'];
-    for j := 0 to ComponentCount - 1 do
-      if Components[j].Name = TagString + s then
-        result := (Components[j] as TPageProducer).Content;
-  end;
-
 begin
-  if TagString = 'article' then
+  if TagString = 'pr' then
+    ReplaceText := promotion
+  else if TagString = 'article' then
   begin
     x := DataModule1.FDTable1.FieldByName('dbnum')
       .AsInteger = DataModule1.FDTable3.FieldByName('info').AsInteger;
@@ -273,13 +295,15 @@ begin
   else if TagString = 'header' then
   begin
     i := DataModule1.FDTable3.FieldByName('count').AsInteger;
-    if 10 * i < DataModule1.FDTable2.RecordCount then
-      ReplaceText := '\82±\82ê\88È\8fã\93\8a\8de\82Å\82«\82Ü\82¹\82ñ.'
+    if 10 * i <= DataModule1.FDTable2.RecordCount then
+      ReplaceText := '<h1>\82±\82ê\88È\8fã\93\8a\8de\82Å\82«\82Ü\82¹\82ñ.</h1>'
     else
       ReplaceText := header.Content;
   end
   else if (TagString = 'css') or (TagString = 'js') then
-    ReplaceText := detail
+    ReplaceText := detail(TagString, TagParams.Values['id'])
+  else if TagString = 'dbnum' then
+    ReplaceText := DataModule1.FDTable1.FieldByName('dbnum').AsString
   else if TagString = 'database' then
     ReplaceText := DataModule1.FDTable1.FieldByName('database').AsString;
 end;
@@ -309,10 +333,10 @@ begin
         j := FieldByName('number').AsInteger;
         str := Request.QueryFields.Values['db'];
         if str = '' then
-          t := Format('<a href=/index?db=%s&num=%d>[ %d-%d ]</a>',
-            [str, j, i, j])
+          t := Format('<a href="/jump?db=%d&num=%d">[ %d-%d ]</a>',
+            [DataModule1.FDTable1.FieldByName('dbnum').AsInteger, j, i, j])
         else
-          t := Format('<a href=/index?db=%s&num=%d>[ %d ]</a>', [str, j, j]);
+          t := Format('<a href="/jump?db=%s&num=%d">[ %d ]</a>', [str, j, j]);
       end;
       ReplaceText := t + s.Text;
     finally
@@ -321,10 +345,19 @@ begin
   end;
 end;
 
+procedure TTWebModule1.loginHTMLTag(Sender: TObject; Tag: TTag;
+  const TagString: string; TagParams: TStrings; var ReplaceText: string);
+begin
+  if TagString = 'pr' then
+    ReplaceText := promotion;
+end;
+
 procedure TTWebModule1.masterHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 begin
-  if TagString = 'request' then
+  if TagString = 'pr' then
+    ReplaceText := promotion
+  else if TagString = 'request' then
     with DataModule1.FDTable4 do
     begin
       First;
@@ -357,7 +390,11 @@ var
 begin
   max := DataModule1.FDTable3.FieldByName('count').AsInteger;
   if (page > -1) and (count < max * (page - 1)) then
+  begin
     page := (count div max) + 1;
+    if count mod max = 0 then
+      dec(page);
+  end;
   case page of
     - 1:
       begin
@@ -373,10 +410,12 @@ end;
 procedure TTWebModule1.mailHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 begin
-  if TagString = 'content' then
+  if TagString = 'pr' then
+    ReplaceText := promotion
+  else if TagString = 'content' then
     ReplaceText := articles.Content
   else if TagString = 'query' then
-    ReplaceText := '?' + Request.Query + '#' + Request.QueryFields.Values['num']
+    ReplaceText := '?' + Request.Query
   else if TagString = 'number' then
     ReplaceText := Request.QueryFields.Values['num'];
 end;
@@ -422,7 +461,9 @@ var
   end;
 
 begin
-  if (Request.MethodType = mtPost) and (TagString = 'items') then
+  if TagString = 'pr' then
+    ReplaceText := promotion
+  else if (Request.MethodType = mtPost) and (TagString = 'items') then
   begin
     if Request.ContentFields.Values['type'] = 'OR' then
       Self.Tag := 0
@@ -459,20 +500,58 @@ begin
     ReplaceText := css2.Content;
 end;
 
+procedure TTWebModule1.tiHTMLTag(Sender: TObject; Tag: TTag;
+  const TagString: string; TagParams: TStrings; var ReplaceText: string);
+begin
+  if TagString = 'count' then
+  begin
+    DataModule1.FDTable1.Locate('dbnum',
+      DataModule1.FDQuery1.FieldByName('dbnum').AsInteger);
+    ReplaceText := DataModule1.FDTable2.RecordCount.ToString;
+  end
+  else if TagString = 'database' then
+    ReplaceText := DataModule1.FDTable1.Lookup('dbnum',
+      DataModule1.FDQuery1.FieldByName('dbnum').AsInteger, 'database');
+end;
+
+procedure TTWebModule1.titleHTMLTag(Sender: TObject; Tag: TTag;
+  const TagString: string; TagParams: TStrings; var ReplaceText: string);
+begin
+  if TagString = 'pr' then
+    ReplaceText := promotion
+  else if TagString = 'js' then
+    ReplaceText := detail(TagString, TagParams.Values['id'])
+  else if TagString = 'main' then
+    with DataModule1.FDQuery1 do
+    begin
+      Open;
+      while Eof = false do
+      begin
+        ReplaceText := ReplaceText + ti.Content;
+        Next;
+      end;
+      Close;
+    end;
+end;
+
 procedure TTWebModule1.topHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 var
   s, t: string;
-  i: Integer;
+  i, j, k: Integer;
 begin
-  if TagString = 'list' then
+  if TagString = 'pr' then
+    ReplaceText := promotion
+  else if TagString = 'list' then
   begin
-    DataModule1.FDTable1.First;
     i := DataModule1.FDTable3.FieldByName('info').AsInteger;
-    while DataModule1.FDTable1.Eof = false do
+    for k := 0 to tcnt do
     begin
+      if DataModule1.FDTable1.Eof = true then
+        break;
       t := '';
-      if i = DataModule1.FDTable1.FieldByName('dbnum').AsInteger then
+      j := DataModule1.FDTable1.FieldByName('dbnum').AsInteger;
+      if i = j then
       begin
         DataModule1.FDTable1.Next;
         continue;
@@ -487,21 +566,25 @@ begin
       if t <> '' then
         t := ' style=' + t;
       ReplaceText := ReplaceText +
-        Format('<p%s><a target=_blank href=%s>%s</a><br></p>',
-        [t, '/index?db=' + s, s]);
+        Format('<p><a%s target=_blank href="/index?db=%d">%s</a><br></p>',
+        [t, j, s]);
       DataModule1.FDTable1.Next;
     end;
   end
   else if TagString = 'info' then
     ReplaceText := DataModule1.FDTable1.Lookup('dbnum',
       DataModule1.FDTable3.FieldByName('info').AsInteger, 'database')
-  else if TagString = 'css' then
-    case TagParams.Values['id'].ToInteger of
-      1:
-        ReplaceText := css1.Content;
-      3:
-        ReplaceText := css3.Content;
-    end;
+  else if TagString = 'dbnum' then
+    ReplaceText := DataModule1.FDTable3.FieldByName('info').AsString
+  else if (TagString = 'css') or (TagString = 'js') then
+    ReplaceText := detail(TagString, TagParams.Values['id'])
+  else if TagString = 'slide' then
+  begin
+    for i := 1 to (DataModule1.FDTable1.RecordCount div tcnt) + 1 do
+      ReplaceText := ReplaceText +
+        '<div class="slide"><img src="/src?name=slide' + i.ToString +
+        '.jpg" style=float:right;height:465px><#list></div>';
+  end;
 end;
 
 procedure TTWebModule1.TWebModule1admdelAction(Sender: TObject;
@@ -526,7 +609,7 @@ begin
       DataModule1.FDTable2.Delete;
     end;
   end;
-  Response.SendRedirect('/admin?db=' + getdbname);
+  TWebModule1adminAction(nil, Request, Response, Handled);
 end;
 
 procedure TTWebModule1.TWebModule1adminAction(Sender: TObject;
@@ -535,15 +618,16 @@ var
   s: string;
   i: Integer;
 begin
-  if Request.CookieFields.Values['user'] <> DataModule1.FDTable3.FieldByName
-    ('password').AsString then
+  if hash(Request.CookieFields.Values['user']) <>
+    DataModule1.FDTable3.FieldByName('password').AsString then
   begin
     Response.SendRedirect('/login');
     Exit;
   end;
   admin.MaxRows := DataModule1.FDTable3.FieldByName('count').AsInteger;
-  s := TNetEncoding.URL.Decode(Request.QueryFields.Values['db']);
-  DataModule1.FDTable1.Locate('database', s, []);
+  s := Request.QueryFields.Values['db'];
+  if s <> '' then
+    DataModule1.FDTable1.Locate('dbnum', s, []);
   s := Request.QueryFields.Values['num'];
   i := StrToIntDef(s, -1);
   pages(DataModule1.FDTable2.RecordCount, i);
@@ -551,7 +635,7 @@ begin
   s := '/admin';
   Self.Tag := Integer(@s);
   i := footer.HTMLDoc.Add
-    ('<p style=text-align:center><a href=/index?db=<#database>>\96ß\82é</a>');
+    ('<p style=text-align:center><a href="/index?db=<#dbnum>">\96ß\82é</a>');
   admin.header.Text := adhead.Content;
   if admin.Tag = 0 then
     admin.footer.Insert(3, footer.Content)
@@ -568,26 +652,35 @@ end;
 
 procedure TTWebModule1.TWebModule1adminsetAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+var
+  s: string;
 begin
+  s := Request.ContentFields.Values['pass'];
   with DataModule1.FDTable3 do
   begin
     Edit;
     FieldByName('mente').AsBoolean := Request.ContentFields.Values
       ['mente'] = 'on';
-    FieldByName('password').AsString :=
-      hash(Request.ContentFields.Values['pass']);
+    FieldByName('password').AsString := hash(s);
     Post;
   end;
+  with Response.Cookies.Add do
+  begin
+    Name := 'user';
+    Value := s;
+    Expires := Now + 14;
+    Secure := true;
+  end;
+  Request.CookieFields.Values['user'] := s;
   TWebModule1adminAction(nil, Request, Response, Handled);
 end;
 
 procedure TTWebModule1.TWebModule1alertAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
-  num1, num2, i: Integer;
-  s: string;
+  num1, num2, i, dbnum: Integer;
 begin
-  s := getdbname;
+  dbnum := DataModule1.FDTable1.FieldByName('dbnum').AsInteger;
   num1 := DataModule1.FDTable1.FieldByName('dbnum').AsInteger;
   num2 := Request.QueryFields.Values['num'].ToInteger;
   if Request.MethodType = mtGet then
@@ -604,7 +697,7 @@ begin
       AppendRecord([i, num1, num2, Now, Request.ContentFields.Values
         ['request']]);
       pages(DataModule1.FDTable2.RecNo, i);
-      Response.SendRedirect(Format('/index?db=%s&num=%d#%d', [s, i, num2]));
+      Response.SendRedirect(Format('/index?db=%d&num=%d#%d', [dbnum, i, num2]));
     end;
 end;
 
@@ -614,23 +707,38 @@ var
   num: Integer;
   s: string;
 begin
-  s := Request.ContentFields.Values['number'];
+  s := Request.ContentFields.Values['num'];
   if s = '' then
     Exit;
   num := s.ToInteger;
-  s := Request.ContentFields.Values['password'];
+  s := hash(Request.ContentFields.Values['password']);
   with DataModule1.FDTable2 do
     if Locate('number;pass', VarArrayOf([num, s])) = true then
     begin
       Edit;
       FieldByName('title').AsString := '';
-      FieldByName('name').AsString := '---';
+      FieldByName('name').AsString := ' - - - ';
       FieldByName('comment').AsString := '<em>\93\8a\8de\8eÒ\82É\82æ\82è\8dí\8f\9c\82³\82ê\82Ü\82µ\82½.</em>';
       FieldByName('raw').AsString := '';
       FieldByName('date').AsDateTime := Now;
       Post;
-    end;
-  Response.SendRedirect('/index?db=' + getdbname);
+      TWebModule1jumpAction(nil, Request, Response, Handled);
+    end
+    else
+      TWebModule1indexpageAction(nil, Request, Response, Handled);
+end;
+
+procedure TTWebModule1.TWebModule1fileAction(Sender: TObject;
+  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+var
+  s: string;
+begin
+  s := Request.QueryFields.Values['type'];
+  if s = 'js' then
+    Response.ContentType := 'text/javascript'
+  else if s = 'css' then
+    Response.ContentType := 'text/css';
+  Response.Content := detail(s, Request.QueryFields.Values['id']);
 end;
 
 procedure TTWebModule1.TWebModule1helpAction(Sender: TObject;
@@ -650,13 +758,42 @@ begin
   Response.Content := help.Content;
 end;
 
+procedure TTWebModule1.TWebModule1imgAction(Sender: TObject;
+  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+var
+  s: string;
+  res: TResourceStream;
+begin
+  with DataModule1.FDTable5 do
+  begin
+    s:= Request.ContentFields.Values['name'];
+    Response.ContentType := 'image/jpeg';
+    if Locate('name', s) = true then
+      Response.ContentStream := CreateBlobStream(FieldByName('source'), bmRead)
+    else
+      if s = 'sprites.png' then
+      begin
+        res:=TResourceStream.Create(HInstance,'PngImage_1',RT_RCDATA);
+        try
+          Response.ContentStream:=res;
+        finally
+          res.Free;
+        end;
+      end
+      else
+        Response.ContentStream:=nil;
+  end;
+end;
+
 procedure TTWebModule1.TWebModule1indexpageAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   int: Integer;
   s: string;
 begin
-  DataModule1.FDTable1.Locate('database', Request.QueryFields.Values['db'], []);
+  s := Request.QueryFields.Values['db'];
+  if s <> '' then
+    DataModule1.FDTable1.Locate('dbnum', s, []);
   int := StrToIntDef(Request.QueryFields.Values['num'], -1);
   pages(DataModule1.FDTable2.RecordCount, int);
   index.Tag := int;
@@ -670,21 +807,17 @@ end;
 procedure TTWebModule1.TWebModule1jumpAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
-  db, s: string;
+  DB, s: string;
   page: Integer;
 begin
-  db := DataModule1.FDTable1.FieldByName('database').AsString;
+  DB := Request.QueryFields.Values['db'];
   s := Request.ContentFields.Values['num'];
-  if s = '' then
-  begin
-    Response.ContentType := 'text/html;charset=utf-8';
-    Response.Content := '<a href=/index?db=' + db + '>\96ß\82é</a>';
-    Exit;
-  end;
+  if DB <> '' then
+    DataModule1.FDTable1.Locate('dbnum', DB.ToInteger, []);
   DataModule1.FDTable2.Locate('number', s.ToInteger, []);
   page := 10;
   pages(DataModule1.FDTable2.RecNo, page);
-  Response.SendRedirect(Format('/index?db=%s&num=%d#%s', [getdbname, page, s]));
+  Response.SendRedirect(Format('/index?db=%s&num=%d#%s', [DB, page, s]));
 end;
 
 procedure TTWebModule1.TWebModule1linkAction(Sender: TObject;
@@ -707,7 +840,7 @@ end;
 procedure TTWebModule1.TWebModule1loginAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
-  s: string;
+  i: Integer;
 begin
   if Request.MethodType = mtGet then
   begin
@@ -718,11 +851,13 @@ begin
   with Response.Cookies.Add do
   begin
     Name := 'user';
-    Value := hash(Request.ContentFields.Values['password']);
+    Value := Request.ContentFields.Values['password'];
     Expires := Now + 14;
+    Secure := true;
   end;
-  s := Request.ContentFields.Values['record'];
-  Response.SendRedirect('/admin?db=' + TNetEncoding.URL.Encode(s));
+  i := DataModule1.FDTable1.Lookup('database',
+    Request.ContentFields.Values['record'], 'dbnum');
+  Response.SendRedirect('/admin?db=' + i.ToString);
 end;
 
 procedure TTWebModule1.TWebModule1logoutAction(Sender: TObject;
@@ -817,7 +952,7 @@ begin
     title := Values['title'];
     na := Values['name'];
     raw := Values['comment'];
-    pass := Values['password'];
+    pass := hash(Values['password']);
   end;
   if title = '' then
     title := '\83^\83C\83g\83\8b\82È\82µ.';
@@ -865,7 +1000,7 @@ begin
       i := DataModule1.FDTable1.FieldByName('dbnum').AsInteger;
       DataModule1.FDTable2.AppendRecord([i, number, title, na, comment.Text,
         raw, Now, pass]);
-      Response.SendRedirect('index?db=' + getdbname + '#article');
+      Response.SendRedirect('index?db=' + i.ToString + '#article');
       Exit;
     end;
   finally
@@ -881,19 +1016,48 @@ begin
   Response.Content := search.Content;
 end;
 
+procedure TTWebModule1.TWebModule1titleAction(Sender: TObject;
+  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+begin
+  Response.ContentType := 'text/html;charset=utf-8';
+  Response.Content := title.Content;
+end;
+
 procedure TTWebModule1.TWebModule1topAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 begin
   Response.ContentType := 'text/html;charset=utf-8';
+  DataModule1.FDTable1.First;
   if mente = false then
-    Response.Content := top.Content;
+    Response.Content := top.ContentFromString(top.Content);
 end;
 
 procedure TTWebModule1.WebModuleCreate(Sender: TObject);
 var
-  a: Variant;
   i: Integer;
+  a: Variant;
 begin
+  with DataModule1 do
+  begin
+    if FDTable1.Exists = false then
+      FDTable1.CreateTable;
+    if FDTable2.Exists = false then
+      FDTable2.CreateTable;
+    if FDTable3.Exists = false then
+      FDTable3.CreateTable;
+    if FDTable4.Exists = false then
+      FDTable4.CreateTable;
+    if FDTable5.Exists = false then
+      FDTable5.CreateTable;
+    FDTable1.Open;
+    FDTable2.Open;
+    FDTable3.Open;
+    FDTable4.Open;
+    FDTable5.Open;
+    FDTable1.Refresh;
+    FDTable3.Refresh;
+    FDTable5.Refresh;
+  end;
   if DataModule1.FDTable1.Bof and DataModule1.FDTable1.Eof then
   begin
     DataModule1.FDTable1.AppendRecord([0, 'info']);