https(secure cookie)に対応

デバッグはしづらくなりましたがApacheでは動きます

diff --git a/FormUnit1.pas b/FormUnit1.pas
index 82c00a9..5dde9cd 100644 (file)
--- a/FormUnit1.pas
+++ b/FormUnit1.pas
@@ -23,6 +23,7 @@ type
   private
     FServer: TIdHTTPWebBrokerBridge;
     procedure StartServer;
+    procedure OnGetSSLPassword(var APassword: String);
     { private \90é\8c¾ }
   public
     { public \90é\8c¾ }
@@ -36,6 +37,7 @@ implementation
 {$R *.dfm}
 
 uses
+  IdSSLOpenSSL,
   WinApi.Windows, Winapi.ShellApi;
 
 procedure TForm1.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
@@ -50,7 +52,7 @@ var
   LURL: string;
 begin
   StartServer;
-  LURL := Format('http://localhost:%s', [EditPort.Text]);
+  LURL := Format('https://localhost:%s', [EditPort.Text]);
   ShellExecute(0,
         nil,
         PChar(LURL), nil, nil, SW_SHOWNOACTIVATE);
@@ -68,8 +70,21 @@ begin
 end;
 
 procedure TForm1.FormCreate(Sender: TObject);
+var
+  LIOHandleSSL: TIdServerIOHandlerSSLOpenSSL;
 begin
   FServer := TIdHTTPWebBrokerBridge.Create(Self);
+  LIOHandleSSL := TIdServerIOHandlerSSLOpenSSL.Create(FServer);
+  LIOHandleSSL.SSLOptions.CertFile := 'C:\Users\fuke masasi\Documents\masasi\https\server.csr';
+  LIOHandleSSL.SSLOptions.RootCertFile := 'C:\Users\fuke masasi\Documents\masasi\https\server.pem';
+  LIOHandleSSL.SSLOptions.KeyFile := 'C:\Users\fuke masasi\Documents\masasi\https\server.key';
+  LIOHandleSSL.OnGetPassword := OnGetSSLPassword;
+  FServer.IOHandler := LIOHandleSSL;
+end;
+
+procedure TForm1.OnGetSSLPassword(var APassword: String);
+begin
+  APassword := 'kainushi';
 end;
 
 procedure TForm1.StartServer;

diff --git a/WebModuleUnit1.pas b/WebModuleUnit1.pas
index 5539932..bf8eb39 100644 (file)
--- a/WebModuleUnit1.pas
+++ b/WebModuleUnit1.pas
@@ -85,7 +85,8 @@ procedure TWebModule1.DataSetPageProducer2HTMLTag(Sender: TObject; Tag: TTag;
 begin
   if TagString = 'home' then
   begin
-    ReplaceText := FDTable2.FieldByName('home').AsString;
+    ReplaceText := String(AnsiReplaceText(FDTable2.FieldByName('home')
+      .AsAnsiString, 'http', 'https'));
   end
   else
   begin
@@ -96,6 +97,7 @@ end;
 function TWebModule1.footer(const path: string): string;
 var
   s1, s2, t1, t2: string;
+  home: string;
   i, k, count: integer;
   function linkcontent: string;
   var
@@ -134,15 +136,23 @@ var
       end
       else
       begin
-        result := result + Format('  <a href="' + FDTable2.FieldByName('home')
-          .AsString + path + '?pos=%d">%d</a>  ',
-          [pos + i + j, pos + 1 + i + j]);
+        result := result + Format('  <a href="' + home + path +
+          '?pos=%d">%d</a>  ', [pos + i + j, pos + 1 + i + j]);
       end;
     end;
   end;
 
 begin
   count := FDTable3.FieldByName('count').AsInteger;
+  if path = 'admin' then
+  begin
+    home := String(ReplaceText(FDTable2.FieldByName('home').AsAnsiString,
+      'http', 'https'));
+  end
+  else
+  begin
+    home := FDTable2.FieldByName('home').AsString;
+  end;
   if pos <= -1 then
   begin
     s1 := '\8dÅ\90V%d\8c\8f\82Ì\8bL\8e\96\82ð\95\\8e¦<br><center>Pages : [<b>';
@@ -173,10 +183,9 @@ begin
       k := (pos + 1) * count;
     end;
     s1 := '%d \8c\8f\92\86 %d \8c\8f\82©\82ç %d \8c\8f\82Ü\82Å\95\\8e¦<br><center>Page : [<b>';
-    s2 := '<a href="' + FDTable2.FieldByName('home').AsString + path + t1 +
-      '"><<</a>' + linkcontent + '<a href="' + FDTable2.FieldByName('home')
-      .AsString + path + t2 + '">>></a>]  <a href="' +
-      FDTable2.FieldByName('home').AsString + path + '">\8dÅ\90V</a></b></center>';
+    s2 := '<a href="' + home + path + t1 + '"><<</a>' + linkcontent +
+      '<a href="' + home + path + t2 + '">>></a>]  <a href="' + home + path +
+      '">\8dÅ\90V</a></b></center>';
     result := Format(s1, [FDTable1.RecordCount, pos * count + 1, k]) + s2;
   end;
 end;
@@ -188,8 +197,17 @@ var
   s: TDataSetPageProducer;
   t: string;
 begin
-  if (TagString = 'home') or (TagString = 'title') or (TagString = 'title2')
-  then
+  if TagString = 'home' then
+    if ExtractFileName(PageProducer1.HTMLFile) = 'index.htm' then
+    begin
+      ReplaceText := FDTable2.FieldByName('home').AsString;
+    end
+    else
+    begin
+      ReplaceText := String(AnsiReplaceText(FDTable2.FieldByName('home')
+        .AsAnsiString, 'http', 'https'));
+    end;
+  if (TagString = 'title') or (TagString = 'title2') then
     ReplaceText := FDTable2.FieldByName(TagString).AsString;
   if TagString = 'username' then
     ReplaceText := user;
@@ -299,7 +317,7 @@ begin
       Expires := Now + 1;
       Name := 'psw';
       Value := AnsiString(s);
-      // Secure := true;
+      Secure := true;
     end;
     if s = FDTable2.FieldByName('pass').AsString then
       something;
@@ -320,7 +338,7 @@ begin
     if FDTable1.Locate('no', Request.ContentFields.ValueFromIndex[i], []) = true
     then
       FDTable1.Delete;
-  Response.SendRedirect(FDTable2.FieldByName('home').AsAnsiString + 'admin');
+  Response.SendRedirect(ReplaceText(FDTable2.FieldByName('home').AsAnsiString + 'admin','http','https'));
 end;
 
 procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;