<#list>' + CellData + '
'; + 3: + CellData := '' + CellData + '
'; + end; 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 := '&num=<#posnum>>[ <#dbname>-<#posnum> ]' + else if TagString = 'article' then begin - with DataModule1 do + if alert.Tag = 1 then begin - FDTable1.Locate('dbnum', FDTable4.FieldByName('dbname').AsInteger); - FDTable2.Locate('number', FDTable4.FieldByName('posnum').AsInteger); + ReplaceText := 'NGXg'; + Exit; end; s := TStringList.Create; try - s.Text := articles.Content; + s.text := articles.Content; for i := 1 to 2 do s.Delete(1); for i := s.count - 1 downto 0 do @@ -174,23 +236,30 @@ begin s.Delete(i); break; end; - ReplaceText := s.Text; + ReplaceText := s.text; finally s.Free; end; - end - else if TagString = 'request' then - ReplaceText := DataModule1.FDTable4.FieldByName('request').AsString; + end; 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; + if TagString = 'uri' then + ReplaceText := Request.ScriptName + else if TagString = 'comment' then + ReplaceText := FDTable2.FieldByName('comment').AsString; end; -function TTWebModule1.detail(ts, pid: string): string; +procedure TWebModule1.css1HTMLTag(Sender: TObject; Tag: TTag; + const TagString: string; TagParams: TStrings; var ReplaceText: string); +begin + if TagString = 'uri' then + ReplaceText := Request.ScriptName; +end; + +function TWebModule1.detail(ts, pid: string): string; var i: Integer; begin @@ -199,7 +268,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; @@ -212,19 +281,19 @@ begin else ReplaceText := ReplaceText + Format(' %d ', - [PString(Self.Tag)^, DataModule1.FDTable1.FieldByName('dbnum') - .AsInteger, i, i]); + [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 := 'recent'; + Request.ScriptName + PString(Self.Tag)^ + '?db=' + + FDTable1.FieldByName('dbnum').AsString + '">recent'; end; -function TTWebModule1.hash(str: string): string; +function TWebModule1.hash(str: string): string; begin with TIdHashSHA1.Create do begin @@ -236,12 +305,14 @@ 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; begin - if TagString = 'cookie' then + if TagString = 'uri' then + ReplaceText := Request.ScriptName + else if TagString = 'cookie' then begin s := TagParams.Values['param']; ReplaceText := TNetEncoding.URL.Decode(Request.CookieFields.Values[s]); @@ -259,56 +330,85 @@ 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 = 'uri' then + ReplaceText := Request.ScriptName + else if TagString = 'area' then + if help.Tag = 0 then + begin + ss := TStringList.Create; + try + ss.Add('
'); + ReplaceText := ss.text; + finally + ss.Free; + end; + end + else + ReplaceText := + '²ñ èªÆ¤²´¢Ü·.'; 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; - x: Boolean; begin if TagString = 'pr' then ReplaceText := promotion + else if TagString = 'uri' then + ReplaceText := Request.ScriptName else if TagString = 'article' then begin - x := DataModule1.FDTable1.FieldByName('dbnum') - .AsInteger = DataModule1.FDTable3.FieldByName('info').AsInteger; - for i := 1 to DataModule1.FDTable3.FieldByName('count').AsInteger do + for i := 1 to FDTable3.FieldByName('count').AsInteger do begin - if DataModule1.FDTable2.Eof = true then + if FDTable2.Eof = true then break; - if x = false then + if isInfo = false then ReplaceText := ReplaceText + articles.Content else ReplaceText := articles.Content + ReplaceText; - if DataModule1.FDTable2.Eof = false then - DataModule1.FDTable2.Next; + FDTable2.Next; end; end 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 := '
' + s[i] else s[i] := '
' + s[i]; - with DataModule1.FDTable2 do + with FDTable2 do begin i := FieldByName('dbnum').AsInteger; j := FieldByName('number').AsInteger; str := Request.QueryFields.Values['db']; if str = '' then - t := Format('[ %d-%d ]', - [DataModule1.FDTable1.FieldByName('dbnum').AsInteger, j, i, j]) + t := Format('[ %d-%d ]', + [Request.ScriptName, i, j, i, j]) else - t := Format('[ %d ]', [str, j, j]); + t := Format('[ %d ]', + [Request.ScriptName, str, j, j]); end; - ReplaceText := t + s.Text; + ReplaceText := t + s.text; finally s.Free; end; end; end; -procedure TTWebModule1.loginHTMLTag(Sender: TObject; Tag: TTag; +function TWebModule1.loginCheck: Boolean; +begin + result := hash(Request.CookieFields.Values['user']) = FDTable3.FieldByName + ('password').AsString; +end; + +procedure TWebModule1.loginHTMLTag(Sender: TObject; Tag: TTag; const TagString: string; TagParams: TStrings; var ReplaceText: string); +var + i: Integer; begin if TagString = 'pr' then - ReplaceText := promotion; + ReplaceText := promotion + else if TagString = 'uri' then + ReplaceText := Request.ScriptName + else if TagString = 'database' then + begin + i := StrToIntDef(Request.QueryFields.Values['db'], + FDTable3.FieldByName('info').AsInteger); + if FDTable1.Locate('dbnum', i) = true then + ReplaceText := FDTable1.FieldByName('database').AsString; + end; end; -procedure TTWebModule1.masterHTMLTag(Sender: TObject; Tag: TTag; +procedure TWebModule1.masterHTMLTag(Sender: TObject; Tag: TTag; const TagString: string; TagParams: TStrings; var ReplaceText: string); +var + i, j: Integer; begin if TagString = 'pr' then ReplaceText := promotion + else if TagString = 'uri' then + ReplaceText := Request.ScriptName else if TagString = 'request' then - with DataModule1.FDTable4 do + begin + FDTable1.Close; + with FDTable4 do begin First; - ReplaceText := '
ÇÒpOC' + Format('
ÇÒpOC', + [Request.ScriptName, s]); end else result := false; end; -procedure TTWebModule1.pages(count: Integer; var page: Integer); +procedure TWebModule1.pages(count: Integer; var page: Integer); var max: Integer; begin - max := DataModule1.FDTable3.FieldByName('count').AsInteger; + max := FDTable3.FieldByName('count').AsInteger; if (page > -1) and (count < max * (page - 1)) then begin page := (count div max) + 1; @@ -398,20 +538,22 @@ begin case page of - 1: begin - DataModule1.FDTable2.Last; - DataModule1.FDTable2.MoveBy(1 - max); + FDTable2.Last; + FDTable2.MoveBy(1 - max); end; else - DataModule1.FDTable2.First; - DataModule1.FDTable2.MoveBy(max * (page - 1)); + FDTable2.First; + FDTable2.MoveBy(max * (page - 1)); 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 ReplaceText := promotion + else if TagString = 'uri' then + ReplaceText := Request.ScriptName else if TagString = 'content' then ReplaceText := articles.Content else if TagString = 'query' then @@ -420,20 +562,46 @@ begin ReplaceText := Request.QueryFields.Values['num']; end; -procedure TTWebModule1.searchHTMLTag(Sender: TObject; Tag: TTag; +function TWebModule1.scan(text: string): string; +var + reg: TRegEx; + coll: TMatchCollection; + i, j: Integer; + s, t, str: string; +begin + i := Request.QueryFields.Values['db'].ToInteger; + s := Request.ScriptName; + text := TNetEncoding.HTML.Encode(text); + str := TNetEncoding.HTML.Encode('>>'); + reg := TRegEx.Create(str + '(\d+)'); + coll := reg.Matches(text); + for j := coll.count - 1 downto 0 do + begin + Delete(text, coll[j].index, coll[j].Length); + t := Copy(coll[j].Value, Length(str) + 1, coll[j].Length); + result := Format + ('>>%s', + [s, i, t, s, i, t, t]); + Insert(result, text, coll[j].index); + end; + result := text; +end; + +procedure TWebModule1.searchHTMLTag(Sender: TObject; Tag: TTag; const TagString: string; TagParams: TStrings; var ReplaceText: string); var s: TStringList; + str: string; procedure sub; var i: Integer; j: Integer; label jump; begin - DataModule1.FDTable2.First; - while DataModule1.FDTable2.Eof = false do + FDTable2.First; + while FDTable2.Eof = false do begin - s.Text := DataModule1.FDTable2.FieldByName('raw').AsString; + s.text := FDTable2.FieldByName('raw').AsString; ss.DelimitedText := Request.ContentFields.Values['word1']; for j := 0 to ss.count - 1 do for i := 0 to s.count - 1 do @@ -456,13 +624,23 @@ var else if i = s.count - 1 then goto jump; jump: - DataModule1.FDTable2.Next; + FDTable2.Next; end; end; begin if TagString = 'pr' then ReplaceText := promotion + else if TagString = 'uri' then + ReplaceText := Request.ScriptName + else if TagString = 'select' then + begin + str := Request.QueryFields.Values['db']; + if str = '' then + ReplaceText := Request.ScriptName + '/' + else + ReplaceText := Request.ScriptName + '/index?db=' + str; + end else if (Request.MethodType = mtPost) and (TagString = 'items') then begin if Request.ContentFields.Values['type'] = 'OR' then @@ -476,11 +654,11 @@ begin ss.StrictDelimiter := false; if Request.QueryFields.Values['db'] = '' then begin - DataModule1.FDTable1.First; - while DataModule1.FDTable1.Eof = false do + FDTable1.First; + while FDTable1.Eof = false do begin sub; - DataModule1.FDTable1.Next; + FDTable1.Next; end; end else @@ -497,44 +675,78 @@ begin ReplaceText := '?' + ReplaceText; end else if TagString = 'css' then - ReplaceText := css2.Content; + ReplaceText := css2.Content + else if TagString = 'dbnum' then + ReplaceText := Request.QueryFields.Values['dbnum']; +end; + +procedure TWebModule1.setLastArticle; +begin + FDTable2.Last; end; -procedure TTWebModule1.tiHTMLTag(Sender: TObject; Tag: TTag; +procedure TWebModule1.strsCheck(var Error: string; list: TStringList); +var + s: TStringList; + i, j: Integer; + x: Boolean; +begin + x := false; + s := TStringList.Create; + try + s.DelimitedText := FDTable3.FieldByName('ng').AsString; + for i := 0 to s.count - 1 do + for j := 0 to list.count - 1 do + if Pos(s[i], list[j]) > 0 then + begin + x := true; + break; + end; + for i := 0 to list.count - 1 do + list[i] := '
' + scan(list[i]); + finally + s.Free; + end; + if x = true then + Error := Error + '
Ö~êåªÜÜêĢܷ.'; +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 + if TagString = 'uri' then + ReplaceText := Request.ScriptName + else if TagString = 'count' then + ReplaceText := FDTable2.RecordCount.ToString else if TagString = 'database' then - ReplaceText := DataModule1.FDTable1.Lookup('dbnum', - DataModule1.FDQuery1.FieldByName('dbnum').AsInteger, 'database'); + ReplaceText := FDTable1.FieldByName('database').AsString + else if TagString = 'date' then + ReplaceText := FDQuery1.FieldByName('max(date)').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 ReplaceText := promotion + else if TagString = 'uri' then + ReplaceText := Request.ScriptName else if TagString = 'js' then ReplaceText := detail(TagString, TagParams.Values['id']) else if TagString = 'main' then - with DataModule1.FDQuery1 do + begin + FDQuery1.Open; + while FDQuery1.Eof = false do begin - Open; - while Eof = false do - begin - ReplaceText := ReplaceText + ti.Content; - Next; - end; - Close; + FDTable1.Locate('dbnum', FDQuery1.FieldByName('dbnum').AsInteger); + ReplaceText := ReplaceText + ti.Content; + FDQuery1.Next; end; + FDQuery1.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; @@ -542,52 +754,73 @@ var begin if TagString = 'pr' then ReplaceText := promotion + else if TagString = 'uri' then + ReplaceText := Request.ScriptName else if TagString = 'list' then begin - i := DataModule1.FDTable3.FieldByName('info').AsInteger; + i := FDTable3.FieldByName('info').AsInteger; for k := 0 to tcnt do begin - if DataModule1.FDTable1.Eof = true then + if FDTable1.Eof = true then break; t := ''; - j := DataModule1.FDTable1.FieldByName('dbnum').AsInteger; - if i = j then + j := FDTable1.FieldByName('dbnum').AsInteger; + s := FDTable1.FieldByName('database').AsString; + if (i = j) or (s = 'master') then begin - DataModule1.FDTable1.Next; + FDTable1.Next; continue; end; - s := DataModule1.FDTable1.FieldByName('database').AsString; - DataModule1.FDTable2.Last; - if Now - DataModule1.FDTable2.FieldByName('date').AsDateTime < 1 then + FDTable2.Last; + if (Now - FDTable2.FieldByName('date').AsDateTime < 1) and + (FDTable2.RecordCount > 0) then t := 'background-color:aqua;'; - if DataModule1.FDTable2.RecordCount >= 10 * - DataModule1.FDTable3.FieldByName('count').AsInteger then + if FDTable2.RecordCount >= 10 * FDTable3.FieldByName('count').AsInteger + then t := t + 'color:red;'; if t <> '' then t := ' style=' + t; ReplaceText := ReplaceText + - Format('
<#list>
<#list>ßé'); - 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.Tag := DataModule1.FDTable2.RecNo; - footer.HTMLDoc.Delete(i); + tagstr := '/admin'; + Self.Tag := Integer(@tagstr); + admin.header.text := adhead.Content; + admin.footer.Clear; + admin.footer.Add + (''); + admin.footer.Add(footer.Content); + if t <> '' then + t := '?db=' + t; + admin.footer.Add + (Format('
ßé', + [Request.ScriptName, t])); 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; + i: Integer; begin s := Request.ContentFields.Values['pass']; - with DataModule1.FDTable3 do + with FDTable3 do begin Edit; - FieldByName('mente').AsBoolean := Request.ContentFields.Values - ['mente'] = 'on'; - FieldByName('password').AsString := hash(s); + if Request.ContentFields.Values['mente'] = 'on' then + i := 1 + else + i := 0; + FieldByName('mente').AsInteger := i; + if (s <> '') and (s = Request.ContentFields.Values['pass2']) 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; + num1 := Request.QueryFields.Values['db'].ToInteger; + num2 := StrToIntDef(Request.QueryFields.Values['num'], -1); + if num2 = -1 then + Exit; if Request.MethodType = mtGet then begin - DataModule1.FDTable2.Locate('number', num2, []); + FDTable1.Locate('dbnum', num1); + FDTable2.Locate('number', num2); Response.ContentType := 'text/html;charset=utf-8'; Response.Content := mail.Content; end else - with DataModule1.FDTable4 do + begin + with 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; + WebModule1jumpAction(nil, Request, Response, Handled); + end; end; -procedure TTWebModule1.TWebModule1deleteAction(Sender: TObject; +procedure TWebModule1.WebModule1deleteAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); var num: Integer; @@ -712,7 +956,7 @@ begin Exit; num := s.ToInteger; s := hash(Request.ContentFields.Values['password']); - with DataModule1.FDTable2 do + with FDTable2 do if Locate('number;pass', VarArrayOf([num, s])) = true then begin Edit; @@ -722,109 +966,128 @@ 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; + FDTable4.Last; + k := FDTable4.FieldByName('id').AsInteger + 1; + 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; + p: TBytes; + res: TMemoryStream; begin - with DataModule1.FDTable5 do - if Locate('name', Request.ContentFields.Values['name']) = true then + with FDTable5 do + begin + s := Request.QueryFields.Values['name']; + Response.ContentType := 'image/jpeg'; + if Locate('name', s) = true then begin - Response.ContentType := 'image/jpeg'; - Response.ContentStream := CreateBlobStream(FieldByName('source'), bmRead); - end; + s := FieldByName('source').AsString; + p := TNetEncoding.Base64.DecodeStringToBytes(s); + res := TMemoryStream.Create; + res.WriteBuffer(p, Length(p)); + 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 + Response.ContentType := 'text/html; charset="utf-8"'; + if mente = true then + Exit; 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); - Response.ContentType := 'text/html; charset="utf-8"'; - if mente = false then - Response.Content := index.Content; + FDTable1.Locate('dbnum', s, []); + i := StrToIntDef(Request.QueryFields.Values['num'], -1); + isInfo; + pages(FDTable2.RecordCount, i); + index.Tag := i; + tagstr := '/index'; + Self.Tag := Integer(@tagstr); + 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; - page: Integer; + i: Integer; begin DB := Request.QueryFields.Values['db']; - s := Request.ContentFields.Values['num']; - if DB <> '' then - DataModule1.FDTable1.Locate('dbnum', DB.ToInteger, []); - DataModule1.FDTable2.Locate('number', s.ToInteger, []); - page := 10; - pages(DataModule1.FDTable2.RecNo, page); - Response.SendRedirect(Format('/index?db=%s&num=%d#%s', [DB, page, s])); + 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, + DB, i, s])); end; -procedure TTWebModule1.TWebModule1linkAction(Sender: TObject; +procedure TWebModule1.WebModule1linkAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); var - num: Integer; s: string; begin - s := Request.QueryFields.Values['num']; - if s = '' then + s := Request.QueryFields.Values['db']; + if (s = '') or (FDTable1.Locate('dbnum', s.ToInteger) = false) then Exit; - num := s.ToInteger; - if DataModule1.FDTable2.Locate('number', num, []) = true then + s := Request.QueryFields.Values['num']; + if (s <> '') and (FDTable2.Locate('number', s.ToInteger) = true) then begin Response.ContentType := 'text/html;charset=utf-8'; Response.Content := articles.Content; 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, t: string; begin if Request.MethodType = mtGet then begin @@ -832,230 +1095,263 @@ begin Response.Content := login.Content; Exit; end; - with Response.Cookies.Add do + 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 begin - Name := 'user'; - Value := Request.ContentFields.Values['password']; - Expires := Now + 14; - Secure := true; - end; - i := DataModule1.FDTable1.Lookup('database', - Request.ContentFields.Values['record'], 'dbnum'); - Response.SendRedirect('/admin?db=' + i.ToString); + with Response.Cookies.Add do + begin + Name := 'user'; + Value := t; + Expires := Now + 14; + // Secure := true; + end; + i := v; + if s = 'master' then + Response.SendRedirect(Request.ScriptName + '/master') + else + Response.SendRedirect(Request.ScriptName + '/admin?db=' + i.ToString); + end + else if VarIsNull(v) = false then + begin + t := v; + Response.SendRedirect(Request.ScriptName + '/login?db=' + t); + end + else + Response.SendRedirect(Request.ScriptName + '/login'); 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 := FDTable1.Locate('dbnum', i); + if (x = true) and (FDTable1.FieldByName('database').AsString = 'master') then + x := false; + if x = false then + Response.SendRedirect(Request.ScriptName + '/') + else + Response.SendRedirect(Request.ScriptName + '/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 + Request.QueryFields.Values['db'] := FDTable1.Lookup('database', + 'master', 'dbnum'); + WebModule1loginAction(nil, Request, Response, Handled); + Exit; + end; if Request.MethodType = mtPost then begin s := Request.ContentFields.Values['delete']; - if s = 'all' then - with DataModule1.FDTable4 do - while (Bof = false) or (Eof = false) do + with FDTable4 do + if s = 'all' then + while not((Bof = true) and (Eof = true)) do Delete - else - begin - DataModule1.FDTable4.First; - while DataModule1.FDTable4.Eof = false do + else begin - i := DataModule1.FDTable4.FieldByName('dbname').AsInteger; - if DataModule1.FDTable1.Locate('dbnum', i) = true then + First; + while Eof = false do begin - i := DataModule1.FDTable4.FieldByName('posnum').AsInteger; - if DataModule1.FDTable2.Locate('number', i) = false then + i := FieldByName('dbname').AsInteger; + if FDTable1.Locate('dbnum', i) = true then begin - DataModule1.FDTable4.Delete; - continue; - end; + i := FieldByName('posnum').AsInteger; + if FDTable2.Locate('number', i) = false then + Delete + else + Next; + end + else + Delete; end; - DataModule1.FDTable4.Next; end; - end; end; + FDTable4.First; Response.ContentType := 'text/html;charset=utf-8'; 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; + title, na, raw, pass, kotoba, Error, temp: string; comment: TStringList; - x: Boolean; - function scan(Text: string): string; - var - reg: TRegEx; - coll: TMatchCollection; - j: Integer; - s, t: string; + review: Boolean; +begin + Error := ''; + temp := Request.ContentFields.Values['preview']; + if temp = '' then begin - Text := TNetEncoding.HTML.Encode(Text); - s := TNetEncoding.HTML.Encode('>>'); - reg := TRegEx.Create(s + '(\d+)'); - coll := reg.Matches(Text); - for j := coll.count - 1 downto 0 do + kotoba := Request.ContentFields.Values['aikotoba']; + if kotoba <> '°ñ«' then + Error := Error + '
¾tª¿ª¢Ü·.';
+ with Request.ContentFields do
begin
- Delete(Text, coll[j].index, coll[j].Length);
- t := Copy(coll[j].Value, Length(s) + 1, coll[j].Length);
- result := Format
- ('>>%s',
- [t, t, t]);
- Insert(result, Text, coll[j].index);
+ title := Values['title'];
+ na := Values['name'];
+ raw := Values['comment'];
+ Values['comment'] := '';
+ pass := hash(Values['password']);
end;
- result := Text;
- end;
-
-begin
- error := '';
- kotoba := Request.ContentFields.Values['aikotoba'];
- if kotoba <> '°ñ«' then
- error := ' ¾tª¿ª¢Ü·.';
- with DataModule1.FDTable2 do
- begin
- Last;
- number := FieldByName('number').AsInteger + 1;
- end;
- with Request.ContentFields do
- begin
- title := Values['title'];
- na := Values['name'];
- raw := Values['comment'];
- pass := hash(Values['password']);
- end;
- if title = '' then
- title := '^Cgȵ.';
- with Response.Cookies.Add do
- begin
- Name := 'name';
- if na = '' then
- Value := 'N©³ñ.'
- else
- Value := na;
- Expires := Now + 14;
- end;
- if error = '' then
+ if title = '' then
+ title := '^Cgȵ.';
with Response.Cookies.Add do
begin
- Name := 'aikotoba';
- Value := kotoba;
+ Name := 'name';
+ if na = '' then
+ Value := 'N©³ñ.'
+ else
+ Value := na;
Expires := Now + 14;
end;
- comment := TStringList.Create;
- try
- comment.Text := raw;
- for i := 0 to comment.count - 1 do
- begin
- if Pos('ng', comment[i]) > 0 then
+ if Error = '' then
+ with Response.Cookies.Add do
begin
- error := error + ' Ö~êåªÜÜêĢܷ.';
- break;
+ Name := 'aikotoba';
+ Value := kotoba;
+ Expires := Now + 14;
end;
- comment[i] := ' ' + scan(comment[i]);
+ comment := TStringList.Create;
+ try
+ comment.text := raw;
+ strsCheck(Error, comment);
+ temp := comment.text;
+ finally
+ comment.Free;
end;
- x := Request.ContentFields.Values['show'] = 'true';
- if error <> '' then
- error := error + '
««vr [««
' +
- comment.Text;
- Request.ContentFields.Values['show'] := 'false';
- Request.ContentFields.Values['preview'] := error;
- Request.ContentFields.Values['raw'] := raw;
- end
+ review := false;
+ end
+ else
+ review := true;
+ Request.ContentFields.Values['raw'] := raw;
+ if Error <> '' then
+ Request.ContentFields.Values['preview'] := '
««vr [««
' + temp + else + Error := temp; + Request.ContentFields.Values['preview'] := Error; + Request.ContentFields.Values['show'] := 'false'; + end + else + begin + i := StrToIntDef(Request.QueryFields.Values['db'], -1); + if FDTable1.Locate('dbnum', i) = false then + Response.SendRedirect(Request.ScriptName + '/') else begin - i := DataModule1.FDTable1.FieldByName('dbnum').AsInteger; - DataModule1.FDTable2.AppendRecord([i, number, title, na, comment.Text, - raw, Now, pass]); - Response.SendRedirect('index?db=' + i.ToString + '#article'); - Exit; + 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 + + '#article'); end; - finally - comment.Free; + Exit; 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; + FDTable1.First; if mente = false then Response.Content := top.ContentFromString(top.Content); end; -procedure TTWebModule1.WebModuleCreate(Sender: TObject); +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; - 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 + 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; + FDTable4.Refresh; + FDTable5.Refresh; + if (FDTable1.Bof = true) and (FDTable1.Eof = true) then begin - DataModule1.FDTable1.AppendRecord([0, 'info']); + FDTable1.AppendRecord([0, 'info']); + FDTable1.AppendRecord([1, 'master']); for i := 1 to 10 do - DataModule1.FDTable1.AppendRecord([i, 'f¦Â' + i.ToString]); + FDTable1.AppendRecord([i + 1, 'f¦Â' + i.ToString]); end; - if DataModule1.FDTable3.Bof and DataModule1.FDTable3.Eof then + if (FDTable3.Bof = true) and (FDTable3.Eof = true) then begin - a := DataModule1.FDTable1.Lookup('database', 'info', 'dbnum'); - DataModule1.FDTable3.AppendRecord + i := FDTable1.Lookup('database', 'info', 'dbnum'); + s := '¢Û,n,Ë'; + FDTable3.AppendRecord (['ÆéË`Ç', '