OnAction = TWebModule1deleteAction
end
item
- MethodType = mtPost
+ MethodType = mtGet
Name = 'jump'
PathInfo = '/jump'
OnAction = TWebModule1jumpAction
+ end
+ item
+ MethodType = mtGet
+ Name = 'link'
+ PathInfo = '/link'
+ OnAction = TWebModule1linkAction
end>
Height = 353
Width = 436
HTMLDoc.Strings = (
' <hr size=1>'
- #9'<section id=number><a name=<#number>></a><a href=/userdel?job=<' +
- '#number> style=text-decoration:none>'
+ #9'<section id=number><a name=<#number>></a><a href=/jump?num=<#nu' +
+ 'mber> style=text-decoration:none>'
#9#9'[<#number>]</a></section>'
#9'<section id=title><#title></section>'
#9'<section id=name>'#12288'Name:<h1><#name></h1></section>'
object admin: TDataSetTableProducer
Columns = <
item
+ Title.Caption = 'check'
+ end
+ item
FieldName = 'NUMBER'
end
item
FieldName = 'DATE'
end>
Footer.Strings = (
- '<p style=text-align:center><a href=/index>'#25147#12427'</a>')
+ '<input type=submit value='#21066#38500#12377#12427'><input type=submit value='#12522#12475#12483#12488'>'
+ '</form>'
+ '<p style=text-align:center><a href=/index?db=<#database>>'#25147#12427'</a>')
Header.Strings = (
- '')
+ '<form action=/admindel>')
DataSet = DataModule1.FDTable2
+ OnFormatCell = adminFormatCell
Left = 176
Top = 32
end
end
object footer: TDataSetPageProducer
HTMLDoc.Strings = (
- '<p style=text-align:center>[ <#link> ] <#recent>')
+ '<p style=text-align:center>[ <#link> ] <#recent>'
+ '')
DataSet = DataModule1.FDTable1
OnHTMLTag = footerHTMLTag
Left = 112
Left = 176
Top = 144
end
- object header: TPageProducer
- HTMLDoc.Strings = (
- ' <header>'
- ' <a name=top></a>'
- ' <form action=/regist?db=<#database> method="post">'
- ' <table>'
- ' <tr><td>'
-
- ' <label><p>'#12362#21517#21069'</p><input name="name" class=name value=<' +
- '#cookie param=name>></label>'
-
- ' <label><p>'#12479#12452#12488#12523'</p><input name="title" class=title valu' +
- 'e=<#cookie param=title> placeholder="'#12479#12452#12488#12523#12394#12375'."></label>'
- ' <input type="submit" value="'#36865#20449'">'
- ' </td></tr>'
- ' <tr><td>'
- ' <label><p>'#26412#25991'<span>'#24517#38920'</span><br></p>'
-
- ' <textarea style="font-size:1.75em" name="comment" co' +
- 'ls=30'
-
- ' required placeholder="'#12467#12513#12531#12488#12394#12393#12434#20837#21147#12375#12390#12367#12384#12373#12356'."><#' +
- 'cookie param=comment></textarea></label>'
- ' </td></tr>'
- ' <tr><td>'
-
- ' <label><p>'#12497#12473#12527#12540#12489'</p><input name="password" type="passwo' +
- 'rd" placeholder="'#21066#38500#29992'">'
-
- ' </label> / <input type="checkbox" name="show" value="t' +
- 'rue" checked><p>'#12503#12524#12499#12517#12540'</p>'
- ' </td></tr>'
- ' <tr><td>'
-
- ' <label><p>'#21512#35328#33865#12434#12402#12425#12364#12394#12391#20837#21147#12375#12390#12367#12384#12373#12356': genki <input name=aikotob' +
- 'a type=text value=<#cookie param=aikotoba>></label>'
- ' </td></tr>'
- ' </table>'
- ' </form>'
- ' </header>')
- Left = 240
- Top = 192
- end
object css1: TPageProducer
HTMLDoc.Strings = (
'<meta http-equiv="Content-Style-Type" content="text/css">'
Left = 360
Top = 240
end
+ object header: TDataSetPageProducer
+ HTMLDoc.Strings = (
+ ' <header>'
+ ' <a name=top></a>'
+ ' <form action=/regist?db=<#database> method="post">'
+ ' <table>'
+ ' <tr><td>'
+
+ ' <label><p>'#12362#21517#21069'</p><input name="name" class=name value=<' +
+ '#cookie param=name>></label>'
+
+ ' <label><p>'#12479#12452#12488#12523'</p><input name="title" class=title plac' +
+ 'eholder="'#12479#12452#12488#12523#12394#12375'."></label>'
+ ' <input type="submit" value="'#36865#20449'">'
+ ' </td></tr>'
+ ' <tr><td>'
+ ' <label><p>'#26412#25991'<span>'#24517#38920'</span><br></p>'
+
+ ' <textarea style="font-size:1.75em" name="comment" co' +
+ 'ls=30'
+
+ ' required placeholder="'#12467#12513#12531#12488#12394#12393#12434#20837#21147#12375#12390#12367#12384#12373#12356'."><#' +
+ 'raw></textarea></label>'
+ ' </td></tr>'
+ ' <tr><td>'
+
+ ' <label><p>'#12497#12473#12527#12540#12489'</p><input name="password" type="passwo' +
+ 'rd" placeholder="'#21066#38500#29992'">'
+
+ ' </label> / <input type="checkbox" name="show" value="t' +
+ 'rue" <#check>><p>'#12503#12524#12499#12517#12540'</p>'
+ ' </td></tr>'
+ ' <tr><td>'
+
+ ' <label><p>'#21512#35328#33865#12434#12402#12425#12364#12394#12391#20837#21147#12375#12390#12367#12384#12373#12356': genki <input name=aikotob' +
+ 'a type=text value=<#cookie param=aikotoba>></label>'
+ ' </td></tr>'
+ ' </table>'
+ ' </form>'
+ ' </header>')
+ DataSet = DataModule1.FDTable1
+ OnHTMLTag = headerHTMLTag
+ Left = 240
+ Top = 192
+ end
end
interface
uses System.SysUtils, System.Classes, Web.HTTPApp, Web.DSProd, Web.HTTPProd,
- Web.DBWeb, System.Variants;
+ Web.DBWeb, System.Variants, System.NetEncoding, System.RegularExpressions;
type
TTWebModule1 = class(TWebModule)
alert: TDataSetPageProducer;
footer: TDataSetPageProducer;
mail: TPageProducer;
- header: TPageProducer;
css1: TPageProducer;
css2: TPageProducer;
css3: TPageProducer;
css4: TPageProducer;
+ header: TDataSetPageProducer;
procedure indexHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
TagParams: TStrings; var ReplaceText: string);
procedure TWebModule1indexpageAction(Sender: TObject; Request: TWebRequest;
Response: TWebResponse; var Handled: Boolean);
procedure TWebModule1jumpAction(Sender: TObject; Request: TWebRequest;
Response: TWebResponse; var Handled: Boolean);
+ procedure TWebModule1linkAction(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);
private
{ private \90é\8c¾ }
ss: TStringList;
- tmpint: integer;
- procedure pages(count: integer; var page: integer);
+ tmpint: Integer;
+ error: string;
+ checkbox: Boolean;
+ procedure pages(count: Integer; var page: Integer);
public
{ public \90é\8c¾ }
end;
{$R *.dfm}
+procedure TTWebModule1.adminFormatCell(Sender: TObject;
+ CellRow, CellColumn: Integer; var BgColor: THTMLBgColor;
+ 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]);
+end;
+
procedure TTWebModule1.alertHTMLTag(Sender: TObject; Tag: TTag;
const TagString: string; TagParams: TStrings; var ReplaceText: string);
var
s: TStringList;
- i: integer;
+ i: Integer;
begin
if TagString = 'article' then
begin
const TagString: string; TagParams: TStrings; var ReplaceText: string);
begin
if TagString = 'database' then
- ReplaceText := Request.QueryFields.Values['db'];
+ ReplaceText := Request.QueryFields.Values['db']
+ else if TagString = 'comment' then
+ ReplaceText := DataModule1.FDTable2.FieldByName('comment').AsString;
end;
procedure TTWebModule1.footerHTMLTag(Sender: TObject; Tag: TTag;
const TagString: string; TagParams: TStrings; var ReplaceText: string);
var
- i: integer;
+ i: Integer;
begin
if TagString = 'link' then
begin
else
ReplaceText := '<a style=text-decoration-line:none href=' +
PString(Self.Tag)^ + '?db=' + Request.QueryFields.Values['db'] +
- '>recent</a>';
+ '>recent</a>'
+ else if TagString = 'pathinfo' then
+ ReplaceText := PString(Self.Tag)^;
+end;
+
+procedure TTWebModule1.headerHTMLTag(Sender: TObject; Tag: TTag;
+ const TagString: string; TagParams: TStrings; var ReplaceText: string);
+var
+ s: string;
+begin
+ if TagString = 'cookie' then
+ begin
+ s := TagParams.Values['param'];
+ ReplaceText := TNetEncoding.URL.Decode(Request.CookieFields.Values[s]);
+ end
+ else if (TagString = 'check') and (checkbox = true) then
+ ReplaceText := 'checked'
+ else if (TagString = 'raw') and (error <> '') then
+ ReplaceText := DataModule1.FDTable2.FieldByName('raw').AsString;
end;
procedure TTWebModule1.indexHTMLTag(Sender: TObject; Tag: TTag;
const TagString: string; TagParams: TStrings; var ReplaceText: string);
var
- i: integer;
+ i: Integer;
x: Boolean;
begin
if TagString = 'article' then
if 10 * i < DataModule1.FDTable2.RecordCount then
ReplaceText := '\82±\82ê\88È\8fã\93\8a\8de\82Å\82«\82Ü\82¹\82ñ.'
else
- ReplaceText := header.Content;
+ ReplaceText := header.Content + error;
end
else if TagString = 'css' then
ReplaceText := css2.Content;
var
s: TStringList;
t, str: string;
- i, j: integer;
+ i, j: Integer;
begin
if TagString = 'item' then
begin
for i := 0 to s.count - 1 do
for j := 0 to ss.count - 1 do
if Pos(ss[j], s[i]) > 0 then
- if Request.ContentFields.Values['type'] = 'OR' then
+ if Self.Tag = 0 then
s[i] := '<p style=background-color:aqua>' + s[i]
else
s[i] := '<p style=background-color:yellow>' + s[i];
procedure TTWebModule1.masterHTMLTag(Sender: TObject; Tag: TTag;
const TagString: string; TagParams: TStrings; var ReplaceText: string);
var
- i, j: integer;
+ i, j: Integer;
s: string;
begin
if TagString = 'request' then
end;
end;
-procedure TTWebModule1.pages(count: integer; var page: integer);
+procedure TTWebModule1.pages(count: Integer; var page: Integer);
var
- max: integer;
+ max: Integer;
begin
max := DataModule1.FDTable3.FieldByName('count').AsInteger;
if (page > -1) and (count < max * (page - 1)) then
s: TStringList;
procedure sub;
var
- i: integer;
- j: integer;
+ i: Integer;
+ j: Integer;
label jump;
begin
DataModule1.FDTable2.First;
while DataModule1.FDTable2.Eof = false do
begin
s.Text := DataModule1.FDTable2.FieldByName('raw').AsString;
- ss.Delimiter := ' ';
- ss.StrictDelimiter := false;
ss.DelimitedText := Request.ContentFields.Values['word1'];
- for i := 0 to s.count - 1 do
- for j := 0 to ss.count - 1 do
+ for j := 0 to ss.count - 1 do
+ for i := 0 to s.count - 1 do
if Pos(ss[j], s[i]) > 0 then
- begin
- ReplaceText := ReplaceText + items.Content;
+ if Self.Tag = 0 then
+ begin
+ ReplaceText := ReplaceText + items.Content;
+ goto jump;
+ end
+ else
+ begin
+ if j = ss.count - 1 then
+ begin
+ ReplaceText := ReplaceText + items.Content;
+ goto jump;
+ end
+ else
+ break;
+ end
+ else if i = s.count - 1 then
goto jump;
- end;
jump:
DataModule1.FDTable2.Next;
end;
begin
if (Request.MethodType = mtPost) and (TagString = 'items') then
begin
+ if Request.ContentFields.Values['type'] = 'OR' then
+ Self.Tag := 0
+ else
+ Self.Tag := 1;
s := TStringList.Create;
ss := TStringList.Create;
try
+ ss.Delimiter := ' ';
+ ss.StrictDelimiter := false;
if Request.QueryFields.Values['db'] = '' then
begin
DataModule1.FDTable1.First;
const TagString: string; TagParams: TStrings; var ReplaceText: string);
var
s, t: string;
- i: integer;
+ i: Integer;
begin
if TagString = 'list' then
begin
DataModule1.FDTable2.Last;
if Now - DataModule1.FDTable2.FieldByName('date').AsDateTime < 1 then
t := 'background-color:aqua;';
- if DataModule1.FDTable2.RecordCount >= 30 then
- t := t + 'font-color:red;';
+ if DataModule1.FDTable2.RecordCount >= 10 *
+ DataModule1.FDTable3.FieldByName('count').AsInteger then
+ t := t + 'color:red;';
if t <> '' then
t := ' style=' + t;
ReplaceText := ReplaceText +
begin
DataModule1.FDTable1.Locate('database', Request.QueryFields.Values['db'], []);
s := '/admin';
- footer.Tag := integer(@s);
+ footer.Tag := Integer(@s);
Response.ContentType := 'text/html;charset=utf-8';
- Response.Content := footer.Content + admin.Content;
+ footer.HTMLDoc.Insert(1,footer.HTMLDoc.Text);
+ admin.footer.Text := footer.ContentFromString
+ (footer.HTMLDoc.Text);
+ Response.Content := admin.Content;
end;
procedure TTWebModule1.TWebModule1alertAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
- num1, num2: integer;
+ num1, num2: Integer;
s: string;
begin
s := Request.QueryFields.Values['db'];
procedure TTWebModule1.TWebModule1deleteAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
- num: integer;
+ num: Integer;
s: string;
begin
s := Request.QueryFields.Values['number'];
procedure TTWebModule1.TWebModule1helpAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
- i, j: integer;
+ i, j: Integer;
s: string;
begin
Response.ContentType := 'text/html;charset=utf-8';
procedure TTWebModule1.TWebModule1indexpageAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
- count, max, int: integer;
+ int: Integer;
s: string;
begin
DataModule1.FDTable1.Locate('database', Request.QueryFields.Values['db'], []);
int := StrToIntDef(Request.QueryFields.Values['num'], -1);
pages(DataModule1.FDTable2.RecordCount, int);
tmpint := int;
- s := (Sender as TWebActionItem).PathInfo;
- Self.Tag := integer(@s);
+ s := '/index';
+ Self.Tag := Integer(@s);
Response.ContentType := 'text/html; charset="utf-8"';
if DataModule1.FDTable3.FieldByName('mente').AsBoolean = true then
Response.Content := '\82½\82¾\82¢\82Ü\83\81\83\93\83e\83i\83\93\83X\92\86\82Å\82·^_^'
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
db, s: string;
- num, page: integer;
+ page: Integer;
begin
db := DataModule1.FDTable1.FieldByName('database').AsString;
- s := Request.ContentFields.Values['number'];
+ s := Request.ContentFields.Values['num'];
if s = '' then
begin
Response.ContentType := 'text/html;charset=utf-8';
Response.Content := '<a href=/index?db=' + db + '>\96ß\82é</a>';
Exit;
- end
- else
- num := s.ToInteger;
+ end;
+ DataModule1.FDTable2.Locate('number', s.ToInteger, []);
page := 10;
- pages(num, page);
- Response.SendRedirect(Format('/index?db=%s&num=%d#%d', [db, page, num]));
+ pages(DataModule1.FDTable2.RecNo, page);
+ Response.SendRedirect(Format('/index?db=%s&num=%d#%s',
+ [TNetEncoding.URL.Encode(db), page, s]));
+end;
+
+procedure TTWebModule1.TWebModule1linkAction(Sender: TObject;
+ Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+var
+ num: Integer;
+ s: string;
+begin
+ s := Request.QueryFields.Values['num'];
+ if s = '' then
+ Exit;
+ num := s.ToInteger;
+ if DataModule1.FDTable2.Locate('number', num, []) = true then
+ begin
+ Response.ContentType := 'text/html;charset=utf-8';
+ Response.Content := articles.Content;
+ end;
end;
procedure TTWebModule1.TWebModule1masterAction(Sender: TObject;
procedure TTWebModule1.TWebModule1registAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
- number: integer;
- title, name, raw, pass: string;
+ number: Integer;
+ title, na, raw, pass, kotoba, db: string;
comment: TStringList;
- i: integer;
+ i: Integer;
+ function scan(Text: string): string;
+ var
+ reg: TRegEx;
+ coll: TMatchCollection;
+ j: Integer;
+ s: string;
+ 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
+ begin
+ Delete(Text, coll[i].index, coll[i].Length);
+ s := Copy(coll[j].Value, Length(s) + 1, coll[j].Length);
+ result := Format
+ ('<a class=minpreview data-preview-url=/link?num=%s href=/jump?num=%s>>>%s</a>',
+ [s, s, s]);
+ Insert(result, Text, coll[j].index);
+ end;
+ result := Text;
+ end;
+
begin
- name := Request.QueryFields.Values['db'];
- DataModule1.FDTable1.Locate('database', name, []);
+ error := '';
+ db := Request.QueryFields.Values['db'];
+ kotoba := Request.ContentFields.Values['aikotoba'];
+ if kotoba <> '\82°\82ñ\82«' then
+ error := '<section style=color:red><p>\8d\87\8c¾\97t\82ª\82¿\82ª\82¢\82Ü\82·.';
+ DataModule1.FDTable1.Locate('database', na, []);
with DataModule1.FDTable2 do
begin
Last;
end;
with Request.ContentFields do
begin
- name := Values['name'];
+ na := Values['name'];
raw := Values['comment'];
pass := Values['password'];
end;
+ with Response.Cookies.Add do
+ begin
+ Name := 'name';
+ Value := na;
+ Expires := Now + 14;
+ end;
+ if error = '' then
+ with Response.Cookies.Add do
+ begin
+ Name := 'aikotoba';
+ Value := kotoba;
+ Expires := Now + 14;
+ end;
comment := TStringList.Create;
try
comment.Text := raw;
for i := 0 to comment.count - 1 do
- comment[i] := '<p>' + comment[i];
- i := DataModule1.FDTable1.FieldByName('dbnum').AsInteger;
- DataModule1.FDTable2.AppendRecord([i, number, title, name, comment.Text,
- raw, Now, pass]);
+ 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;
+ if error <> '' then
+ error := 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;
+ checkbox := false;
+ end
+ else
+ begin
+ i := DataModule1.FDTable1.FieldByName('dbnum').AsInteger;
+ DataModule1.FDTable2.AppendRecord([i, number, title, na, comment.Text,
+ raw, Now, pass]);
+ checkbox := true;
+ end;
finally
comment.Free;
end;
- Response.SendRedirect('/index?db=' + name);
+ TWebModule1indexpageAction(Sender, Request, Response, Handled);
end;
procedure TTWebModule1.TWebModule1searchAction(Sender: TObject;
begin
DataModule1.FDTable1.AppendRecord([0, 'info']);
for i := 1 to 10 do
- DataModule1.FDTable1.AppendRecord([i,'\8cf\8e¦\94Â'+i]);
+ DataModule1.FDTable1.AppendRecord([i, '\8cf\8e¦\94Â' + i.ToString]);
end;
if DataModule1.FDTable3.Bof and DataModule1.FDTable3.Eof then
begin
OSDN Git Service
