OSDN Git Service

(root) / newbbs / newbbs.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
/regist がややこしくなってしまいました
[newbbs/newbbs.git] / WebModuleUnit1.pas
diff --git a/WebModuleUnit1.pas b/WebModuleUnit1.pas
index 3736a31..a04fe58 100644 (file)
--- a/WebModuleUnit1.pas
+++ b/WebModuleUnit1.pas
@@ -4,10 +4,10 @@ interface
 
 uses System.SysUtils, System.Classes, Web.HTTPApp, Web.DSProd, Web.HTTPProd,
   Web.DBWeb, System.Variants, System.NetEncoding, System.RegularExpressions,
-  Data.DB, Web.DBXpressWeb;
+  Data.DB, Web.DBXpressWeb, System.Types;
 
 type
-  TTWebModule1 = class(TWebModule)
+  TWebModule1 = class(TWebModule)
     articles: TDataSetPageProducer;
     index: TDataSetPageProducer;
     admin: TDataSetTableProducer;
@@ -35,22 +35,22 @@ type
     ti: TDataSetPageProducer;
     procedure indexHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
-    procedure TWebModule1indexpageAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1indexpageAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
-    procedure TWebModule1registAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1registAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
     procedure WebModuleCreate(Sender: TObject);
-    procedure TWebModule1adminAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1adminAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
-    procedure TWebModule1topAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1topAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
     procedure itemsHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
     procedure topHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
-    procedure TWebModule1searchAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1searchAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
-    procedure TWebModule1helpAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1helpAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
     procedure searchHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
@@ -60,42 +60,42 @@ type
       const TagString: string; TagParams: TStrings; var ReplaceText: string);
     procedure footerHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
-    procedure TWebModule1alertAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1alertAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
-    procedure TWebModule1masterAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1masterAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
     procedure mailHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
     procedure alertHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
-    procedure TWebModule1deleteAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1deleteAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
-    procedure TWebModule1jumpAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1jumpAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
-    procedure TWebModule1linkAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1linkAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
     procedure headerHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
     procedure adminFormatCell(Sender: TObject; CellRow, CellColumn: Integer;
       var BgColor: THTMLBgColor; var Align: THTMLAlign; var VAlign: THTMLVAlign;
       var CustomAttrs, CellData: string);
-    procedure TWebModule1admdelAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1admdelAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
-    procedure TWebModule1loginAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1loginAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
-    procedure TWebModule1adminsetAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1adminsetAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
     procedure adheadHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
-    procedure TWebModule1logoutAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1logoutAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
-    procedure TWebModule1imgAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1imgAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
-    procedure TWebModule1fileAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1fileAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
     procedure titleHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
-    procedure TWebModule1titleAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1titleAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
     procedure tiHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
@@ -106,7 +106,12 @@ type
   private
     { private \90é\8c¾ }
     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;
@@ -115,7 +120,7 @@ type
   end;
 
 var
-  WebModuleClass: TComponentClass = TTWebModule1;
+  WebModuleClass: TComponentClass = TWebModule1;
 
 implementation
 
@@ -126,9 +131,12 @@ uses Unit1, IdHashSHA, IdGlobal, IdHash, IdHashMessageDigest;
 {$R *.dfm}
 
 const
-  promotion: string = '\8dL\8d\90:';
+  promotion = '\8dL\8d\90:';
+  tcnt = 7;
+  sortNormal = 'DBNUM;NUMBER';
+  sortReverse = 'DBNUM;NUMBER:A';
 
-procedure TTWebModule1.adheadHTMLTag(Sender: TObject; Tag: TTag;
+procedure TWebModule1.adheadHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 begin
   if TagString = 'pr' then
@@ -136,11 +144,11 @@ 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;
 
-procedure TTWebModule1.adminFormatCell(Sender: TObject;
+procedure TWebModule1.adminFormatCell(Sender: TObject;
   CellRow, CellColumn: Integer; var BgColor: THTMLBgColor;
   var Align: THTMLAlign; var VAlign: THTMLVAlign;
   var CustomAttrs, CellData: string);
@@ -149,19 +157,25 @@ begin
     CellData := Format('<input name=check%d type=checkbox>', [CellRow]);
 end;
 
-procedure TTWebModule1.alertHTMLTag(Sender: TObject; Tag: TTag;
+procedure TWebModule1.alertHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 var
   s: TStringList;
   i: Integer;
 begin
-  if TagString = 'article' then
+  if (TagString = 'plus') and (alert.Tag = 0) then
+    ReplaceText :=
+      '<a href=/jump?db=<#dbname>&num=<#posnum>>[ <#dbname>-<#posnum> ]</a>'
+  else if TagString = 'article' then
   begin
     with DataModule1 do
-    begin
-      FDTable1.Locate('dbnum', FDTable4.FieldByName('dbname').AsInteger);
-      FDTable2.Locate('number', FDTable4.FieldByName('posnum').AsInteger);
-    end;
+      if (FDTable1.Locate('dbnum', FDTable4.FieldByName('dbname').AsInteger)
+        = false) or (FDTable2.Locate('number', FDTable4.FieldByName('posnum')
+        .AsInteger) = false) then
+      begin
+        ReplaceText := '<p>\83\8a\83N\83G\83X\83g';
+        Exit;
+      end;
     s := TStringList.Create;
     try
       s.Text := articles.Content;
@@ -182,14 +196,14 @@ begin
     ReplaceText := DataModule1.FDTable4.FieldByName('request').AsString;
 end;
 
-procedure TTWebModule1.articlesHTMLTag(Sender: TObject; Tag: TTag;
+procedure TWebModule1.articlesHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 begin
   if TagString = 'comment' then
     ReplaceText := DataModule1.FDTable2.FieldByName('comment').AsString;
 end;
 
-function TTWebModule1.detail(ts, pid: string): string;
+function TWebModule1.detail(ts, pid: string): string;
 var
   i: Integer;
 begin
@@ -198,7 +212,7 @@ begin
       result := (Components[i] as TPageProducer).Content;
 end;
 
-procedure TTWebModule1.footerHTMLTag(Sender: TObject; Tag: TTag;
+procedure TWebModule1.footerHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 var
   i: Integer;
@@ -223,7 +237,7 @@ begin
         .AsString + '">recent</a>';
 end;
 
-function TTWebModule1.hash(str: string): string;
+function TWebModule1.hash(str: string): string;
 begin
   with TIdHashSHA1.Create do
   begin
@@ -235,7 +249,7 @@ begin
   end;
 end;
 
-procedure TTWebModule1.headerHTMLTag(Sender: TObject; Tag: TTag;
+procedure TWebModule1.headerHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 var
   s: string;
@@ -258,14 +272,32 @@ begin
     ReplaceText := Request.ContentFields.Values['title'];
 end;
 
-procedure TTWebModule1.helpHTMLTag(Sender: TObject; Tag: TTag;
+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 TTWebModule1.indexHTMLTag(Sender: TObject; Tag: TTag;
+procedure TWebModule1.indexHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 var
   i: Integer;
@@ -292,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
@@ -307,7 +344,32 @@ begin
     ReplaceText := DataModule1.FDTable1.FieldByName('database').AsString;
 end;
 
-procedure TTWebModule1.itemsHTMLTag(Sender: TObject; Tag: TTag;
+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
   s: TStringList;
@@ -333,7 +395,7 @@ begin
         str := Request.QueryFields.Values['db'];
         if str = '' then
           t := Format('<a href="/jump?db=%d&num=%d">[ %d-%d ]</a>',
-            [DataModule1.FDTable1.FieldByName('dbnum').AsInteger, j, i, j])
+            [i, j, i, j])
         else
           t := Format('<a href="/jump?db=%s&num=%d">[ %d ]</a>', [str, j, j]);
       end;
@@ -344,14 +406,20 @@ begin
   end;
 end;
 
-procedure TTWebModule1.loginHTMLTag(Sender: TObject; Tag: TTag;
+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
   if TagString = 'pr' then
     ReplaceText := promotion;
 end;
 
-procedure TTWebModule1.masterHTMLTag(Sender: TObject; Tag: TTag;
+procedure TWebModule1.masterHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 begin
   if TagString = 'pr' then
@@ -363,14 +431,18 @@ begin
       ReplaceText := '<table border=1 align=center>';
       while Eof = false do
       begin
-        ReplaceText := ReplaceText + alert.Content;
+        if FieldByName('posnum').AsInteger = -1 then
+          alert.Tag := 1
+        else
+          alert.Tag := 0;
+        ReplaceText := ReplaceText + alert.ContentFromString(alert.Content);
         Next;
       end;
       ReplaceText := ReplaceText + '</table>';
     end;
 end;
 
-function TTWebModule1.mente: Boolean;
+function TWebModule1.mente: Boolean;
 begin
   if DataModule1.FDTable3.FieldByName('mente').AsBoolean = true then
   begin
@@ -383,7 +455,7 @@ begin
     result := false;
 end;
 
-procedure TTWebModule1.pages(count: Integer; var page: Integer);
+procedure TWebModule1.pages(count: Integer; var page: Integer);
 var
   max: Integer;
 begin
@@ -406,7 +478,7 @@ begin
   end;
 end;
 
-procedure TTWebModule1.mailHTMLTag(Sender: TObject; Tag: TTag;
+procedure TWebModule1.mailHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 begin
   if TagString = 'pr' then
@@ -419,7 +491,7 @@ begin
     ReplaceText := Request.QueryFields.Values['num'];
 end;
 
-procedure TTWebModule1.searchHTMLTag(Sender: TObject; Tag: TTag;
+procedure TWebModule1.searchHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 var
   s: TStringList;
@@ -499,21 +571,50 @@ begin
     ReplaceText := css2.Content;
 end;
 
-procedure TTWebModule1.tiHTMLTag(Sender: TObject; Tag: TTag;
+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 TTWebModule1.titleHTMLTag(Sender: TObject; Tag: TTag;
+procedure TWebModule1.titleHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 begin
   if TagString = 'pr' then
@@ -521,19 +622,19 @@ 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;
 
-procedure TTWebModule1.topHTMLTag(Sender: TObject; Tag: TTag;
+procedure TWebModule1.topHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 var
   s, t: string;
@@ -544,20 +645,21 @@ begin
   else if TagString = 'list' then
   begin
     i := DataModule1.FDTable3.FieldByName('info').AsInteger;
-    for k := 0 to DataModule1.FDTable3.FieldByName('tcnt').AsInteger do
+    for k := 0 to tcnt do
     begin
       if DataModule1.FDTable1.Eof = true then
         break;
       t := '';
       j := DataModule1.FDTable1.FieldByName('dbnum').AsInteger;
-      if i = j then
+      s := DataModule1.FDTable1.FieldByName('database').AsString;
+      if (i = j) or (s = 'master') then
       begin
         DataModule1.FDTable1.Next;
         continue;
       end;
-      s := DataModule1.FDTable1.FieldByName('database').AsString;
       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
@@ -579,15 +681,14 @@ begin
     ReplaceText := detail(TagString, TagParams.Values['id'])
   else if TagString = 'slide' then
   begin
-    j := DataModule1.FDTable3.FieldByName('tcnt').AsInteger;
-    for i := 1 to (DataModule1.FDTable1.RecordCount div j) + 1 do
+    for i := 1 to (DataModule1.FDTable1.RecordCount div tcnt) + 1 do
       ReplaceText := ReplaceText +
         '<div class="slide"><img src="/src?name=slide' + i.ToString +
         '.jpg" style=float:right;height:465px><#list></div>';
   end;
 end;
 
-procedure TTWebModule1.TWebModule1admdelAction(Sender: TObject;
+procedure TWebModule1.WebModule1admdelAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   i, j, k, m: Integer;
@@ -609,48 +710,46 @@ begin
       DataModule1.FDTable2.Delete;
     end;
   end;
-  TWebModule1adminAction(nil, Request, Response, Handled);
+  WebModule1adminAction(nil, Request, Response, Handled);
 end;
 
-procedure TTWebModule1.TWebModule1adminAction(Sender: TObject;
+procedure TWebModule1.WebModule1adminAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
-  s: string;
+  s, t: string;
   i: Integer;
 begin
-  if hash(Request.CookieFields.Values['user']) <>
-    DataModule1.FDTable3.FieldByName('password').AsString then
+  s := Request.CookieFields.Values['user'];
+  if (s = '') or (loginCheck = false) then
   begin
-    Response.SendRedirect('/login');
+    WebModule1loginAction(nil, Request, Response, Handled);
     Exit;
   end;
   admin.MaxRows := DataModule1.FDTable3.FieldByName('count').AsInteger;
-  s := Request.QueryFields.Values['db'];
-  if s <> '' then
-    DataModule1.FDTable1.Locate('dbnum', s, []);
+  t := Request.QueryFields.Values['db'];
+  if t <> '' then
+    DataModule1.FDTable1.Locate('dbnum', t, []);
   s := Request.QueryFields.Values['num'];
   i := StrToIntDef(s, -1);
   pages(DataModule1.FDTable2.RecordCount, i);
   index.Tag := i;
-  s := '/admin';
-  Self.Tag := Integer(@s);
-  i := footer.HTMLDoc.Add
-    ('<p style=text-align:center><a href="/index?db=<#dbnum>">\96ß\82é</a>');
+  tagstr := '/admin';
+  Self.Tag := Integer(@tagstr);
   admin.header.Text := adhead.Content;
-  if admin.Tag = 0 then
-    admin.footer.Insert(3, footer.Content)
-  else
-  begin
-    admin.footer.Delete(3);
-    admin.footer.Insert(3, footer.Content);
-  end;
+  admin.footer.Clear;
+  admin.footer.Add
+    ('<input type=submit value=\8dí\8f\9c\82·\82é><input type=reset value=\83\8a\83Z\83b\83g></form>');
+  admin.footer.Add(footer.Content);
+  if t <> '' then
+    t := '?db=' + t;
+  admin.footer.Add('<p style=text-align:center><a href="/index' + t +
+    '">\96ß\82é</a>');
   admin.Tag := DataModule1.FDTable2.RecNo;
-  footer.HTMLDoc.Delete(i);
   Response.ContentType := 'text/html;charset=utf-8';
   Response.Content := admin.Content;
 end;
 
-procedure TTWebModule1.TWebModule1adminsetAction(Sender: TObject;
+procedure TWebModule1.WebModule1adminsetAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   s: string;
@@ -661,28 +760,33 @@ begin
     Edit;
     FieldByName('mente').AsBoolean := Request.ContentFields.Values
       ['mente'] = 'on';
-    FieldByName('password').AsString := hash(s);
+    if s <> '' then
+    begin
+      s := hash(s);
+      FieldByName('password').AsString := hash(s);
+      with Response.Cookies.Add do
+      begin
+        Name := 'user';
+        Value := s;
+        Expires := Now + 14;
+        Secure := true;
+      end;
+    end;
     Post;
   end;
-  with Response.Cookies.Add do
-  begin
-    Name := 'user';
-    Value := s;
-    Expires := Now + 14;
-    Secure := true;
-  end;
-  Request.CookieFields.Values['user'] := s;
-  TWebModule1adminAction(nil, Request, Response, Handled);
+  WebModule1adminAction(nil, Request, Response, Handled);
 end;
 
-procedure TTWebModule1.TWebModule1alertAction(Sender: TObject;
+procedure TWebModule1.WebModule1alertAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
-  num1, num2, i, dbnum: Integer;
+  num1, num2, i: Integer;
+  s: string;
 begin
-  dbnum := DataModule1.FDTable1.FieldByName('dbnum').AsInteger;
   num1 := DataModule1.FDTable1.FieldByName('dbnum').AsInteger;
-  num2 := Request.QueryFields.Values['num'].ToInteger;
+  num2 := StrToIntDef(Request.QueryFields.Values['num'], -1);
+  if num2 = -1 then
+    num1 := -1;
   if Request.MethodType = mtGet then
   begin
     DataModule1.FDTable2.Locate('number', num2, []);
@@ -690,18 +794,25 @@ begin
     Response.Content := mail.Content;
   end
   else
+  begin
     with DataModule1.FDTable4 do
     begin
       Last;
       i := FieldByName('id').AsInteger + 1;
-      AppendRecord([i, num1, num2, Now, Request.ContentFields.Values
-        ['request']]);
-      pages(DataModule1.FDTable2.RecNo, i);
-      Response.SendRedirect(Format('/index?db=%d&num=%d#%d', [dbnum, i, num2]));
+      s := Request.ContentFields.Values['request'];
+      if s = '' then
+        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]))
+    else
+      Response.SendRedirect('/top');
+  end;
 end;
 
-procedure TTWebModule1.TWebModule1deleteAction(Sender: TObject;
+procedure TWebModule1.WebModule1deleteAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   num: Integer;
@@ -722,73 +833,89 @@ begin
       FieldByName('raw').AsString := '';
       FieldByName('date').AsDateTime := Now;
       Post;
-      TWebModule1jumpAction(nil, Request, Response, Handled);
+      WebModule1jumpAction(nil, Request, Response, Handled);
     end
     else
-      TWebModule1indexpageAction(nil, Request, Response, Handled);
+      WebModule1indexpageAction(nil, Request, Response, Handled);
 end;
 
-procedure TTWebModule1.TWebModule1fileAction(Sender: TObject;
+procedure TWebModule1.WebModule1fileAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   s: string;
 begin
   s := Request.QueryFields.Values['type'];
   if s = 'js' then
-    Response.ContentType := 'text/javascript;charset=utf-8'
+    Response.ContentType := 'text/javascript'
   else if s = 'css' then
     Response.ContentType := 'text/css';
   Response.Content := detail(s, Request.QueryFields.Values['id']);
 end;
 
-procedure TTWebModule1.TWebModule1helpAction(Sender: TObject;
+procedure TWebModule1.WebModule1helpAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
-  i, j: 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.AppendRecord([i, j, s]);
-  end;
+    DataModule1.FDTable4.Last;
+    k := DataModule1.FDTable4.FieldByName('id').AsInteger + 1;
+    DataModule1.FDTable4.AppendRecord([k, -1, -1, Now, s]);
+    help.Tag := 1;
+  end
+  else
+    help.Tag := 0;
   Response.Content := help.Content;
 end;
 
-procedure TTWebModule1.TWebModule1imgAction(Sender: TObject;
-  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+procedure TWebModule1.WebModule1imgAction(Sender: TObject; Request: TWebRequest;
+  Response: TWebResponse; var Handled: Boolean);
+var
+  s: string;
+  res: TResourceStream;
 begin
   with DataModule1.FDTable5 do
   begin
-    Locate('name', Request.ContentFields.Values['name'], []);
+    s := Request.ContentFields.Values['name'];
     Response.ContentType := 'image/jpeg';
-    Response.ContentStream := CreateBlobStream(FieldByName('source'), bmRead);
+    if Locate('name', s) = true then
+      Response.ContentStream := CreateBlobStream(FieldByName('source'), bmRead)
+    else if s = 'sprites.png' then
+    begin
+      Response.ContentType := 'image/png';
+      res := TResourceStream.Create(HInstance, 'PngImage_1', RT_RCDATA);
+      Response.ContentStream := res;
+    end
+    else
+      Response.ContentStream := nil;
   end;
 end;
 
-procedure TTWebModule1.TWebModule1indexpageAction(Sender: TObject;
+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;
-  s := '/index';
-  Self.Tag := Integer(@s);
+  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"';
   if mente = false then
     Response.Content := index.Content;
 end;
 
-procedure TTWebModule1.TWebModule1jumpAction(Sender: TObject;
+procedure TWebModule1.WebModule1jumpAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   DB, s: string;
@@ -804,7 +931,7 @@ begin
   Response.SendRedirect(Format('/index?db=%s&num=%d#%s', [DB, page, s]));
 end;
 
-procedure TTWebModule1.TWebModule1linkAction(Sender: TObject;
+procedure TWebModule1.WebModule1linkAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   num: Integer;
@@ -821,10 +948,12 @@ begin
   end;
 end;
 
-procedure TTWebModule1.TWebModule1loginAction(Sender: TObject;
+procedure TWebModule1.WebModule1loginAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
+  v: Variant;
   i: Integer;
+  s: string;
 begin
   if Request.MethodType = mtGet then
   begin
@@ -832,35 +961,72 @@ begin
     Response.Content := login.Content;
     Exit;
   end;
-  with Response.Cookies.Add do
+  s := Request.ContentFields.Values['record'];
+  v := DataModule1.FDTable1.Lookup('database', s, 'dbnum');
+  if VarIsNull(v) = false then
   begin
-    Name := 'user';
-    Value := Request.ContentFields.Values['password'];
-    Expires := Now + 14;
-    Secure := true;
+    with Response.Cookies.Add do
+    begin
+      Name := 'user';
+      Value := hash(Request.ContentFields.Values['password']);
+      Expires := Now + 14;
+      // Secure := true;
+    end;
+    i := v;
+    if s = 'master' then
+      Response.SendRedirect('/master')
+    else
+      Response.SendRedirect('/admin?db=' + i.ToString);
+  end
+  else
+  begin
+    Response.ContentType := 'text/html;charset=utf-8';
+    Response.Content := login.Content;
   end;
-  i := DataModule1.FDTable1.Lookup('database',
-    Request.ContentFields.Values['record'], 'dbnum');
-  Response.SendRedirect('/admin?db=' + i.ToString);
 end;
 
-procedure TTWebModule1.TWebModule1logoutAction(Sender: TObject;
+procedure TWebModule1.WebModule1logoutAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+var
+  i: Integer;
+  s: string;
+  x: Boolean;
 begin
   with Response.Cookies.Add do
   begin
     Name := 'user';
     Expires := Now - 1;
   end;
-  TWebModule1indexpageAction(nil, Request, Response, Handled);
+  s := Request.QueryFields.Values['db'];
+  i := StrToIntDef(s, -1);
+  x := DataModule1.FDTable1.Locate('dbnum', i);
+  if (x = true) and (DataModule1.FDTable1.FieldByName('database')
+    .AsString = 'master') then
+    x := false;
+  if x = false then
+    Response.SendRedirect('/')
+  else
+    Response.SendRedirect('/index?db=' + s);
 end;
 
-procedure TTWebModule1.TWebModule1masterAction(Sender: TObject;
+procedure TWebModule1.WebModule1masterAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   s: string;
   i: Integer;
 begin
+  if loginCheck = false then
+  begin
+    with DataModule1.FDTable1 do
+      if Locate('database', 'master') = false then
+      begin
+        Last;
+        i := FieldByName('dbnum').AsInteger + 1;
+        AppendRecord([i, 'master']);
+      end;
+    WebModule1loginAction(nil, Request, Response, Handled);
+    Exit;
+  end;
   if Request.MethodType = mtPost then
   begin
     s := Request.ContentFields.Values['delete'];
@@ -878,12 +1044,12 @@ begin
         begin
           i := DataModule1.FDTable4.FieldByName('posnum').AsInteger;
           if DataModule1.FDTable2.Locate('number', i) = false then
-          begin
-            DataModule1.FDTable4.Delete;
-            continue;
-          end;
-        end;
-        DataModule1.FDTable4.Next;
+            DataModule1.FDTable4.Delete
+          else
+            DataModule1.FDTable4.Next;
+        end
+        else
+          DataModule1.FDTable4.Delete;
       end;
     end;
   end;
@@ -891,13 +1057,12 @@ begin
   Response.Content := master.Content;
 end;
 
-procedure TTWebModule1.TWebModule1registAction(Sender: TObject;
+procedure TWebModule1.WebModule1registAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   number, i: Integer;
   title, na, raw, pass, kotoba, error: string;
   comment: TStringList;
-  x: Boolean;
   function scan(Text: string): string;
   var
     reg: TRegEx;
@@ -922,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'];
@@ -959,56 +1121,51 @@ 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;
   finally
     comment.Free;
   end;
-  TWebModule1indexpageAction(nil, Request, Response, Handled);
+  WebModule1indexpageAction(nil, Request, Response, Handled);
 end;
 
-procedure TTWebModule1.TWebModule1searchAction(Sender: TObject;
+procedure TWebModule1.WebModule1searchAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 begin
   Response.ContentType := 'text/html;charset=utf-8';
   Response.Content := search.Content;
 end;
 
-procedure TTWebModule1.TWebModule1titleAction(Sender: TObject;
+procedure TWebModule1.WebModule1titleAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 begin
   Response.ContentType := 'text/html;charset=utf-8';
   Response.Content := title.Content;
 end;
 
-procedure TTWebModule1.TWebModule1topAction(Sender: TObject;
-  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+procedure TWebModule1.WebModule1topAction(Sender: TObject; Request: TWebRequest;
+  Response: TWebResponse; var Handled: Boolean);
 begin
   Response.ContentType := 'text/html;charset=utf-8';
   DataModule1.FDTable1.First;
@@ -1016,11 +1173,33 @@ begin
     Response.Content := top.ContentFromString(top.Content);
 end;
 
-procedure TTWebModule1.WebModuleCreate(Sender: TObject);
+procedure TWebModule1.WebModuleCreate(Sender: TObject);
 var
   i: Integer;
   a: Variant;
+  s: string;
 begin
+  with DataModule1 do
+  begin
+    if FDTable1.Exists = false then
+      FDTable1.CreateTable;
+    if FDTable2.Exists = false then
+      FDTable2.CreateTable;
+    if FDTable3.Exists = false then
+      FDTable3.CreateTable;
+    if FDTable4.Exists = false then
+      FDTable4.CreateTable;
+    if FDTable5.Exists = false then
+      FDTable5.CreateTable;
+    FDTable1.Open;
+    FDTable2.Open;
+    FDTable3.Open;
+    FDTable4.Open;
+    FDTable5.Open;
+    FDTable1.Refresh;
+    FDTable3.Refresh;
+    FDTable5.Refresh;
+  end;
   if DataModule1.FDTable1.Bof and DataModule1.FDTable1.Eof then
   begin
     DataModule1.FDTable1.AppendRecord([0, 'info']);
@@ -1030,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('admin'), 7]);
+      false, a, 30, hash(hash('admin')), s]);
   end;
 end;
 
About OSDN
Find Software
Develop Software
Help