interface
uses System.SysUtils, System.Classes, Web.HTTPApp, Web.DSProd, Web.HTTPProd,
- Web.DBWeb, System.Variants, System.NetEncoding, System.RegularExpressions;
+ Web.DBWeb, System.Variants, System.NetEncoding, System.RegularExpressions,
+ Data.DB, Web.DBXpressWeb, System.Types, FireDAC.Stan.Intf,
+ FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS,
+ FireDAC.Phys.Intf, FireDAC.DApt.Intf, FireDAC.Stan.Async, FireDAC.DApt,
+ FireDAC.Comp.DataSet, FireDAC.Comp.Client, FireDAC.UI.Intf, FireDAC.Stan.Def,
+ FireDAC.Stan.Pool, FireDAC.Phys, FireDAC.Phys.FB, FireDAC.Phys.FBDef,
+ FireDAC.Phys.MySQL, FireDAC.Phys.MySQLDef, FireDAC.VCLUI.Wait,
+ FireDAC.Comp.UI;
type
- TTWebModule1 = class(TWebModule)
+ TWebModule1 = class(TWebModule)
articles: TDataSetPageProducer;
index: TDataSetPageProducer;
admin: TDataSetTableProducer;
top: TPageProducer;
master: TPageProducer;
alert: TDataSetPageProducer;
- footer: TDataSetPageProducer;
mail: TPageProducer;
- css1: TPageProducer;
css2: TPageProducer;
css3: TPageProducer;
css4: TPageProducer;
header: TDataSetPageProducer;
- login: TDataSetPageProducer;
+ js1: TPageProducer;
+ js2: TPageProducer;
+ adhead: TPageProducer;
+ js5: TPageProducer;
+ title: TPageProducer;
+ ti: TDataSetPageProducer;
+ FDTable2: TFDTable;
+ FDTable2DBNUM: TIntegerField;
+ FDTable2NUMBER: TIntegerField;
+ FDTable2TITLE: TWideStringField;
+ FDTable2NAME: TWideStringField;
+ FDTable2COMMENT: TWideMemoField;
+ FDTable2RAW: TWideMemoField;
+ FDTable2DATE: TDateField;
+ FDTable2PASS: TWideStringField;
+ FDTable5: TFDTable;
+ FDTable4: TFDTable;
+ FDTable4ID: TIntegerField;
+ FDTable4DBNAME: TIntegerField;
+ FDTable4POSNUM: TIntegerField;
+ FDTable4DATE: TDateField;
+ FDTable4REQUEST: TWideMemoField;
+ DataSource1: TDataSource;
+ FDTable3: TFDTable;
+ FDTable3TITLE: TWideStringField;
+ FDTable3TITLE2: TWideStringField;
+ FDTable3INFO: TIntegerField;
+ FDTable3COUNT: TIntegerField;
+ FDTable3password: TWideStringField;
+ FDTable3ng: TWideStringField;
+ FDConnection1: TFDConnection;
+ FDTable1: TFDTable;
+ FDTable1DBNUM: TIntegerField;
+ FDTable1DATABASE: TWideStringField;
+ login: TPageProducer;
+ footer: TPageProducer;
+ FDGUIxWaitCursor1: TFDGUIxWaitCursor;
+ FDQuery1: TFDQuery;
+ FDTable3mente: TSmallintField;
+ FDTable5id: TIntegerField;
+ FDTable5name: TWideStringField;
+ FDTable5source: TWideMemoField;
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 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 WebModule1logoutAction(Sender: TObject; Request: TWebRequest;
+ Response: TWebResponse; var Handled: Boolean);
+ procedure WebModule1imgAction(Sender: TObject; Request: TWebRequest;
+ Response: TWebResponse; var Handled: Boolean);
+ 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 WebModule1titleAction(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);
+ procedure css1HTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
+ TagParams: TStrings; var ReplaceText: string);
+ procedure WebModule1usrdelAction(Sender: TObject; Request: TWebRequest;
Response: TWebResponse; var Handled: Boolean);
private
{ private \90é\8c¾ }
ss: TStringList;
- checkbox: Boolean;
+ tagstr: string;
procedure pages(count: Integer; var page: Integer);
+ procedure strsCheck(var Error: string; list: TStringList);
+ procedure setLastArticle;
+ function footerLink(Data: array of const): string;
+ function isInfo: Boolean;
+ function loginCheck: Boolean;
+ function hash(str: string): string;
+ function mente: Boolean;
+ function detail(ts, pid: string): string;
+ function scan(text: string): string;
public
{ public \90é\8c¾ }
end;
var
- WebModuleClass: TComponentClass = TTWebModule1;
+ WebModuleClass: TComponentClass = TWebModule1;
implementation
{ %CLASSGROUP 'Vcl.Controls.TControl' }
-uses Unit1;
+uses IdHashSHA, IdGlobal, IdHash, IdHashMessageDigest, Jpeg, Graphics;
{$R *.dfm}
-procedure TTWebModule1.adminFormatCell(Sender: TObject;
+const
+ promotion = '\8dL\8d\90:';
+ tcnt = 7;
+
+procedure TWebModule1.adheadHTMLTag(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 = 'mente') and (FDTable3.FieldByName('mente').AsInteger = 1)
+ then
+ ReplaceText := 'checked="checked"'
+ else if TagString = 'database' then
+ ReplaceText := Request.QueryFields.Values['db'];
+end;
+
+procedure TWebModule1.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]);
+ if CellRow = 0 then
+ begin
+ BgColor := 'Silver';
+ Exit;
+ end;
+ if CellRow mod 2 = 0 then
+ BgColor := 'snow';
+ case CellColumn of
+ 0:
+ CellData := Format('<input name=check%d type=checkbox>', [CellRow]);
+ 1:
+ CellData := '<b>' + CellData + '</b>';
+ 2:
+ CellData := '<p style=color:red>' + CellData + '</p>';
+ 3:
+ CellData := '<p style=color:green>' + CellData + '</p>';
+ 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 := '<a href=' + Request.ScriptName +
+ '/jump?db=<#dbname>&num=<#posnum>>[ <#dbname>-<#posnum> ]</a>'
+ else if TagString = 'article' then
begin
+ if alert.Tag = 1 then
+ begin
+ ReplaceText := '<p>\83\8a\83N\83G\83X\83g';
+ 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
if Copy(s[i], 1, 18) = '<section id=master' then
begin
s.Delete(i);
break;
end;
- ReplaceText := s.Text;
+ ReplaceText := s.text;
finally
s.Free;
end;
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 = 'database' then
- ReplaceText := Request.QueryFields.Values['db']
+ if TagString = 'uri' then
+ ReplaceText := Request.ScriptName
else if TagString = 'comment' then
- ReplaceText := DataModule1.FDTable2.FieldByName('comment').AsString;
+ ReplaceText := FDTable2.FieldByName('comment').AsString;
end;
-procedure TTWebModule1.footerHTMLTag(Sender: TObject; Tag: TTag;
+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
+ for i := 0 to ComponentCount - 1 do
+ if Components[i].Name = ts + pid then
+ result := (Components[i] as TPageProducer).Content;
+end;
+
+procedure TWebModule1.footerHTMLTag(Sender: TObject; Tag: TTag;
+ const TagString: string; TagParams: TStrings; var ReplaceText: string);
+var
+ i: Integer;
+ s: shortstring;
+ x: Boolean;
+begin
if TagString = 'link' then
begin
for i := 1 to 10 do
- if i = index.Tag then
- ReplaceText := ReplaceText + ' ' + i.ToString + ' '
- else
- ReplaceText := ReplaceText +
- Format(' <a style=text-decoration-line:none href=%s?db=%s&num=%d>%d</a> ',
- [PString(Self.Tag)^,
- TNetEncoding.URL.Decode(Request.QueryFields.Values['db']), i, i]);
- end
- else if TagString = 'recent' then
- if index.Tag = -1 then
- ReplaceText := TagString
- else
- ReplaceText := '<a style=text-decoration-line:none href=' +
- PString(Self.Tag)^ + '?db=' + Request.QueryFields.Values['db'] +
- '>recent</a>'
- else if TagString = 'pathinfo' then
- ReplaceText := PString(Self.Tag)^;
+ begin
+ x := i = index.Tag;
+ ReplaceText := ReplaceText + footerLink([i, i, x]);
+ end;
+ x := index.Tag = -1;
+ s := '\82³\82¢\82²';
+ ReplaceText := ReplaceText + footerLink([-1, s, x]);
+ end;
+end;
+
+function TWebModule1.footerLink(Data: array of const): string;
+var
+ s, t: string;
+begin
+ if Data[1].VType = vtInteger then
+ t := Data[1].VInteger.toString
+ else
+ t := Data[1].VString^;
+ if Data[2].VBoolean = true then
+ s := ' active'
+ else
+ s := '';
+ result := Format
+ ('<li class="page-item%s"><a class=page-link href="%s?db=%d&num=%d">%s</a></li>',
+ [s, Request.ScriptName + tagstr, FDTable1.FieldByName('dbnum').AsInteger,
+ Data[0].VInteger, t]);
end;
-procedure TTWebModule1.headerHTMLTag(Sender: TObject; Tag: TTag;
+function TWebModule1.hash(str: string): string;
+begin
+ with TIdHashSHA1.Create do
+ begin
+ try
+ result := HashStringAsHex(str);
+ finally
+ Free;
+ end;
+ end;
+end;
+
+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]);
end
- else if (TagString = 'check') and (checkbox = true) then
+ else if (TagString = 'check') and
+ (Request.ContentFields.Values['show'] <> 'false') then
ReplaceText := 'checked'
- else if (TagString = 'preview') and (header.Tag <> 0) then
- begin
- ReplaceText := PString(header.Tag)^;
- Dispose(Pointer(header.Tag));
- end
- else if (TagString = 'raw') and (articles.Tag <> 0) then
- begin
- ReplaceText:=PString(articles.Tag)^;
- Dispose(Pointer(articles.Tag));
- end;
+ 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 TWebModule1.helpHTMLTag(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 = 'area' then
+ if help.Tag = 0 then
+ begin
+ ss := TStringList.Create;
+ try
+ ss.Add('<form action=' + Request.ScriptName +
+ '/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;
- x: Boolean;
begin
- if TagString = 'article' then
+ 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 := '\82±\82ê\88È\8fã\93\8a\8de\82Å\82«\82Ü\82¹\82ñ.'
+ if (FDTable1.FieldByName('dbnum').AsInteger = 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
- else if TagString = 'css' then
- ReplaceText := css2.Content;
+ begin
+ i := FDTable3.FieldByName('count').AsInteger;
+ if 10 * i <= 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 := FDTable1.FieldByName('dbnum').AsString
+ else if TagString = 'database' then
+ ReplaceText := FDTable1.FieldByName('database').AsString;
end;
-procedure TTWebModule1.itemsHTMLTag(Sender: TObject; Tag: TTag;
+function TWebModule1.isInfo: Boolean;
+begin
+ result := FDTable1.FieldByName('dbnum').AsInteger = FDTable3.FieldByName
+ ('info').AsInteger;
+end;
+
+procedure TWebModule1.itemsHTMLTag(Sender: TObject; Tag: TTag;
const TagString: string; TagParams: TStrings; var ReplaceText: string);
var
s: TStringList;
begin
s := TStringList.Create;
try
- s.Text := DataModule1.FDTable2.FieldByName('raw').AsString;
+ s.text := FDTable2.FieldByName('raw').AsString;
for i := 0 to s.count - 1 do
for j := 0 to ss.count - 1 do
if Pos(ss[j], s[i]) > 0 then
s[i] := '<p style=background-color:aqua>' + s[i]
else
s[i] := '<p style=background-color:yellow>' + 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('<a href=/index?db=%s&num=%d>[ %d-%d ]</a>',
- [str, j, i, j])
+ t := Format('<a href="%s/jump?db=%d&num=%d">[ %d-%d ]</a>',
+ [Request.ScriptName, i, j, i, j])
else
- t := Format('<a href=/index?db=%s&num=%d>[ %d ]</a>', [str, j, j]);
+ t := Format('<a href="%s/jump?db=%s&num=%d">[ %d ]</a>',
+ [Request.ScriptName, str, j, j]);
end;
- ReplaceText := t + s.Text;
+ ReplaceText := t + s.text;
finally
s.Free;
end;
end;
end;
-procedure TTWebModule1.masterHTMLTag(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
+ 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 TWebModule1.masterHTMLTag(Sender: TObject; Tag: TTag;
const TagString: string; TagParams: TStrings; var ReplaceText: string);
var
i, j: Integer;
- s: string;
begin
- if TagString = 'request' then
- with DataModule1.FDTable4 do
+ if TagString = 'pr' then
+ ReplaceText := promotion
+ else if TagString = 'uri' then
+ ReplaceText := Request.ScriptName
+ else if TagString = 'request' then
+ with FDTable4 do
begin
First;
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;
+ if FDTable2.Locate('dbnum;number', VarArrayOf([i, j])) = true then
+ alert.Tag := 0
+ else
+ alert.Tag := 1;
+ ReplaceText := ReplaceText + alert.ContentFromString(alert.Content);
Next;
end;
+ if ReplaceText <> '' then
+ ReplaceText := '<table border=1 align=center>' + ReplaceText +
+ '</table>';
end;
end;
-procedure TTWebModule1.pages(count: Integer; var page: Integer);
+function TWebModule1.mente: Boolean;
+var
+ s: string;
+begin
+ if FDTable3.FieldByName('mente').AsInteger = 1 then
+ begin
+ s := Request.QueryFields.Values['db'];
+ if s <> '' then
+ s := '?db=' + s;
+ 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>' +
+ Format('<p style=text-align:center><a href=%s/admin%s>\8aÇ\97\9d\8eÒ\97p\83\8d\83O\83C\83\93</a>',
+ [Request.ScriptName, s]);
+ end
+ else
+ result := false;
+end;
+
+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;
+ if count mod max = 0 then
+ dec(page);
+ end;
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 = 'content' then
- ReplaceText := alert.Content
+ 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
- ReplaceText := '?' + Request.Query + '#' +
- Request.QueryFields.Values['num'];
+ ReplaceText := '?' + Request.Query
+ else if TagString = 'number' then
+ ReplaceText := Request.QueryFields.Values['num'];
+end;
+
+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
+ ('<a class=minpreview data-preview-url=%s/link?db=%d&num=%s href=%s/jump?db=%d&num=%s>>>%s</a>',
+ [s, i, t, s, i, t, t]);
+ Insert(result, text, coll[j].index);
+ end;
+ result := text;
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;
+ 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
else if i = s.count - 1 then
goto jump;
jump:
- DataModule1.FDTable2.Next;
+ FDTable2.Next;
end;
end;
begin
- if (Request.MethodType = mtPost) and (TagString = 'items') then
+ 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
Self.Tag := 0
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
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.topHTMLTag(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] := '<p>' + scan(list[i]);
+ 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 = 'uri' then
+ ReplaceText := Request.ScriptName
+ else if TagString = 'count' then
+ ReplaceText := FDTable2.RecordCount.toString
+ else if TagString = 'database' then
+ ReplaceText := FDTable1.FieldByName('database').AsString
+ else if TagString = 'date' then
+ ReplaceText := FDQuery1.FieldByName('max(date)').AsString;
+end;
+
+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
+ begin
+ FDQuery1.Open;
+ while FDQuery1.Eof = false do
+ begin
+ FDTable1.Locate('dbnum', FDQuery1.FieldByName('dbnum').AsInteger);
+ ReplaceText := ReplaceText + ti.Content;
+ FDQuery1.Next;
+ end;
+ FDQuery1.Close;
+ end;
+end;
+
+procedure TWebModule1.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 = 'uri' then
+ ReplaceText := Request.ScriptName
+ else if TagString = 'list' then
begin
- DataModule1.FDTable1.First;
- i := DataModule1.FDTable3.FieldByName('info').AsInteger;
- while DataModule1.FDTable1.Eof = false do
+ i := FDTable3.FieldByName('info').AsInteger;
+ for k := 0 to tcnt do
begin
+ if FDTable1.Eof = true then
+ break;
t := '';
- if i = DataModule1.FDTable1.FieldByName('dbnum').AsInteger 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('<p%s><a target=_blank href=%s>%s</a><br></p>',
- [t, '/index?db=' + s, s]);
- DataModule1.FDTable1.Next;
+ Format('<p><a%s target=_blank href="%s/index?db=%d">%s</a><br></p>',
+ [t, Request.ScriptName, j, s]);
+ FDTable1.Next;
end;
+ ReplaceText :=
+ '<div class="carousel-caption text-left" style="text-align:bottom;font-size:1.5rem">'
+ + ReplaceText + '</div>';
end
else if TagString = 'info' then
- ReplaceText := DataModule1.FDTable1.Lookup('dbnum',
- DataModule1.FDTable3.FieldByName('info').AsInteger, 'database')
- else if TagString = 'css' then
- case TagParams.Values['id'].ToInteger of
- 1:
- ReplaceText := css1.Content;
- 3:
- ReplaceText := css3.Content;
+ ReplaceText := FDTable1.Lookup('dbnum', FDTable3.FieldByName('info')
+ .AsInteger, 'database')
+ else if TagString = 'dbnum' then
+ ReplaceText := FDTable3.FieldByName('info').AsString
+ else if (TagString = 'css') or (TagString = 'js') then
+ ReplaceText := detail(TagString, TagParams.Values['id'])
+ else if TagString = 'slide' then
+ begin
+ s := ' active';
+ for i := 1 to (FDTable1.RecordCount div tcnt) + 1 do
+ begin
+ ReplaceText := ReplaceText +
+ Format('<div class="carousel-item%s"><img src="%s/src?name=slide%d.jpg"',
+ [s, Request.ScriptName, i]) +
+ ' class="d-sm-block d-none" style=float:right;height:465px><div style=height:465px></div><#list></div>';
+ s := '';
+ end;
+ end
+ else if TagString = 'indicator' then
+ begin
+ s := ' class="active"';
+ for i := 0 to (FDTable1.RecordCount div tcnt) do
+ begin
+ ReplaceText := ReplaceText +
+ Format('<li data-target="#slide-1" data-slide-to=%d%s></li>', [i, s]);
+ s := '';
end;
+ 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;
match: TMatch;
begin
j := 0;
- DataModule1.FDTable2.RecNo := admin.Tag;
+ FDTable1.Locate('dbnum', Request.QueryFields.Values['db']);
for i := 0 to Request.ContentFields.count - 1 do
begin
reg := TRegEx.Create('\d+');
k := match.Value.ToInteger - j - 1;
j := match.Value.ToInteger;
for m := 1 to k do
- DataModule1.FDTable2.Next;
- DataModule1.FDTable2.Delete;
+ FDTable2.Next;
+ FDTable2.Delete;
end;
end;
- Response.SendRedirect('/admin?db=' + TNetEncoding.URL.Encode
- (DataModule1.FDTable1.FieldByName('database').AsString));
+ 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 Request.CookieFields.Values['user'] <> 'admin' 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 := TNetEncoding.URL.Decode(Request.QueryFields.Values['db']);
- DataModule1.FDTable1.Locate('database', s, []);
+ admin.MaxRows := FDTable3.FieldByName('count').AsInteger;
+ t := Request.QueryFields.Values['db'];
+ if t <> '' then
+ FDTable1.Locate('dbnum', t, []);
s := Request.QueryFields.Values['num'];
i := StrToIntDef(s, -1);
- pages(DataModule1.FDTable2.RecordCount, i);
+ pages(FDTable2.RecordCount, i);
index.Tag := i;
- s := '/admin';
- footer.Tag := Integer(@s);
- i := footer.HTMLDoc.Add
- ('<p style=text-align:center><a href=/index?db=<#database>>\96ß\82é</a>');
- if admin.Tag = 0 then
- begin
- admin.footer.Insert(3, footer.Content);
- admin.Tag := 1;
- end
- else
- begin
- admin.footer.Delete(3);
- admin.footer.Insert(3, footer.Content);
- end;
- footer.HTMLDoc.Delete(i);
+ tagstr := '/admin';
+ admin.header.text := adhead.Content;
+ 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
+ (Format('<p style=text-align:center><a href="%s/index%s">\96ß\82é</a>',
+ [Request.ScriptName, t]));
Response.ContentType := 'text/html;charset=utf-8';
Response.Content := admin.Content;
end;
-procedure TTWebModule1.TWebModule1alertAction(Sender: TObject;
+procedure TWebModule1.WebModule1adminsetAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
- num1, num2: Integer;
s: string;
+ i: Integer;
begin
- s := Request.QueryFields.Values['db'];
- num1 := DataModule1.FDTable1.Lookup('database', s, 'dbnum');
- num2 := Request.QueryFields.Values['num'].ToInteger;
+ s := Request.ContentFields.Values['pass'];
+ with FDTable3 do
+ begin
+ Edit;
+ 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;
+ WebModule1adminAction(nil, Request, Response, Handled);
+end;
+
+procedure TWebModule1.WebModule1alertAction(Sender: TObject;
+ Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+var
+ num1, num2, i: Integer;
+ s: string;
+begin
+ 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
begin
- DataModule1.FDTable4.AppendRecord
- ([num1, num2, Now, Request.ContentFields.Values['request']]);
- Response.SendRedirect(Format('/index?db=%s&num=%d#%d', [s, Tag, num2]));
+ with FDTable4 do
+ begin
+ Last;
+ i := FieldByName('id').AsInteger + 1;
+ 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;
s: string;
begin
- s := Request.ContentFields.Values['number'];
+ s := Request.ContentFields.Values['num'];
if s = '' then
Exit;
num := s.ToInteger;
- s := Request.ContentFields.Values['password'];
- with DataModule1.FDTable2 do
+ s := hash(Request.ContentFields.Values['password']);
+ with FDTable2 do
if Locate('number;pass', VarArrayOf([num, s])) = true then
begin
Edit;
FieldByName('title').AsString := '';
- FieldByName('name').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;
- end;
- Response.SendRedirect('/index?db=' + DataModule1.FDTable1.FieldByName
- ('database').AsString);
+ WebModule1jumpAction(nil, Request, Response, Handled);
+ end
+ else
+ WebModule1indexpageAction(nil, Request, Response, Handled);
end;
-procedure TTWebModule1.TWebModule1helpAction(Sender: TObject;
+procedure TWebModule1.WebModule1fileAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
- i, j: Integer;
+ 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 TWebModule1.WebModule1helpAction(Sender: TObject;
+ Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+var
+ 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.TWebModule1indexpageAction(Sender: TObject;
+procedure TWebModule1.WebModule1imgAction(Sender: TObject; Request: TWebRequest;
+ Response: TWebResponse; var Handled: Boolean);
+var
+ s: string;
+ p: TBytes;
+ res: TMemoryStream;
+begin
+ with FDTable5 do
+ begin
+ s := Request.QueryFields.Values['name'];
+ Response.ContentType := 'image/jpeg';
+ if s = 'BBS_bn.jpg' then
+ Response.ContentStream := TResourceStream.Create(HInstance, 'JpgImage_1',
+ RT_RCDATA)
+ else if s = 'favicon64.ico' then
+ Response.ContentStream := TResourceStream.Create(HInstance,
+ 'Icon_1', RT_ICON)
+ else if Locate('name', s) = true then
+ begin
+ 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 TWebModule1.WebModule1indexpageAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
- int: Integer;
+ i: Integer;
s: string;
begin
- DataModule1.FDTable1.Locate('database', Request.QueryFields.Values['db'], []);
- 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
- Response.Content := index.Content;
+ if mente = true then
+ Exit;
+ s := Request.QueryFields.Values['db'];
+ if s <> '' then
+ FDTable1.Locate('dbnum', s, []);
+ i := StrToIntDef(Request.QueryFields.Values['num'], -1);
+ isInfo;
+ pages(FDTable2.RecordCount, i);
+ index.Tag := i;
+ tagstr := '/index';
+ 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;
+ DB, s: string;
+ i: Integer;
begin
- db := DataModule1.FDTable1.FieldByName('database').AsString;
- s := Request.ContentFields.Values['num'];
+ DB := Request.QueryFields.Values['db'];
+ s := Request.QueryFields.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;
- DataModule1.FDTable2.Locate('number', s.ToInteger, []);
- page := 10;
- pages(DataModule1.FDTable2.RecNo, page);
- Response.SendRedirect(Format('/index?db=%s&num=%d#%s',
- [TNetEncoding.URL.Encode(db), page, s]));
+ 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
- s: string;
+ v: Variant;
+ i: Integer;
+ s, t: string;
begin
if Request.MethodType = mtGet then
begin
Response.Content := login.Content;
Exit;
end;
+ 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
+ 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 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';
- Value := 'admin';
- Expires := Now + 14;
+ Expires := Now - 1;
end;
- s := Request.ContentFields.Values['record'];
- Response.SendRedirect('/admin?db=' + TNetEncoding.URL.Encode(s));
+ 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'];
+ FDTable4.First;
+ with FDTable4 do
+ if s = 'all' then
+ while not((Bof = true) and (Eof = true)) do
+ Delete
+ else
+ while Eof = false do
+ begin
+ i := FieldByName('dbname').AsInteger;
+ if FDTable1.Locate('dbnum', i) = true then
+ begin
+ i := FieldByName('posnum').AsInteger;
+ if FDTable2.Locate('number', i) = false then
+ Delete
+ else
+ Next;
+ end
+ else
+ Delete;
+ 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: Integer;
- title, na, raw, pass, kotoba, db, error, URL: string;
- p: PString;
+ number, i: Integer;
+ title, na, raw, pass, kotoba, Error, temp: string;
comment: TStringList;
- i: Integer;
- function scan(Text: string): string;
- var
- reg: TRegEx;
- coll: TMatchCollection;
- j: Integer;
- s: 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 <> '\82°\82ñ\82«' then
+ Error := Error + '<p>\8d\87\8c¾\97t\82ª\82¿\82ª\82¢\82Ü\82·.';
+ with Request.ContentFields 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);
+ title := Values['title'];
+ na := Values['name'];
+ raw := Values['comment'];
+ Values['comment'] := '';
+ pass := hash(Values['password']);
end;
- result := Text;
- end;
-
-begin
- 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;
- number := FieldByName('number').AsInteger + 1;
- end;
- with Request.ContentFields do
- begin
- na := Values['name'];
- raw := Values['comment'];
- pass := Values['password'];
- end;
- 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
+ if title = '' then
+ title := '\83^\83C\83g\83\8b\82È\82µ.';
with Response.Cookies.Add do
begin
- Name := 'aikotoba';
- Value := kotoba;
+ Name := 'name';
+ if na = '' then
+ Value := '\92N\82©\82³\82ñ.'
+ 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 + '<p>\8bÖ\8e~\8cê\8bå\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82Ü\82·.';
- break;
+ Name := 'aikotoba';
+ Value := kotoba;
+ Expires := Now + 14;
end;
- comment[i] := '<p>' + scan(comment[i]);
+ comment := TStringList.Create;
+ try
+ comment.text := raw;
+ strsCheck(Error, comment);
+ temp := comment.text;
+ finally
+ comment.Free;
end;
- URL := '/index?db=' + TNetEncoding.URL.Encode(db);
- 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;
- New(p);
- p^ := error;
- header.Tag := Integer(p);
- New(p);
- p^:=raw;
- articles.Tag:=Integer(p);
- end
+ review := false;
+ end
+ else
+ review := true;
+ Request.ContentFields.Values['raw'] := raw;
+ if Error <> '' then
+ Request.ContentFields.Values['preview'] := '<section style=color:red>' +
+ Error + '</section>'
+ else if Request.ContentFields.Values['show'] = 'true' then
+ begin
+ if review = false then
+ Error := '<p style=font-size:2.3em;color:blue>
\81«
\81«
\83v
\83\8c\83r
\83\85\81[
\81«
\81«<p>' + 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]);
- checkbox := true;
- header.Tag := 0;
- URL := URL + '#article';
+ 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;
- Response.SendRedirect(URL);
+ 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.TWebModule1topAction(Sender: TObject;
+procedure TWebModule1.WebModule1titleAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
Response.ContentType := 'text/html;charset=utf-8';
- Response.Content := top.Content;
+ Response.Content := title.Content;
+end;
+
+procedure TWebModule1.WebModule1topAction(Sender: TObject; Request: TWebRequest;
+ Response: TWebResponse; var Handled: Boolean);
+begin
+ Response.ContentType := 'text/html;charset=utf-8';
+ 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
- a: Variant;
i: Integer;
+ s: string;
begin
- 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, '\8cf\8e¦\94Â' + i.ToString]);
+ FDTable1.AppendRecord([i + 1, '\8cf\8e¦\94Â' + 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
- (['
\82Æ
\82é
\82Ë
\81`
\82Ç
\8d\86', '<p style=font-color:gray>
\82Æ
\82é
\82Ë
\81`
\82Ç
\8d\86</p>', false, a, 30]);
+ i := FDTable1.Lookup('database', 'info', 'dbnum');
+ s := '\88¢\95Û,\94n\8e,\8e\80\82Ë';
+ 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>',
+ 0, i, 30, hash(hash('admin')), s]);
end;
- checkbox := true;
+ admin.MaxRows := FDTable3.FieldByName('count').AsInteger;
end;
end.
OSDN Git Service
