master にまだ修正が必要でした

[newbbs/newbbs.git] / WebModuleUnit1.pas

diff --git a/WebModuleUnit1.pas b/WebModuleUnit1.pas
index 8152116..5e9c27e 100644 (file)
--- a/WebModuleUnit1.pas
+++ b/WebModuleUnit1.pas
@@ -9,7 +9,8 @@ uses System.SysUtils, System.Classes, Web.HTTPApp, Web.DSProd, Web.HTTPProd,
   FireDAC.Phys.Intf, FireDAC.DApt.Intf, FireDAC.Stan.Async, FireDAC.DApt,
   FireDAC.Comp.DataSet, FireDAC.Comp.Client, FireDAC.UI.Intf, FireDAC.Stan.Def,
   FireDAC.Stan.Pool, FireDAC.Phys, FireDAC.Phys.FB, FireDAC.Phys.FBDef,
-  FireDAC.Phys.MySQL, FireDAC.Phys.MySQLDef;
+  FireDAC.Phys.MySQL, FireDAC.Phys.MySQLDef, FireDAC.VCLUI.Wait,
+  FireDAC.Comp.UI;
 
 type
   TWebModule1 = class(TWebModule)
@@ -71,6 +72,7 @@ type
     login: TPageProducer;
     footer: TPageProducer;
     FDTable3mente: TBooleanField;
+    FDGUIxWaitCursor1: TFDGUIxWaitCursor;
     procedure indexHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
     procedure WebModule1indexpageAction(Sender: TObject; Request: TWebRequest;
@@ -143,6 +145,8 @@ type
       TagParams: TStrings; var ReplaceText: string);
     procedure css1HTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
+    procedure WebModule1usrdelAction(Sender: TObject; Request: TWebRequest;
+      Response: TWebResponse; var Handled: Boolean);
   private
     { private \90é\8c¾ }
     ss: TStringList;
@@ -202,16 +206,14 @@ procedure TWebModule1.alertHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 var
   s: TStringList;
-  i, j: Integer;
+  i: Integer;
 begin
   if (TagString = 'plus') and (alert.Tag = 0) then
     ReplaceText := '<a href=' + Request.ScriptName +
       '/jump?db=<#dbname>&num=<#posnum>>[ <#dbname>-<#posnum> ]</a>'
   else if TagString = 'article' then
   begin
-    i := FDTable4.FieldByName('dbname').AsInteger;
-    j := FDTable4.FieldByName('posnum').AsInteger;
-    if FDTable2.Locate('dbnum;number', VarArrayOf([i, j])) = false then
+    if alert.Tag = 1 then
     begin
       ReplaceText := '<p>\83\8a\83N\83G\83X\83g';
       Exit;
@@ -446,7 +448,7 @@ end;
 procedure TWebModule1.loginHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 var
-  i: integer;
+  i: Integer;
 begin
   if TagString = 'pr' then
     ReplaceText := promotion
@@ -464,22 +466,26 @@ end;
 procedure TWebModule1.masterHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 var
-  i: Integer;
+  i, j: Integer;
 begin
   if TagString = 'pr' then
     ReplaceText := promotion
   else if TagString = 'uri' then
     ReplaceText := Request.ScriptName
   else if TagString = 'request' then
+  begin
+    FDTable1.Close;
     with FDTable4 do
     begin
       First;
       while Eof = false do
       begin
-        if FieldByName('posnum').AsInteger = -1 then
-          alert.Tag := 1
+        i := FieldByName('dbname').AsInteger;
+        j := FieldByName('posnum').AsInteger;
+        if FDTable2.Locate('dbnum;number', VarArrayOf([i, j])) = true then
+          alert.Tag := 0
         else
-          alert.Tag := 0;
+          alert.Tag := 1;
         ReplaceText := ReplaceText + alert.ContentFromString(alert.Content);
         Next;
       end;
@@ -487,6 +493,9 @@ begin
         ReplaceText := '<table border=1 align=center>' + ReplaceText +
           '</table>';
     end;
+    FDTable1.Open;
+    FDTable1.Refresh;
+  end;
 end;
 
 function TWebModule1.mente: Boolean;
@@ -895,7 +904,7 @@ begin
   if Request.MethodType = mtGet then
   begin
     FDTable1.Locate('dbnum', num1);
-    FDTable2.Locate('number', num2, []);
+    FDTable2.Locate('number', num2);
     Response.ContentType := 'text/html;charset=utf-8';
     Response.Content := mail.Content;
   end
@@ -910,8 +919,7 @@ begin
         s := '(No Comment)';
       AppendRecord([i, num1, num2, Now, s]);
     end;
-    Response.SendRedirect(Format('%s/index?db=%d&num=%d#%d',
-      [Request.ScriptName, num1, num2, num2]))
+    WebModule1jumpAction(nil, Request, Response, Handled);
   end;
 end;
 
@@ -983,7 +991,7 @@ var
 begin
   with FDTable5 do
   begin
-    s := Request.ContentFields.Values['name'];
+    s := Request.QueryFields.Values['name'];
     Response.ContentType := 'image/jpeg';
     if Locate('name', s) = true then
     begin
@@ -1029,6 +1037,8 @@ var
 begin
   DB := Request.QueryFields.Values['db'];
   s := Request.QueryFields.Values['num'];
+  if s = '' then
+    s := Request.ContentFields.Values['num'];
   i := 10;
   pages(s.ToInteger, i);
   Response.SendRedirect(Format('%s/index?db=%s&num=%d#%s', [Request.ScriptName,
@@ -1067,8 +1077,8 @@ begin
   s := Request.ContentFields.Values['record'];
   v := FDTable1.Lookup('database', s, 'dbnum');
   t := hash(Request.ContentFields.Values['password']);
-  if (VarIsNull(v) = false) and (hash(t) = FDTable3.FieldByName('password').AsString)
-  then
+  if (VarIsNull(v) = false) and (hash(t) = FDTable3.FieldByName('password')
+    .AsString) then
   begin
     with Response.Cookies.Add do
     begin
@@ -1085,11 +1095,11 @@ begin
   end
   else if VarIsNull(v) = false then
   begin
-    t:=v;
-    Response.SendRedirect(Request.ScriptName+'/login?db='+t);
+    t := v;
+    Response.SendRedirect(Request.ScriptName + '/login?db=' + t);
   end
   else
-    Response.SendRedirect(Request.ScriptName+'/login');
+    Response.SendRedirect(Request.ScriptName + '/login');
 end;
 
 procedure TWebModule1.WebModule1logoutAction(Sender: TObject;
@@ -1131,27 +1141,26 @@ begin
   if Request.MethodType = mtPost then
   begin
     s := Request.ContentFields.Values['delete'];
-    if s = 'all' then
-      with FDTable4 do
-        repeat
-          Delete;
-        until (Bof = true) and (Eof = true)
+    with FDTable4 do
+      if s = 'all' then
+        while not (Bof = true) and (Eof = true) do
+          Delete
       else
       begin
-        FDTable4.First;
-        while FDTable4.Eof = false do
+        First;
+        while Eof = false do
         begin
-          i := FDTable4.FieldByName('dbname').AsInteger;
+          i := FieldByName('dbname').AsInteger;
           if FDTable1.Locate('dbnum', i) = true then
           begin
-            i := FDTable4.FieldByName('posnum').AsInteger;
+            i := FieldByName('posnum').AsInteger;
             if FDTable2.Locate('number', i) = false then
-              FDTable4.Delete
+              Delete
             else
-              FDTable4.Next;
+              Next;
           end
           else
-            FDTable4.Delete;
+            Delete;
         end;
       end;
   end;
@@ -1266,6 +1275,20 @@ begin
     Response.Content := top.ContentFromString(top.Content);
 end;
 
+procedure TWebModule1.WebModule1usrdelAction(Sender: TObject;
+  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+var
+  s, t, p: string;
+begin
+  s := Request.QueryFields.Values['db'];
+  t := Request.ContentFields.Values['num'];
+  p := Request.ContentFields.Values['password'];
+  if FDTable2.Locate('dbnum;number;pass',
+    VarArrayOf([s.ToInteger, t.ToInteger, p])) = true then
+    FDTable2.Delete;
+  WebModule1indexpageAction(nil, Request, Response, Handled);
+end;
+
 procedure TWebModule1.WebModuleCreate(Sender: TObject);
 var
   i: Integer;