interface
uses System.SysUtils, System.Classes, Web.HTTPApp, Web.DSProd, Web.HTTPProd,
- Web.DBWeb, System.Variants;
+ Web.DBWeb, System.Variants, System.NetEncoding, System.RegularExpressions,
+ Data.DB, Web.DBXpressWeb, System.Types;
type
TTWebModule1 = class(TWebModule)
alert: TDataSetPageProducer;
footer: TDataSetPageProducer;
mail: TPageProducer;
- header: TPageProducer;
css1: TPageProducer;
css2: TPageProducer;
css3: TPageProducer;
css4: TPageProducer;
+ header: TDataSetPageProducer;
+ login: TDataSetPageProducer;
+ js1: TPageProducer;
+ js2: TPageProducer;
+ js3: TPageProducer;
+ js4: TPageProducer;
+ adhead: TPageProducer;
+ js5: TPageProducer;
+ title: TPageProducer;
+ ti: TDataSetPageProducer;
procedure indexHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
TagParams: TStrings; var ReplaceText: string);
procedure TWebModule1indexpageAction(Sender: TObject; Request: TWebRequest;
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;
+ 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);
+ procedure TWebModule1admdelAction(Sender: TObject; Request: TWebRequest;
+ Response: TWebResponse; var Handled: Boolean);
+ procedure TWebModule1loginAction(Sender: TObject; Request: TWebRequest;
+ Response: TWebResponse; var Handled: Boolean);
+ procedure TWebModule1adminsetAction(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;
+ Response: TWebResponse; var Handled: Boolean);
+ procedure TWebModule1imgAction(Sender: TObject; Request: TWebRequest;
+ Response: TWebResponse; var Handled: Boolean);
+ procedure TWebModule1fileAction(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;
+ Response: TWebResponse; var Handled: Boolean);
+ procedure tiHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
+ TagParams: TStrings; var ReplaceText: string);
+ procedure helpHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
+ TagParams: TStrings; var ReplaceText: string);
+ procedure loginHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
+ TagParams: TStrings; var ReplaceText: string);
private
{ private \90é\8c¾ }
ss: TStringList;
+ procedure pages(count: Integer; var page: Integer);
+ function hash(str: string): string;
+ function mente: Boolean;
+ function detail(ts, pid: string): string;
public
{ public \90é\8c¾ }
end;
{ %CLASSGROUP 'Vcl.Controls.TControl' }
-uses Unit1;
+uses Unit1, IdHashSHA, IdGlobal, IdHash, IdHashMessageDigest;
{$R *.dfm}
+const
+ promotion = '\8dL\8d\90:';
+ tcnt = 7;
+
+procedure TTWebModule1.adheadHTMLTag(Sender: TObject; Tag: TTag;
+ const TagString: string; TagParams: TStrings; var ReplaceText: string);
+begin
+ if TagString = 'pr' then
+ ReplaceText := promotion
+ else if (TagString = 'mente') and
+ (DataModule1.FDTable3.FieldByName('mente').AsBoolean = true) then
+ ReplaceText := 'checked'
+ else if TagString = 'password' then
+ ReplaceText := Request.CookieFields.Values['user'];
+end;
+
+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
begin
if TagString = 'article' then
begin
+ with DataModule1 do
+ begin
+ FDTable1.Locate('dbnum', FDTable4.FieldByName('dbname').AsInteger);
+ FDTable2.Locate('number', FDTable4.FieldByName('posnum').AsInteger);
+ end;
s := TStringList.Create;
try
s.Text := articles.Content;
- for i := s.Count - 1 downto 0 do
+ for i := 1 to 2 do
+ s.Delete(1);
+ for i := s.count - 1 downto 0 do
if Copy(s[i], 1, 18) = '<section id=master' then
begin
s.Delete(i);
finally
s.Free;
end;
- end;
+ end
+ else if TagString = 'request' then
+ ReplaceText := DataModule1.FDTable4.FieldByName('request').AsString;
end;
procedure TTWebModule1.articlesHTMLTag(Sender: TObject; Tag: TTag;
const TagString: string; TagParams: TStrings; var ReplaceText: string);
begin
- if TagString = 'database' then
- ReplaceText := Request.QueryFields.Values['db'];
+ if TagString = 'comment' then
+ ReplaceText := DataModule1.FDTable2.FieldByName('comment').AsString;
+end;
+
+function TTWebModule1.detail(ts, pid: string): string;
+var
+ i: Integer;
+begin
+ for i := 0 to ComponentCount - 1 do
+ if Components[i].Name = ts + pid then
+ result := (Components[i] as TPageProducer).Content;
end;
procedure TTWebModule1.footerHTMLTag(Sender: TObject; Tag: TTag;
i: Integer;
begin
if TagString = 'link' then
+ begin
for i := 1 to 10 do
- if i = Self.Tag then
+ if i = index.Tag then
ReplaceText := ReplaceText + ' ' + i.ToString + ' '
else
ReplaceText := ReplaceText +
- Format('<a style=text-decoration-line:none href=/index?db=%s&num=%d> %d </a>',
- [Request.QueryFields.Values['db'], i, i])
+ Format(' <a style=text-decoration-line:none href="%s?db=%d&num=%d">%d</a> ',
+ [PString(Self.Tag)^, DataModule1.FDTable1.FieldByName('dbnum')
+ .AsInteger, i, i]);
+ end
else if TagString = 'recent' then
- case Self.Tag of
- - 1:
- ReplaceText := TagString
+ if index.Tag = -1 then
+ ReplaceText := TagString
else
- ReplaceText := '<a style=text-decoration-line:none href=/index?db=' +
- Request.QueryFields.Values['db'] + '>recent</a>';
+ ReplaceText := '<a style=text-decoration-line:none href="' +
+ PString(Self.Tag)^ + '?db=' + DataModule1.FDTable1.FieldByName('dbnum')
+ .AsString + '">recent</a>';
+end;
+
+function TTWebModule1.hash(str: string): string;
+begin
+ with TIdHashSHA1.Create do
+ begin
+ try
+ result := HashStringAsHex(str);
+ finally
+ Free;
end;
+ end;
+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
+ (Request.ContentFields.Values['show'] <> 'false') then
+ ReplaceText := 'checked'
+ else if TagString = 'preview' then
+ ReplaceText := Request.ContentFields.Values['preview']
+ else if TagString = 'raw' then
+ ReplaceText := Request.ContentFields.Values['raw']
+ else if TagString = 'pass' then
+ ReplaceText := Request.ContentFields.Values['password']
+ else if TagString = 'title' then
+ ReplaceText := Request.ContentFields.Values['title'];
+end;
+
+procedure TTWebModule1.helpHTMLTag(Sender: TObject; Tag: TTag;
+ const TagString: string; TagParams: TStrings; var ReplaceText: string);
+begin
+ if TagString = 'pr' then
+ ReplaceText := promotion;
end;
procedure TTWebModule1.indexHTMLTag(Sender: TObject; Tag: TTag;
i: Integer;
x: Boolean;
begin
- if TagString = 'article' then
+ if TagString = 'pr' then
+ ReplaceText := promotion
+ else if TagString = 'article' then
begin
x := DataModule1.FDTable1.FieldByName('dbnum')
.AsInteger = DataModule1.FDTable3.FieldByName('info').AsInteger;
ReplaceText := ReplaceText + articles.Content
else
ReplaceText := articles.Content + ReplaceText;
- DataModule1.FDTable2.Next;
+ if DataModule1.FDTable2.Eof = false then
+ DataModule1.FDTable2.Next;
end;
end
else if TagString = 'footer' then
else if TagString = 'header' then
begin
i := DataModule1.FDTable3.FieldByName('count').AsInteger;
- if 10 * i < DataModule1.FDTable2.RecordCount then
- ReplaceText := '\82±\82ê\88È\8fã\93\8a\8de\82Å\82«\82Ü\82¹\82ñ.'
+ 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' then
- ReplaceText := css2.Content;
+ else if (TagString = 'css') or (TagString = 'js') then
+ ReplaceText := detail(TagString, TagParams.Values['id'])
+ else if TagString = 'dbnum' then
+ ReplaceText := DataModule1.FDTable1.FieldByName('dbnum').AsString
+ else if TagString = 'database' then
+ ReplaceText := DataModule1.FDTable1.FieldByName('database').AsString;
end;
procedure TTWebModule1.itemsHTMLTag(Sender: TObject; Tag: TTag;
s := TStringList.Create;
try
s.Text := DataModule1.FDTable2.FieldByName('raw').AsString;
- for i := 0 to s.Count - 1 do
- for j := 0 to ss.Count - 1 do
+ 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];
j := FieldByName('number').AsInteger;
str := Request.QueryFields.Values['db'];
if str = '' then
- t := Format('<a href=/index?db=%s&num=%d>[ %d-%d ]</a>',
- [str, j, i, j])
+ t := Format('<a href="/jump?db=%d&num=%d">[ %d-%d ]</a>',
+ [DataModule1.FDTable1.FieldByName('dbnum').AsInteger, j, i, j])
else
- t := Format('<a href=/index?db=%s&num=%d>[ %d ]</a>', [str, j, j]);
+ t := Format('<a href="/jump?db=%s&num=%d">[ %d ]</a>', [str, j, j]);
end;
ReplaceText := t + s.Text;
finally
end;
end;
+procedure TTWebModule1.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;
const TagString: string; TagParams: TStrings; var ReplaceText: string);
-var
- i, j: Integer;
- s: string;
begin
- if TagString = 'request' then
+ if TagString = 'pr' then
+ ReplaceText := promotion
+ else if TagString = 'request' then
with DataModule1.FDTable4 do
begin
First;
+ ReplaceText := '<table border=1 align=center>';
while Eof = false do
begin
- i := FieldByName('dbname').AsInteger;
- j := FieldByName('posnum').AsInteger;
- DataModule1.FDTable2.Locate('dbnum;number', VarArrayOf([i, j]), []);
- s := FieldByName('request').AsString;
- ReplaceText := ReplaceText + alert.Content + s;
+ ReplaceText := ReplaceText + alert.Content;
Next;
end;
+ ReplaceText := ReplaceText + '</table>';
end;
end;
+function TTWebModule1.mente: Boolean;
+begin
+ if DataModule1.FDTable3.FieldByName('mente').AsBoolean = true then
+ begin
+ result := true;
+ Response.Content :=
+ '<p><br><h1 style=text-align:center>\82½\82¾\82¢\82Ü\83\81\83\93\83e\83i\83\93\83X\92\86\82Å\82·^_^</h1>' +
+ '<p style=text-align:center><a href=/admin>\8aÇ\97\9d\8eÒ\97p\83\8d\83O\83C\83\93</a>'
+ end
+ else
+ result := false;
+end;
+
+procedure TTWebModule1.pages(count: Integer; var page: Integer);
+var
+ max: Integer;
+begin
+ max := DataModule1.FDTable3.FieldByName('count').AsInteger;
+ if (page > -1) and (count < max * (page - 1)) then
+ begin
+ page := (count div max) + 1;
+ if count mod max = 0 then
+ dec(page);
+ end;
+ case page of
+ - 1:
+ begin
+ DataModule1.FDTable2.Last;
+ DataModule1.FDTable2.MoveBy(1 - max);
+ end;
+ else
+ DataModule1.FDTable2.First;
+ DataModule1.FDTable2.MoveBy(max * (page - 1));
+ end;
+end;
+
procedure TTWebModule1.mailHTMLTag(Sender: TObject; Tag: TTag;
const TagString: string; TagParams: TStrings; var ReplaceText: string);
begin
- if TagString = 'content' then
- ReplaceText := alert.Content
+ if TagString = 'pr' then
+ ReplaceText := promotion
+ else if TagString = 'content' then
+ ReplaceText := articles.Content
else if TagString = 'query' then
- ReplaceText := '?' + Request.Query + '#' +
- Request.QueryFields.Values['num'];
+ ReplaceText := '?' + Request.Query
+ else if TagString = 'number' then
+ ReplaceText := Request.QueryFields.Values['num'];
end;
procedure TTWebModule1.searchHTMLTag(Sender: TObject; Tag: TTag;
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;
end;
begin
- if (Request.MethodType = mtPost) and (TagString = 'items') then
+ if TagString = 'pr' then
+ ReplaceText := promotion
+ else 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;
ReplaceText := Request.Query;
if ReplaceText <> '' then
ReplaceText := '?' + ReplaceText;
- end;
+ end
+ else if TagString = 'css' then
+ ReplaceText := css2.Content;
+end;
+
+procedure TTWebModule1.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
+ else if TagString = 'database' then
+ ReplaceText := DataModule1.FDTable1.Lookup('dbnum',
+ DataModule1.FDQuery1.FieldByName('dbnum').AsInteger, 'database');
+end;
+
+procedure TTWebModule1.titleHTMLTag(Sender: TObject; Tag: TTag;
+ const TagString: string; TagParams: TStrings; var ReplaceText: string);
+begin
+ if TagString = 'pr' then
+ ReplaceText := promotion
+ else if TagString = 'js' then
+ ReplaceText := detail(TagString, TagParams.Values['id'])
+ else if TagString = 'main' then
+ with DataModule1.FDQuery1 do
+ begin
+ Open;
+ while Eof = false do
+ begin
+ ReplaceText := ReplaceText + ti.Content;
+ Next;
+ end;
+ Close;
+ end;
end;
procedure TTWebModule1.topHTMLTag(Sender: TObject; Tag: TTag;
const TagString: string; TagParams: TStrings; var ReplaceText: string);
var
s, t: string;
- i: Integer;
+ i, j, k: Integer;
begin
- if TagString = 'list' then
+ if TagString = 'pr' then
+ ReplaceText := promotion
+ else if TagString = 'list' then
begin
- DataModule1.FDTable1.First;
i := DataModule1.FDTable3.FieldByName('info').AsInteger;
- while DataModule1.FDTable1.Eof = false do
+ for k := 0 to tcnt do
begin
+ if DataModule1.FDTable1.Eof = true then
+ break;
t := '';
- if i = DataModule1.FDTable1.FieldByName('dbnum').AsInteger then
+ j := DataModule1.FDTable1.FieldByName('dbnum').AsInteger;
+ if i = j then
begin
DataModule1.FDTable1.Next;
continue;
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 +
- Format('<p%s><a target=_blank href=%s>%s</a><br></p>',
- [t, '/index?db=' + s, s]);
+ Format('<p><a%s target=_blank href="/index?db=%d">%s</a><br></p>',
+ [t, j, s]);
DataModule1.FDTable1.Next;
end;
end
else if TagString = 'info' then
ReplaceText := DataModule1.FDTable1.Lookup('dbnum',
DataModule1.FDTable3.FieldByName('info').AsInteger, 'database')
- else if TagString = 'css' then
- if TagParams.Values['id'] = '1' then
- ReplaceText := css1.Content
- else if TagParams.Values['id'] = '3' then
- ReplaceText := css3.Content;
+ else if TagString = 'dbnum' then
+ ReplaceText := DataModule1.FDTable3.FieldByName('info').AsString
+ else if (TagString = 'css') or (TagString = 'js') then
+ ReplaceText := detail(TagString, TagParams.Values['id'])
+ else if TagString = 'slide' then
+ begin
+ 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;
+ Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+var
+ i, j, k, m: Integer;
+ reg: TRegEx;
+ match: TMatch;
+begin
+ j := 0;
+ DataModule1.FDTable2.RecNo := admin.Tag;
+ for i := 0 to Request.ContentFields.count - 1 do
+ begin
+ reg := TRegEx.Create('\d+');
+ match := reg.match(Request.ContentFields[i]);
+ if match.Success = true then
+ begin
+ k := match.Value.ToInteger - j - 1;
+ j := match.Value.ToInteger;
+ for m := 1 to k do
+ DataModule1.FDTable2.Next;
+ DataModule1.FDTable2.Delete;
+ end;
+ end;
+ TWebModule1adminAction(nil, Request, Response, Handled);
end;
procedure TTWebModule1.TWebModule1adminAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+var
+ s: string;
+ i: Integer;
begin
- DataModule1.FDTable1.Locate('database', Request.QueryFields.Values['db'], []);
+ if hash(Request.CookieFields.Values['user']) <>
+ DataModule1.FDTable3.FieldByName('password').AsString then
+ begin
+ Response.SendRedirect('/login');
+ Exit;
+ end;
+ admin.MaxRows := DataModule1.FDTable3.FieldByName('count').AsInteger;
+ s := Request.QueryFields.Values['db'];
+ if s <> '' then
+ DataModule1.FDTable1.Locate('dbnum', s, []);
+ 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>');
+ 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);
Response.ContentType := 'text/html;charset=utf-8';
Response.Content := admin.Content;
end;
-procedure TTWebModule1.TWebModule1alertAction(Sender: TObject;
+procedure TTWebModule1.TWebModule1adminsetAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
- num1, num2: Integer;
s: string;
begin
- s := Request.QueryFields.Values['db'];
- num1 := DataModule1.FDTable1.Lookup('database', s, 'dbnum');
+ s := Request.ContentFields.Values['pass'];
+ with DataModule1.FDTable3 do
+ begin
+ Edit;
+ FieldByName('mente').AsBoolean := Request.ContentFields.Values
+ ['mente'] = 'on';
+ FieldByName('password').AsString := hash(s);
+ 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);
+end;
+
+procedure TTWebModule1.TWebModule1alertAction(Sender: TObject;
+ Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+var
+ num1, num2, i, dbnum: Integer;
+begin
+ dbnum := DataModule1.FDTable1.FieldByName('dbnum').AsInteger;
+ num1 := DataModule1.FDTable1.FieldByName('dbnum').AsInteger;
num2 := Request.QueryFields.Values['num'].ToInteger;
if Request.MethodType = mtGet then
begin
Response.Content := mail.Content;
end
else
- begin
- DataModule1.FDTable4.AppendRecord
- ([num1, num2, Now, Request.ContentFields.Values['request']]);
- Response.SendRedirect(Format('/index?db=%s&num=%d#%d', [s, Tag, num2]));
- end;
+ 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]));
+ end;
+end;
+
+procedure TTWebModule1.TWebModule1deleteAction(Sender: TObject;
+ Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+var
+ num: Integer;
+ s: string;
+begin
+ s := Request.ContentFields.Values['num'];
+ if s = '' then
+ Exit;
+ num := s.ToInteger;
+ s := hash(Request.ContentFields.Values['password']);
+ with DataModule1.FDTable2 do
+ if Locate('number;pass', VarArrayOf([num, s])) = true then
+ begin
+ Edit;
+ FieldByName('title').AsString := '';
+ FieldByName('name').AsString := ' - - - ';
+ FieldByName('comment').AsString := '<em>\93\8a\8de\8eÒ\82É\82æ\82è\8dí\8f\9c\82³\82ê\82Ü\82µ\82½.</em>';
+ FieldByName('raw').AsString := '';
+ FieldByName('date').AsDateTime := Now;
+ Post;
+ TWebModule1jumpAction(nil, Request, Response, Handled);
+ end
+ else
+ TWebModule1indexpageAction(nil, Request, Response, Handled);
+end;
+
+procedure TTWebModule1.TWebModule1fileAction(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'
+ else if s = 'css' then
+ Response.ContentType := 'text/css';
+ Response.Content := detail(s, Request.QueryFields.Values['id']);
end;
procedure TTWebModule1.TWebModule1helpAction(Sender: TObject;
Response.Content := help.Content;
end;
-procedure TTWebModule1.TWebModule1indexpageAction(Sender: TObject;
+procedure TTWebModule1.TWebModule1imgAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
- Count, max, int: Integer;
s: string;
+ res: TResourceStream;
begin
- DataModule1.FDTable1.Locate('database', Request.QueryFields.Values['db'], []);
- Count := DataModule1.FDTable2.RecordCount;
- max := DataModule1.FDTable3.FieldByName('count').AsInteger;
- int := StrToIntDef(Request.QueryFields.Values['num'], -1);
- if (int > -1) and (Count < max * (int - 1)) then
- int := (Count div max) + 1;
- case int of
- - 1:
+ with DataModule1.FDTable5 do
+ begin
+ s:= Request.ContentFields.Values['name'];
+ Response.ContentType := 'image/jpeg';
+ if Locate('name', s) = true then
+ Response.ContentStream := CreateBlobStream(FieldByName('source'), bmRead)
+ else
+ if s = 'sprites.png' then
begin
- DataModule1.FDTable2.Last;
- DataModule1.FDTable2.MoveBy(1 - max);
- end;
- else
- DataModule1.FDTable2.First;
- DataModule1.FDTable2.MoveBy(max * (int - 1));
+ res:=TResourceStream.Create(HInstance,'PngImage_1',RT_RCDATA);
+ try
+ Response.ContentStream:=res;
+ finally
+ res.Free;
+ end;
+ end
+ else
+ Response.ContentStream:=nil;
end;
- Tag := int;
+end;
+
+procedure TTWebModule1.TWebModule1indexpageAction(Sender: TObject;
+ Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+var
+ int: 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);
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·^_^'
- else
+ if mente = false then
Response.Content := index.Content;
end;
+procedure TTWebModule1.TWebModule1jumpAction(Sender: TObject;
+ Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+var
+ DB, s: string;
+ page: 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]));
+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.TWebModule1loginAction(Sender: TObject;
+ Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+var
+ i: Integer;
+begin
+ if Request.MethodType = mtGet then
+ begin
+ Response.ContentType := 'text/html;charset=utf-8';
+ Response.Content := login.Content;
+ Exit;
+ end;
+ with Response.Cookies.Add do
+ 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);
+end;
+
+procedure TTWebModule1.TWebModule1logoutAction(Sender: TObject;
+ Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+begin
+ with Response.Cookies.Add do
+ begin
+ Name := 'user';
+ Expires := Now - 1;
+ end;
+ TWebModule1indexpageAction(nil, Request, Response, Handled);
+end;
+
procedure TTWebModule1.TWebModule1masterAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+var
+ s: string;
+ i: Integer;
begin
+ 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
+ Delete
+ else
+ begin
+ DataModule1.FDTable4.First;
+ while DataModule1.FDTable4.Eof = false do
+ begin
+ i := DataModule1.FDTable4.FieldByName('dbname').AsInteger;
+ if DataModule1.FDTable1.Locate('dbnum', i) = true then
+ 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;
+ end;
+ end;
+ end;
Response.ContentType := 'text/html;charset=utf-8';
Response.Content := master.Content;
end;
procedure TTWebModule1.TWebModule1registAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
- number: Integer;
- title, name, raw: string;
+ number, i: Integer;
+ title, na, raw, pass, kotoba, error: string;
comment: TStringList;
- i: Integer;
+ x: Boolean;
+ function scan(Text: string): string;
+ var
+ reg: TRegEx;
+ coll: TMatchCollection;
+ j: Integer;
+ s, t: 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[j].index, coll[j].Length);
+ t := 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>',
+ [t, t, t]);
+ Insert(result, Text, coll[j].index);
+ end;
+ result := Text;
+ end;
+
begin
- name := Request.QueryFields.Values['db'];
- DataModule1.FDTable1.Locate('database', name, []);
+ error := '';
+ 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·.';
with DataModule1.FDTable2 do
begin
Last;
end;
with Request.ContentFields do
begin
- name := Values['name'];
+ title := Values['title'];
+ na := Values['name'];
raw := Values['comment'];
+ pass := hash(Values['password']);
end;
+ if title = '' then
+ title := '\83^\83C\83g\83\8b\82È\82µ.';
+ with Response.Cookies.Add do
+ begin
+ Name := 'name';
+ if na = '' then
+ Value := '\92N\82©\82³\82ñ.'
+ else
+ 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]);
+ 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';
+ if error <> '' then
+ error := error + '</section>'
+ else if x = 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;
+ end
+ 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;
+ end;
finally
comment.Free;
end;
- Response.SendRedirect('/index?db=' + name);
+ TWebModule1indexpageAction(nil, Request, Response, Handled);
end;
procedure TTWebModule1.TWebModule1searchAction(Sender: TObject;
Response.Content := search.Content;
end;
+procedure TTWebModule1.TWebModule1titleAction(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);
begin
Response.ContentType := 'text/html;charset=utf-8';
- Response.Content := top.Content;
+ DataModule1.FDTable1.First;
+ if mente = false then
+ Response.Content := top.ContentFromString(top.Content);
end;
procedure TTWebModule1.WebModuleCreate(Sender: TObject);
var
+ i: Integer;
a: Variant;
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']);
+ for i := 1 to 10 do
+ DataModule1.FDTable1.AppendRecord([i, '\8cf\8e¦\94Â' + i.ToString]);
+ end;
if DataModule1.FDTable3.Bof and DataModule1.FDTable3.Eof then
begin
a := DataModule1.FDTable1.Lookup('database', 'info', 'dbnum');
DataModule1.FDTable3.AppendRecord
- (['\82Æ\82é\82Ë\81`\82Ç\8d\86', '<p style=font-color:gray>\82Æ\82é\82Ë\81`\82Ç\8d\86</p>', false, a, 30]);
+ (['\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')]);
end;
end;