OSDN Git Service

Linuxでも動作します
[newbbs/newbbs.git] / WebModuleUnit1.pas
index cb2cbbc..94e734e 100644 (file)
@@ -24,15 +24,12 @@ type
     master: TPageProducer;
     alert: TDataSetPageProducer;
     mail: TPageProducer;
-    css1: TPageProducer;
     css2: TPageProducer;
     css3: TPageProducer;
     css4: TPageProducer;
     header: TDataSetPageProducer;
     js1: TPageProducer;
     js2: TPageProducer;
-    js3: TPageProducer;
-    js4: TPageProducer;
     adhead: TPageProducer;
     js5: TPageProducer;
     title: TPageProducer;
@@ -65,14 +62,14 @@ type
     FDTable1: TFDTable;
     FDTable1DBNUM: TIntegerField;
     FDTable1DATABASE: TWideStringField;
-    FDTable5ID: TIntegerField;
-    FDTable5NAME: TWideStringField;
-    FDTable5SOURCE: TBlobField;
     login: TPageProducer;
     footer: TPageProducer;
     FDGUIxWaitCursor1: TFDGUIxWaitCursor;
     FDQuery1: TFDQuery;
     FDTable3mente: TSmallintField;
+    FDTable5id: TIntegerField;
+    FDTable5name: TWideStringField;
+    FDTable5source: TWideMemoField;
     procedure indexHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
     procedure WebModule1indexpageAction(Sender: TObject; Request: TWebRequest;
@@ -154,6 +151,7 @@ type
     procedure pages(count: Integer; var page: Integer);
     procedure strsCheck(var Error: string; list: TStringList);
     procedure setLastArticle;
+    function footerLink(Data: array of const): string;
     function isInfo: Boolean;
     function loginCheck: Boolean;
     function hash(str: string): string;
@@ -198,8 +196,23 @@ procedure TWebModule1.adminFormatCell(Sender: TObject;
   var Align: THTMLAlign; var VAlign: THTMLVAlign;
   var CustomAttrs, CellData: string);
 begin
-  if (CellColumn = 0) and (CellRow > 0) then
-    CellData := Format('<input name=check%d type=checkbox>', [CellRow]);
+  if CellRow = 0 then
+  begin
+    BgColor := 'Silver';
+    Exit;
+  end;
+  if CellRow mod 2 = 0 then
+    BgColor := 'snow';
+  case CellColumn of
+    0:
+      CellData := Format('<input name=check%d type=checkbox>', [CellRow]);
+    1:
+      CellData := '<b>' + CellData + '</b>';
+    2:
+      CellData := '<p style=color:red>' + CellData + '</p>';
+    3:
+      CellData := '<p style=color:green>' + CellData + '</p>';
+  end;
 end;
 
 procedure TWebModule1.alertHTMLTag(Sender: TObject; Tag: TTag;
@@ -265,25 +278,38 @@ procedure TWebModule1.footerHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 var
   i: Integer;
+  s: shortstring;
+  x: Boolean;
 begin
   if TagString = 'link' then
   begin
     for i := 1 to 10 do
-      if i = index.Tag then
-        ReplaceText := ReplaceText + ' ' + i.ToString + ' '
-      else
-        ReplaceText := ReplaceText +
-          Format(' <a style=text-decoration-line:none href="%s?db=%d&num=%d">%d</a> ',
-          [Request.ScriptName + PString(Self.Tag)^,
-          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="' +
-        Request.ScriptName + PString(Self.Tag)^ + '?db=' +
-        FDTable1.FieldByName('dbnum').AsString + '">recent</a>';
+    begin
+      x := i = index.Tag;
+      ReplaceText := ReplaceText + footerLink([i, i, x]);
+    end;
+    x := index.Tag = -1;
+    s := '\82³\82¢\82²';
+    ReplaceText := ReplaceText + footerLink([-1, s, x]);
+  end;
+end;
+
+function TWebModule1.footerLink(Data: array of const): string;
+var
+  s, t: string;
+begin
+  if Data[1].VType = vtInteger then
+    t := Data[1].VInteger.toString
+  else
+    t := Data[1].VString^;
+  if Data[2].VBoolean = true then
+    s := ' active'
+  else
+    s := '';
+  result := Format
+    ('<li class="page-item%s"><a class=page-link href="%s?db=%d&num=%d">%s</a></li>',
+    [s, Request.ScriptName + tagstr, FDTable1.FieldByName('dbnum').AsInteger,
+    Data[0].VInteger, t]);
 end;
 
 function TWebModule1.hash(str: string): string;
@@ -473,8 +499,6 @@ begin
   else if TagString = 'uri' then
     ReplaceText := Request.ScriptName
   else if TagString = 'request' then
-  begin
-    FDTable1.Close;
     with FDTable4 do
     begin
       First;
@@ -493,9 +517,6 @@ begin
         ReplaceText := '<table border=1 align=center>' + ReplaceText +
           '</table>';
     end;
-    FDTable1.Open;
-    FDTable1.Refresh;
-  end;
 end;
 
 function TWebModule1.mente: Boolean;
@@ -710,7 +731,7 @@ begin
   if TagString = 'uri' then
     ReplaceText := Request.ScriptName
   else if TagString = 'count' then
-    ReplaceText := FDTable2.RecordCount.ToString
+    ReplaceText := FDTable2.RecordCount.toString
   else if TagString = 'database' then
     ReplaceText := FDTable1.FieldByName('database').AsString
   else if TagString = 'date' then
@@ -778,6 +799,9 @@ begin
         [t, Request.ScriptName, j, s]);
       FDTable1.Next;
     end;
+    ReplaceText :=
+      '<div class="carousel-caption text-left" style="text-align:bottom;font-size:1.5rem">'
+      + ReplaceText + '</div>';
   end
   else if TagString = 'info' then
     ReplaceText := FDTable1.Lookup('dbnum', FDTable3.FieldByName('info')
@@ -788,11 +812,25 @@ begin
     ReplaceText := detail(TagString, TagParams.Values['id'])
   else if TagString = 'slide' then
   begin
+    s := ' active';
     for i := 1 to (FDTable1.RecordCount div tcnt) + 1 do
+    begin
       ReplaceText := ReplaceText +
-        Format('<div class="slide"><img src="%s/src?name=slide%d.jpg"',
-        [Request.ScriptName, i]) +
-        ' style=float:right;height:465px><#list></div>';
+        Format('<div class="carousel-item%s"><img src="%s/src?name=slide%d.jpg"',
+        [s, Request.ScriptName, i]) +
+        ' class="d-sm-block d-none" style=float:right;height:465px><div style=height:465px></div><#list></div>';
+      s := '';
+    end;
+  end
+  else if TagString = 'indicator' then
+  begin
+    s := ' class="active"';
+    for i := 0 to (FDTable1.RecordCount div tcnt) do
+    begin
+      ReplaceText := ReplaceText +
+        Format('<li data-target="#slide-1" data-slide-to=%d%s></li>', [i, s]);
+      s := '';
+    end;
   end;
 end;
 
@@ -842,7 +880,6 @@ begin
   pages(FDTable2.RecordCount, i);
   index.Tag := i;
   tagstr := '/admin';
-  Self.Tag := Integer(@tagstr);
   admin.header.text := adhead.Content;
   admin.footer.Clear;
   admin.footer.Add
@@ -872,7 +909,7 @@ begin
     else
       i := 0;
     FieldByName('mente').AsInteger := i;
-    if s <> '' then
+    if (s <> '') and (s = Request.ContentFields.Values['pass2']) then
     begin
       s := hash(s);
       FieldByName('password').AsString := hash(s);
@@ -985,21 +1022,22 @@ procedure TWebModule1.WebModule1imgAction(Sender: TObject; Request: TWebRequest;
   Response: TWebResponse; var Handled: Boolean);
 var
   s: string;
-  res: TStream;
+  p: TBytes;
+  res: TMemoryStream;
 begin
   with FDTable5 do
   begin
     s := Request.QueryFields.Values['name'];
-    Response.ContentType := 'image/jpeg';
+    if ExtractFileExt(s) = '.ico' then
+      Response.ContentType:='image/x-ico'
+    else
+      Response.ContentType := 'image/jpeg';
     if Locate('name', s) = true then
     begin
-      res := CreateBlobStream(FieldByName('source'), bmRead);
-      Response.ContentStream := res;
-    end
-    else if s = 'sprites.png' then
-    begin
-      Response.ContentType := 'image/png';
-      res := TResourceStream.Create(HInstance, 'PngImage_1', RT_RCDATA);
+      s := FieldByName('source').AsString;
+      p := TNetEncoding.Base64.DecodeStringToBytes(s);
+      res := TMemoryStream.Create;
+      res.WriteBuffer(p, Length(p));
       Response.ContentStream := res;
     end
     else
@@ -1024,7 +1062,6 @@ begin
   pages(FDTable2.RecordCount, i);
   index.Tag := i;
   tagstr := '/index';
-  Self.Tag := Integer(@tagstr);
   Response.Content := index.Content;
 end;
 
@@ -1090,7 +1127,7 @@ begin
     if s = 'master' then
       Response.SendRedirect(Request.ScriptName + '/master')
     else
-      Response.SendRedirect(Request.ScriptName + '/admin?db=' + i.ToString);
+      Response.SendRedirect(Request.ScriptName + '/admin?db=' + i.toString);
   end
   else if VarIsNull(v) = false then
   begin
@@ -1140,13 +1177,12 @@ begin
   if Request.MethodType = mtPost then
   begin
     s := Request.ContentFields.Values['delete'];
+    FDTable4.First;
     with FDTable4 do
       if s = 'all' then
         while not((Bof = true) and (Eof = true)) do
           Delete
       else
-      begin
-        First;
         while Eof = false do
         begin
           i := FieldByName('dbname').AsInteger;
@@ -1161,7 +1197,6 @@ begin
           else
             Delete;
         end;
-      end;
   end;
   FDTable4.First;
   Response.ContentType := 'text/html;charset=utf-8';
@@ -1244,7 +1279,7 @@ begin
       setLastArticle;
       number := FDTable2.FieldByName('number').AsInteger + 1;
       FDTable2.AppendRecord([i, number, title, na, temp, raw, Now, pass]);
-      Response.SendRedirect(Request.ScriptName + '/index?db=' + i.ToString +
+      Response.SendRedirect(Request.ScriptName + '/index?db=' + i.toString +
         '#article');
     end;
     Exit;
@@ -1318,7 +1353,7 @@ begin
     FDTable1.AppendRecord([0, 'info']);
     FDTable1.AppendRecord([1, 'master']);
     for i := 1 to 10 do
-      FDTable1.AppendRecord([i + 1, '\8cf\8e¦\94Â' + i.ToString]);
+      FDTable1.AppendRecord([i + 1, '\8cf\8e¦\94Â' + i.toString]);
   end;
   if (FDTable3.Bof = true) and (FDTable3.Eof = true) then
   begin
@@ -1329,6 +1364,7 @@ begin
       '<h1 style=color:maron;text-align:center;font-style:italic>\82Æ\82é\82Ë\81`\82Ç\8d\86</h1>',
       0, i, 30, hash(hash('admin')), s]);
   end;
+  admin.MaxRows := FDTable3.FieldByName('count').AsInteger;
 end;
 
 end.