OSDN Git Service

/regist がややこしくなってしまいました
[newbbs/newbbs.git] / WebModuleUnit1.pas
index 15ccd2d..a04fe58 100644 (file)
@@ -108,6 +108,10 @@ type
     ss: TStringList;
     tagstr: string;
     procedure pages(count: Integer; var page: Integer);
+    procedure strsCheck(var error: string; var list: TStringList);
+    procedure setLastArticle;
+    function isInfo(sort: Boolean = true): Boolean;
+    function loginCheck: Boolean;
     function hash(str: string): string;
     function mente: Boolean;
     function detail(ts, pid: string): string;
@@ -129,6 +133,8 @@ uses Unit1, IdHashSHA, IdGlobal, IdHash, IdHashMessageDigest;
 const
   promotion = '\8dL\8d\90:';
   tcnt = 7;
+  sortNormal = 'DBNUM;NUMBER';
+  sortReverse = 'DBNUM;NUMBER:A';
 
 procedure TWebModule1.adheadHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
@@ -138,8 +144,6 @@ begin
   else if (TagString = 'mente') and
     (DataModule1.FDTable3.FieldByName('mente').AsBoolean = true) then
     ReplaceText := 'checked'
-  else if TagString = 'password' then
-    ReplaceText := Request.CookieFields.Values['user']
   else if TagString = 'database' then
     ReplaceText := Request.QueryFields.Values['db'];
 end;
@@ -159,9 +163,9 @@ var
   s: TStringList;
   i: Integer;
 begin
-  if (TagString = 'plus')and(alert.Tag = 0) then
+  if (TagString = 'plus') and (alert.Tag = 0) then
     ReplaceText :=
-        '<a href=/jump?db=<#dbname>&num=<#posnum>>[ <#dbname>-<#posnum> ]</a>'
+      '<a href=/jump?db=<#dbname>&num=<#posnum>>[ <#dbname>-<#posnum> ]</a>'
   else if TagString = 'article' then
   begin
     with DataModule1 do
@@ -272,7 +276,25 @@ procedure TWebModule1.helpHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 begin
   if TagString = 'pr' then
-    ReplaceText := promotion;
+    ReplaceText := promotion
+  else if TagString = 'area' then
+    if help.Tag = 0 then
+    begin
+      ss := TStringList.Create;
+      try
+        ss.Add('<form action=/help method=post><p>\82¨\96â\82¢\8d\87\82í\82¹<\8dí\8f\9c\88Ë\97\8a\82È\82Ç\89½\82Å\82à></p>');
+        ss.Add('<textarea name=help style=height:100px;width:250px>\93\8a\8de\8eÒ\96¼\82È\82Ç\81F');
+        ss.Add('\91\8a\92k\93à\97e\81F');
+        ss.Add('\82»\82Ì\91¼\81F</textarea><br>');
+        ss.Add('<input type=submit value="\91\97\90M"></form>');
+        ReplaceText := ss.Text;
+      finally
+        ss.Free;
+      end;
+    end
+    else
+      ReplaceText :=
+        '<p style=color:yellow;background-color:aqua>\82²\95ñ\8d\90\82 \82è\82ª\82Æ\82¤\82²\82´\82¢\82Ü\82·.';
 end;
 
 procedure TWebModule1.indexHTMLTag(Sender: TObject; Tag: TTag;
@@ -302,13 +324,18 @@ begin
   else if TagString = 'footer' then
     ReplaceText := footer.Content
   else if TagString = 'header' then
-  begin
-    i := DataModule1.FDTable3.FieldByName('count').AsInteger;
-    if 10 * i <= DataModule1.FDTable2.RecordCount then
-      ReplaceText := '<h1>\82±\82ê\88È\8fã\93\8a\8de\82Å\82«\82Ü\82¹\82ñ.</h1>'
+    if (DataModule1.FDTable1.FieldByName('dbnum')
+      .AsInteger = DataModule1.FDTable3.FieldByName('info').AsInteger) and
+      (loginCheck = false) then
+      ReplaceText := '<h1 style=text-align:center>\8aÇ\97\9d\90l\82©\82ç\82¨\92m\82ç\82¹\82ª\82 \82è\82Ü\82·.</h1>'
     else
-      ReplaceText := header.Content;
-  end
+    begin
+      i := DataModule1.FDTable3.FieldByName('count').AsInteger;
+      if 10 * i <= DataModule1.FDTable2.RecordCount then
+        ReplaceText := '<h1>\82±\82ê\88È\8fã\93\8a\8de\82Å\82«\82Ü\82¹\82ñ.</h1>'
+      else
+        ReplaceText := header.Content;
+    end
   else if (TagString = 'css') or (TagString = 'js') then
     ReplaceText := detail(TagString, TagParams.Values['id'])
   else if TagString = 'dbnum' then
@@ -317,6 +344,31 @@ begin
     ReplaceText := DataModule1.FDTable1.FieldByName('database').AsString;
 end;
 
+function TWebModule1.isInfo(sort: Boolean = true): Boolean;
+var
+  s: string;
+begin
+  result := DataModule1.FDTable1.FieldByName('dbnum')
+    .AsInteger = DataModule1.FDTable3.FieldByName('info').AsInteger;
+  if sort = false then
+    Exit;
+  with DataModule1.FDTable2 do
+  begin
+    s := IndexFieldNames;
+    if (result = false) and (s = sortNormal) then
+      Exit;
+    Close;
+    try
+      if result = true then
+        IndexFieldNames := sortReverse
+      else
+        IndexFieldNames := sortNormal;
+    finally
+      Open;
+    end;
+  end;
+end;
+
 procedure TWebModule1.itemsHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 var
@@ -354,6 +406,12 @@ begin
   end;
 end;
 
+function TWebModule1.loginCheck: Boolean;
+begin
+  result := hash(Request.CookieFields.Values['user'])
+    = DataModule1.FDTable3.FieldByName('password').AsString;
+end;
+
 procedure TWebModule1.loginHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 begin
@@ -374,9 +432,9 @@ begin
       while Eof = false do
       begin
         if FieldByName('posnum').AsInteger = -1 then
-          alert.Tag:=1
+          alert.Tag := 1
         else
-          alert.Tag:=0;
+          alert.Tag := 0;
         ReplaceText := ReplaceText + alert.ContentFromString(alert.Content);
         Next;
       end;
@@ -513,18 +571,47 @@ begin
     ReplaceText := css2.Content;
 end;
 
+procedure TWebModule1.setLastArticle;
+begin
+  {
+    if isInfo(false) = true then
+    DataModule1.FDTable2.First
+    else
+  }
+  DataModule1.FDTable2.Last;
+end;
+
+procedure TWebModule1.strsCheck(var error: string; var list: TStringList);
+var
+  s: TStringList;
+  i, j: Integer;
+  x: Boolean;
+begin
+  x := false;
+  s := TStringList.Create;
+  try
+    s.DelimitedText := DataModule1.FDTable3.FieldByName('ng').AsString;
+    for i := 0 to s.count - 1 do
+      for j := 0 to list.count - 1 do
+      begin
+        if Pos(s[i], list[j]) > 0 then
+          x := true;
+        list[j] := '<p>' + list[j];
+      end;
+  finally
+    s.Free;
+  end;
+  if x = true then
+    error := error + '<p>\8bÖ\8e~\8cê\8bå\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82Ü\82·.';
+end;
+
 procedure TWebModule1.tiHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 begin
   if TagString = 'count' then
-  begin
-    DataModule1.FDTable1.Locate('dbnum',
-      DataModule1.FDQuery1.FieldByName('dbnum').AsInteger);
-    ReplaceText := DataModule1.FDTable2.RecordCount.ToString;
-  end
+    ReplaceText := DataModule1.FDTable2.FieldCount.ToString
   else if TagString = 'database' then
-    ReplaceText := DataModule1.FDTable1.Lookup('dbnum',
-      DataModule1.FDQuery1.FieldByName('dbnum').AsInteger, 'database');
+    ReplaceText := DataModule1.FDTable1.FieldByName('database').AsString;
 end;
 
 procedure TWebModule1.titleHTMLTag(Sender: TObject; Tag: TTag;
@@ -535,15 +622,15 @@ begin
   else if TagString = 'js' then
     ReplaceText := detail(TagString, TagParams.Values['id'])
   else if TagString = 'main' then
-    with DataModule1.FDQuery1 do
+    with DataModule1.FDTable1 do
     begin
-      Open;
+      First;
       while Eof = false do
       begin
+        setLastArticle;
         ReplaceText := ReplaceText + ti.Content;
         Next;
       end;
-      Close;
     end;
 end;
 
@@ -571,7 +658,8 @@ begin
         continue;
       end;
       DataModule1.FDTable2.Last;
-      if Now - DataModule1.FDTable2.FieldByName('date').AsDateTime < 1 then
+      if (Now - DataModule1.FDTable2.FieldByName('date').AsDateTime < 1) and
+        (DataModule1.FDTable2.RecordCount > 0) then
         t := 'background-color:aqua;';
       if DataModule1.FDTable2.RecordCount >= 10 *
         DataModule1.FDTable3.FieldByName('count').AsInteger then
@@ -632,8 +720,7 @@ var
   i: Integer;
 begin
   s := Request.CookieFields.Values['user'];
-  if (s = '') or (hash(s) <> DataModule1.FDTable3.FieldByName('password')
-    .AsString) then
+  if (s = '') or (loginCheck = false) then
   begin
     WebModule1loginAction(nil, Request, Response, Handled);
     Exit;
@@ -697,7 +784,7 @@ var
   s: string;
 begin
   num1 := DataModule1.FDTable1.FieldByName('dbnum').AsInteger;
-  num2 := StrToIntDef(Request.QueryFields.Values['num'],-1);
+  num2 := StrToIntDef(Request.QueryFields.Values['num'], -1);
   if num2 = -1 then
     num1 := -1;
   if Request.MethodType = mtGet then
@@ -712,13 +799,14 @@ begin
     begin
       Last;
       i := FieldByName('id').AsInteger + 1;
-      s:=Request.ContentFields.Values['request'];
+      s := Request.ContentFields.Values['request'];
       if s = '' then
-        s:='(No Comment)';
+        s := '(No Comment)';
       AppendRecord([i, num1, num2, Now, s]);
     end;
     if num1 > -1 then
-      Response.SendRedirect(Format('/index?db=%d&num=%d#%d', [num1, num2, num2]))
+      Response.SendRedirect(Format('/index?db=%d&num=%d#%d',
+        [num1, num2, num2]))
     else
       Response.SendRedirect('/top');
   end;
@@ -767,21 +855,20 @@ end;
 procedure TWebModule1.WebModule1helpAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
-  i, j, k: Integer;
+  k: Integer;
   s: string;
 begin
   Response.ContentType := 'text/html;charset=utf-8';
   if Request.MethodType = mtPost then
   begin
-  {
-    i := DataModule1.FDTable1.FieldByName('dbnum').AsInteger;;
-    j := DataModule1.FDTable2.FieldByName('number').AsInteger;
-    }
     s := Request.ContentFields.Values['help'];
     DataModule1.FDTable4.Last;
     k := DataModule1.FDTable4.FieldByName('id').AsInteger + 1;
-    DataModule1.FDTable4.AppendRecord([k, -1,-1, Now, s]);
-  end;
+    DataModule1.FDTable4.AppendRecord([k, -1, -1, Now, s]);
+    help.Tag := 1;
+  end
+  else
+    help.Tag := 0;
   Response.Content := help.Content;
 end;
 
@@ -811,15 +898,16 @@ end;
 procedure TWebModule1.WebModule1indexpageAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
-  int: Integer;
+  i: Integer;
   s: string;
 begin
   s := Request.QueryFields.Values['db'];
   if s <> '' then
     DataModule1.FDTable1.Locate('dbnum', s, []);
-  int := StrToIntDef(Request.QueryFields.Values['num'], -1);
-  pages(DataModule1.FDTable2.RecordCount, int);
-  index.Tag := int;
+  i := StrToIntDef(Request.QueryFields.Values['num'], -1);
+  isInfo;
+  pages(DataModule1.FDTable2.RecordCount, i);
+  index.Tag := i;
   tagstr := '/index';
   Self.Tag := Integer(@tagstr);
   Response.ContentType := 'text/html; charset="utf-8"';
@@ -927,14 +1015,13 @@ var
   s: string;
   i: Integer;
 begin
-  if hash(Request.CookieFields.Values['user']) <>
-    DataModule1.FDTable3.FieldByName('password').AsString then
+  if loginCheck = false then
   begin
     with DataModule1.FDTable1 do
       if Locate('database', 'master') = false then
       begin
         Last;
-        i:=FieldByName('dbnum').AsInteger+1;
+        i := FieldByName('dbnum').AsInteger + 1;
         AppendRecord([i, 'master']);
       end;
     WebModule1loginAction(nil, Request, Response, Handled);
@@ -976,7 +1063,6 @@ var
   number, i: Integer;
   title, na, raw, pass, kotoba, error: string;
   comment: TStringList;
-  x: Boolean;
   function scan(Text: string): string;
   var
     reg: TRegEx;
@@ -1001,15 +1087,12 @@ var
   end;
 
 begin
-  error := '';
   kotoba := Request.ContentFields.Values['aikotoba'];
+  error := '';
   if kotoba <> '\82°\82ñ\82«' then
-    error := '<section style=color:red><p>\8d\87\8c¾\97t\82ª\82¿\82ª\82¢\82Ü\82·.';
-  with DataModule1.FDTable2 do
-  begin
-    Last;
-    number := FieldByName('number').AsInteger + 1;
-  end;
+    error := error + '<p>\8d\87\8c¾\97t\82ª\82¿\82ª\82¢\82Ü\82·.';
+  setLastArticle;
+  number := DataModule1.FDTable2.FieldByName('number').AsInteger + 1;
   with Request.ContentFields do
   begin
     title := Values['title'];
@@ -1038,31 +1121,26 @@ begin
   comment := TStringList.Create;
   try
     comment.Text := raw;
-    for i := 0 to comment.count - 1 do
-    begin
-      if Pos('ng', comment[i]) > 0 then
-      begin
-        error := error + '<p>\8bÖ\8e~\8cê\8bå\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82Ü\82·.';
-        break;
-      end;
-      comment[i] := '<p>' + scan(comment[i]);
-    end;
-    x := Request.ContentFields.Values['show'] = 'true';
+    strsCheck(error, comment);
+    Request.ContentFields.Values['raw'] := raw;
     if error <> '' then
-      error := error + '</section>'
-    else if x = true then
+      Request.ContentFields.Values['preview'] := '<section style=color:red>' +
+        error + '</section>'
+    else if Request.ContentFields.Values['show'] = 'true' then
     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.Values['preview'] := error;
-      Request.ContentFields.Values['raw'] := raw;
+      Request.ContentFields.Values['show'] := 'false';
     end
     else
     begin
+      if isInfo(false) = true then
+        DataModule1.FDTable2.IndexFieldNames := '';
       i := DataModule1.FDTable1.FieldByName('dbnum').AsInteger;
       DataModule1.FDTable2.AppendRecord([i, number, title, na, comment.Text,
         raw, Now, pass]);
+      isInfo;
       Response.SendRedirect('index?db=' + i.ToString + '#article');
       Exit;
     end;
@@ -1099,6 +1177,7 @@ procedure TWebModule1.WebModuleCreate(Sender: TObject);
 var
   i: Integer;
   a: Variant;
+  s: string;
 begin
   with DataModule1 do
   begin
@@ -1130,10 +1209,11 @@ begin
   if DataModule1.FDTable3.Bof and DataModule1.FDTable3.Eof then
   begin
     a := DataModule1.FDTable1.Lookup('database', 'info', 'dbnum');
+    s := '\88¢\95Û,\94n\8e­,\8e\80\82Ë';
     DataModule1.FDTable3.AppendRecord
       (['\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(hash('admin'))]);
+      false, a, 30, hash(hash('admin')), s]);
   end;
 end;