パスワードのハッシュ化が未達です

他はかなりいいところまで来ました

diff --git a/WebModuleUnit1.dfm b/WebModuleUnit1.dfm
index 38f129b..8d85e8b 100644 (file)
--- a/WebModuleUnit1.dfm
+++ b/WebModuleUnit1.dfm
@@ -166,7 +166,7 @@ object TWebModule1: TTWebModule1
         #29702#32773#29992#12525#12464#12452#12531'</a></p>'
       '  </body>'
       '</html>')
-    DataSet = DataModule1.FDTable1
+    DataSet = DataModule1.FDTable3
     OnHTMLTag = indexHTMLTag
     Left = 112
     Top = 32
@@ -186,9 +186,6 @@ object TWebModule1: TTWebModule1
         FieldName = 'NAME'
       end
       item
-        FieldName = 'COMMENT'
-      end
-      item
         FieldName = 'DATE'
       end>
     Footer.Strings = (

diff --git a/WebModuleUnit1.pas b/WebModuleUnit1.pas
index 608ba68..3c8f858 100644 (file)
--- a/WebModuleUnit1.pas
+++ b/WebModuleUnit1.pas
@@ -3,7 +3,8 @@ unit WebModuleUnit1;
 interface
 
 uses System.SysUtils, System.Classes, Web.HTTPApp, Web.DSProd, Web.HTTPProd,
-  Web.DBWeb, System.Variants, System.NetEncoding, System.RegularExpressions;
+  Web.DBWeb, System.Variants, System.NetEncoding, System.RegularExpressions,
+  IdHashSHA, IdGlobal;
 
 type
   TTWebModule1 = class(TWebModule)
@@ -92,6 +93,8 @@ type
     ss: TStringList;
     procedure pages(count: Integer; var page: Integer);
     function getdbname: string;
+    function hash(str: string): string;
+    function mente: Boolean;
   public
     { public \90é\8c¾ }
   end;
@@ -199,6 +202,20 @@ begin
     result := '';
 end;
 
+function TTWebModule1.hash(str: string): string;
+var
+  s: TIdHashSHA512;
+begin
+  s := TIdHashSHA512.Create;
+  try
+    result := s.HashStringAsHex(str, IndyTextEncoding_UTF8);
+  finally;
+    s.Free;
+  end;
+  if result = '' then
+    result := 'admin';
+end;
+
 procedure TTWebModule1.headerHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 var
@@ -262,7 +279,9 @@ begin
       ReplaceText := header.Content;
   end
   else if (TagString = 'css') or (TagString = 'js') then
-    ReplaceText := detail;
+    ReplaceText := detail
+  else if TagString = 'database' then
+    ReplaceText := DataModule1.FDTable1.FieldByName('database').AsString;
 end;
 
 procedure TTWebModule1.itemsHTMLTag(Sender: TObject; Tag: TTag;
@@ -319,6 +338,19 @@ begin
     end;
 end;
 
+function TTWebModule1.mente: Boolean;
+begin
+  if DataModule1.FDTable3.FieldByName('mente').AsBoolean = true then
+  begin
+    result := true;
+    Response.Content :=
+      '<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>' +
+      '<p style=text-align:center><a href=/admin>\8aÇ\97\9d\8eÒ\97p\83\8d\83O\83C\83\93</a>'
+  end
+  else
+    result := false;
+end;
+
 procedure TTWebModule1.pages(count: Integer; var page: Integer);
 var
   max: Integer;
@@ -542,7 +574,8 @@ begin
     Edit;
     FieldByName('mente').AsBoolean := Request.ContentFields.Values
       ['mente'] = 'on';
-    FieldByName('password').AsString := Request.ContentFields.Values['pass'];
+    FieldByName('password').AsString :=
+      hash(Request.ContentFields.Values['pass']);
     Post;
   end;
   TWebModule1adminAction(nil, Request, Response, Handled);
@@ -630,9 +663,7 @@ begin
   s := '/index';
   Self.Tag := Integer(@s);
   Response.ContentType := 'text/html; charset="utf-8"';
-  if DataModule1.FDTable3.FieldByName('mente').AsBoolean = true then
-    Response.Content := '\82½\82¾\82¢\82Ü\83\81\83\93\83e\83i\83\93\83X\92\86\82Å\82·^_^'
-  else
+  if mente = false then
     Response.Content := index.Content;
 end;
 
@@ -687,7 +718,7 @@ begin
   with Response.Cookies.Add do
   begin
     Name := 'user';
-    Value := DataModule1.FDTable3.FieldByName('password').AsString;
+    Value := hash(Request.ContentFields.Values['password']);
     Expires := Now + 14;
   end;
   s := Request.ContentFields.Values['record'];
@@ -826,8 +857,8 @@ begin
       error := '<p style=font-size:2.3em;color:blue>\81«\81«\83v\83\8c\83r\83\85\81[\81«\81«<p>' +
         comment.Text;
       Request.ContentFields.Values['show'] := 'false';
-      Request.ContentFields.Add('preview=' + error);
-      Request.ContentFields.Add('raw=' + raw);
+      Request.ContentFields.Values['preview'] := error;
+      Request.ContentFields.Values['raw'] := raw;
     end
     else
     begin
@@ -854,7 +885,8 @@ procedure TTWebModule1.TWebModule1topAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 begin
   Response.ContentType := 'text/html;charset=utf-8';
-  Response.Content := top.Content;
+  if mente = false then
+    Response.Content := top.Content;
 end;
 
 procedure TTWebModule1.WebModuleCreate(Sender: TObject);
@@ -872,7 +904,9 @@ begin
   begin
     a := DataModule1.FDTable1.Lookup('database', 'info', 'dbnum');
     DataModule1.FDTable3.AppendRecord
-      (['\82Æ\82é\82Ë\81`\82Ç\8d\86', '<p style=color:gray>\82Æ\82é\82Ë\81`\82Ç\8d\86</p>', false, a, 30, 'admin']);
+      (['\82Æ\82é\82Ë\81`\82Ç\8d\86',
+      '<h1 style=color:maron;text-align:center;font-style:italic>\82Æ\82é\82Ë\81`\82Ç\8d\86</h1>',
+      false, a, 30, hash('admin')]);
   end;
 end;