Data.DB, Web.DBXpressWeb, System.Types;
type
- TTWebModule1 = class(TWebModule)
+ TWebModule1 = class(TWebModule)
articles: TDataSetPageProducer;
index: TDataSetPageProducer;
admin: TDataSetTableProducer;
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);
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);
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;
end;
var
- WebModuleClass: TComponentClass = TTWebModule1;
+ WebModuleClass: TComponentClass = TWebModule1;
implementation
const
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
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);
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;
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
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;
.AsString + '">recent</a>';
end;
-function TTWebModule1.hash(str: string): string;
+function TWebModule1.hash(str: string): string;
begin
with TIdHashSHA1.Create do
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;
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;
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
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;
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;
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
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
result := false;
end;
-procedure TTWebModule1.pages(count: Integer; var page: Integer);
+procedure TWebModule1.pages(count: Integer; var page: Integer);
var
max: Integer;
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
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;
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
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;
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
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;
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;
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, []);
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;
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;
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
- s:= Request.ContentFields.Values['name'];
+ 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
+ Response.ContentType := 'image/png';
+ res := TResourceStream.Create(HInstance, 'PngImage_1', RT_RCDATA);
+ Response.ContentStream := res;
+ end
else
- if s = 'sprites.png' then
- begin
- res:=TResourceStream.Create(HInstance,'PngImage_1',RT_RCDATA);
- try
- Response.ContentStream:=res;
- finally
- res.Free;
- end;
- end
- else
- Response.ContentStream:=nil;
+ 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;
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;
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
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'];
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;
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;
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'];
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;
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 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')]);
+ false, a, 30, hash(hash('admin')), s]);
end;
end;