OSDN Git Service

(root) / newbbs / newbbs.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: e4e181e)
secure にいまだ未対応
authoryamat0jp <terukohietori@gmail.com>
Mon, 15 Jul 2019 08:50:57 +0000 (17:50 +0900)
committeryamat0jp <terukohietori@gmail.com>
Mon, 15 Jul 2019 08:50:57 +0000 (17:50 +0900)
広告表示を想定に入れました

WebModuleUnit1.dfm patch | blob | history
WebModuleUnit1.pas patch | blob | history

diff --git a/WebModuleUnit1.dfm b/WebModuleUnit1.dfm
index b5c6cc1..e9a5ba8 100644 (file)
--- a/WebModuleUnit1.dfm
+++ b/WebModuleUnit1.dfm
@@ -156,7 +156,7 @@ object TWebModule1: TTWebModule1
       '    </title>'
       '  </head>'
       '  <body>'
-      ''
+      '<#pr>'
       '    <a href=/ style=text-decoration:none><#title2></a>'
       ''
       '    <#header>'
@@ -234,6 +234,7 @@ object TWebModule1: TTWebModule1
       '  </head>'
       ''
       '  <body>'
+      '<#pr>'
       '    <form action="/search<#query>" method="post">'
       '    <p align="center"><strong>'#25237#31295#26908#32034
       '</strong>'
@@ -291,6 +292,7 @@ object TWebModule1: TTWebModule1
       ''
       '<html><head><meta charset=utf8><title>'#20351#12356#26041'</title></head>'
       '<body>'
+      '<#pr>'
       '<P>'#35370#21839#32773#12398#30342#12373#12435'</P>'
       '<form action=/help method=post>'
       #9'<p>'#12362#21839#12356#21512#12431#12379'<'#21066#38500#20381#38972#12394#12393#20309#12391#12418'></p>'
@@ -311,6 +313,7 @@ object TWebModule1: TTWebModule1
       '<p style=text-align:center><a href=/>'#25147#12427'</a>'
       '</body>'
       '</html>')
+    OnHTMLTag = helpHTMLTag
     Left = 304
     Top = 32
   end
@@ -339,6 +342,7 @@ object TWebModule1: TTWebModule1
       '<script src="/file?type=js&id=4">moder</script>'
       '</head>'
       '<body>'
+      '<#pr>'
       '<div id="fb-root"></div>'
       ''
       '<script>(function(d, s, id) {'
@@ -417,6 +421,7 @@ object TWebModule1: TTWebModule1
       '<meta charset=utf-8>'
       '</head>'
       '<body>'
+      '<#pr>'
       '<form action=/master method=post>'
       '<p><#request>'
       '<input type=radio name=delete value=some checked>'#21066#38500#28168#12415#12434#28040#21435#12288
@@ -455,6 +460,7 @@ object TWebModule1: TTWebModule1
       '<html>'
       '<head><meta charset=utf-8></head>'
       '<body>'
+      '<#pr>'
       '<form action=/alert<#query>  method=post>'
       '  <#content>'
       '<textarea name=request></textarea>'
@@ -1372,6 +1378,7 @@ object TWebModule1: TTWebModule1
       '    <title>'#12525#12464#12452#12531'</title>'
       '  </head>'
       '  <body>'
+      '<#pr>'
       '    <p style=text-align:center>'#31649#29702#32773#29992#12525#12464#12452#12531#30011#38754
       '</p>'
       '    <br>'
@@ -1386,6 +1393,7 @@ object TWebModule1: TTWebModule1
       '  </body>'
       '</html>')
     DataSet = DataModule1.FDTable1
+    OnHTMLTag = loginHTMLTag
     Left = 304
     Top = 144
   end
@@ -1821,6 +1829,7 @@ object TWebModule1: TTWebModule1
   end
   object adhead: TPageProducer
     HTMLDoc.Strings = (
+      '<#pr>'
       '<form method=post action=/adminset style=text-align:center>'
       '    <label><p>'#12497#12473#12527#12540#12489#12398#22793#26356
       
@@ -1899,6 +1908,7 @@ object TWebModule1: TTWebModule1
       '</script>'
       '</head>'
       '<body>'
+      '<#pr>'
       '<#main>'
       '<p style=text-align:center><a href=/>'#25147#12427'</a>'
       '</body>'
diff --git a/WebModuleUnit1.pas b/WebModuleUnit1.pas
index 8334404..1c97507 100644 (file)
--- a/WebModuleUnit1.pas
+++ b/WebModuleUnit1.pas
@@ -99,6 +99,10 @@ type
       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;
@@ -121,10 +125,15 @@ uses Unit1, IdHashSHA, IdGlobal, IdHash, IdHashMessageDigest;
 
 {$R *.dfm}
 
+const
+  promotion: string = '\8dL\8d\90:';
+
 procedure TTWebModule1.adheadHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 begin
-  if (TagString = 'mente') and (DataModule1.FDTable3.FieldByName('mente')
+  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
@@ -249,13 +258,22 @@ begin
     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;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 var
   i: Integer;
   x: Boolean;
 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;
@@ -326,10 +344,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;
@@ -382,7 +409,9 @@ 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
@@ -431,7 +460,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
@@ -482,7 +513,9 @@ end;
 procedure TTWebModule1.titleHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 begin
-  if TagString = 'js' then
+  if TagString = 'pr' then
+    ReplaceText:=promotion
+  else if TagString = 'js' then
     ReplaceText := detail(TagString, TagParams.Values['id'])
   else
     with DataModule1.FDQuery1 do
@@ -503,7 +536,9 @@ var
   s, t: string;
   i, j, k: Integer;
 begin
-  if TagString = 'list' then
+  if TagString = 'pr' then
+    ReplaceText := promotion
+  else if TagString = 'list' then
   begin
     i := DataModule1.FDTable3.FieldByName('info').AsInteger;
     for k := 0 to DataModule1.FDTable3.FieldByName('tcnt').AsInteger do
@@ -631,6 +666,7 @@ begin
     Name := 'user';
     Value := s;
     Expires := Now + 14;
+    Secure := true;
   end;
   Request.CookieFields.Values['user'] := s;
   TWebModule1adminAction(nil, Request, Response, Handled);
@@ -798,6 +834,7 @@ begin
     Name := 'user';
     Value := Request.ContentFields.Values['password'];
     Expires := Now + 14;
+    Secure := true;
   end;
   i := DataModule1.FDTable1.Lookup('database',
     Request.ContentFields.Values['record'], 'dbnum');
About OSDN
Find Software
Develop Software
Help