uses System.SysUtils, System.Classes, Web.HTTPApp, Web.DSProd, Web.HTTPProd,
Web.DBWeb, System.Variants, System.NetEncoding, System.RegularExpressions,
- Data.DB;
+ Data.DB, Web.DBXpressWeb, System.Types;
type
TTWebModule1 = class(TWebModule)
js2: TPageProducer;
js3: TPageProducer;
js4: TPageProducer;
+ adhead: TPageProducer;
js5: TPageProducer;
- js6: TPageProducer;
- adhead: TDataSetPageProducer;
+ title: TPageProducer;
+ ti: TDataSetPageProducer;
procedure indexHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
TagParams: TStrings; var ReplaceText: string);
procedure TWebModule1indexpageAction(Sender: TObject; Request: TWebRequest;
Response: TWebResponse; var Handled: Boolean);
procedure 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;
{$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 = 'mente') and (DataModule1.FDTable3.FieldByName('mente')
- .AsBoolean = true) then
- ReplaceText := 'checked';
+ 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;
function TTWebModule1.detail(ts, pid: string): string;
var
- s: string;
- j: Integer;
+ i: Integer;
begin
- s := pid;
- for j := 0 to ComponentCount - 1 do
- if Components[j].Name = ts + s then
- result := (Components[j] as TPageProducer).Content;
+ 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;
ReplaceText := ReplaceText + ' ' + i.ToString + ' '
else
ReplaceText := ReplaceText +
- Format(' <a style=text-decoration-line:none href=%s?db=%d&num=%d>%d</a> ',
+ 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
if index.Tag = -1 then
ReplaceText := TagString
else
- ReplaceText := '<a style=text-decoration-line:none href=' +
+ ReplaceText := '<a style=text-decoration-line:none href="' +
PString(Self.Tag)^ + '?db=' + DataModule1.FDTable1.FieldByName('dbnum')
- .AsString + '>recent</a>';
+ .AsString + '">recent</a>';
end;
function TTWebModule1.hash(str: string): string;
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;
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 = 'article' then
begin
x := DataModule1.FDTable1.FieldByName('dbnum')
.AsInteger = DataModule1.FDTable3.FieldByName('info').AsInteger;
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
j := FieldByName('number').AsInteger;
str := Request.QueryFields.Values['db'];
if str = '' then
- t := Format('<a href=/jump?db=%d&num=%d>[ %d-%d ]</a>',
+ 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=/jump?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);
begin
- if TagString = 'request' then
+ if TagString = 'pr' then
+ ReplaceText := promotion
+ else if TagString = 'request' then
with DataModule1.FDTable4 do
begin
First;
procedure TTWebModule1.mailHTMLTag(Sender: TObject; Tag: TTag;
const TagString: string; TagParams: TStrings; var ReplaceText: string);
begin
- if TagString = 'content' then
+ if TagString = 'pr' then
+ ReplaceText := promotion
+ else if TagString = 'content' then
ReplaceText := articles.Content
else if TagString = 'query' then
ReplaceText := '?' + Request.Query
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
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, j, k: Integer;
begin
- if TagString = 'list' then
+ if TagString = 'pr' then
+ ReplaceText := promotion
+ else if TagString = 'list' then
begin
i := DataModule1.FDTable3.FieldByName('info').AsInteger;
- for k := 0 to DataModule1.FDTable3.FieldByName('tcnt').AsInteger do
+ for k := 0 to tcnt do
begin
if DataModule1.FDTable1.Eof = true then
break;
if t <> '' then
t := ' style=' + t;
ReplaceText := ReplaceText +
- Format('<p%s><a target=_blank href="/index?db=%d">%s</a><br></p>',
+ Format('<p><a%s target=_blank href="/index?db=%d">%s</a><br></p>',
[t, j, s]);
DataModule1.FDTable1.Next;
end;
else if TagString = 'info' then
ReplaceText := DataModule1.FDTable1.Lookup('dbnum',
DataModule1.FDTable3.FieldByName('info').AsInteger, 'database')
+ 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
- j := DataModule1.FDTable3.FieldByName('tcnt').AsInteger;
- for i := 1 to (DataModule1.FDTable1.RecordCount div j)+1 do
+ for i := 1 to (DataModule1.FDTable1.RecordCount div tcnt) + 1 do
ReplaceText := ReplaceText +
- '<div class="slide"><#list><img src=/src?name=slide' + i.ToString +
- '.jpg style=float:right;height:465px></div>';
+ '<div class="slide"><img src="/src?name=slide' + i.ToString +
+ '.jpg" style=float:right;height:465px><#list></div>';
end;
end;
s: string;
i: Integer;
begin
- if Request.CookieFields.Values['user'] <> DataModule1.FDTable3.FieldByName
- ('password').AsString then
+ 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'];
- DataModule1.FDTable1.Locate('dbnum', s, []);
+ if s <> '' then
+ DataModule1.FDTable1.Locate('dbnum', s, []);
s := Request.QueryFields.Values['num'];
i := StrToIntDef(s, -1);
pages(DataModule1.FDTable2.RecordCount, i);
s := '/admin';
Self.Tag := Integer(@s);
i := footer.HTMLDoc.Add
- ('<p style=text-align:center><a href=/index?db=<#dbnum>>\96ß\82é</a>');
+ ('<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)
var
s: string;
begin
- s := hash(Request.ContentFields.Values['pass']);
+ s := Request.ContentFields.Values['pass'];
with DataModule1.FDTable3 do
begin
Edit;
FieldByName('mente').AsBoolean := Request.ContentFields.Values
['mente'] = 'on';
- FieldByName('password').AsString := s;
+ FieldByName('password').AsString := hash(s);
Post;
end;
with Response.Cookies.Add do
Name := 'user';
Value := s;
Expires := Now + 14;
+ Secure := true;
end;
Request.CookieFields.Values['user'] := s;
TWebModule1adminAction(nil, Request, Response, Handled);
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;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
procedure TTWebModule1.TWebModule1imgAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+var
+ s: string;
+ res: TResourceStream;
begin
with DataModule1.FDTable5 do
begin
- Locate('name', Request.ContentFields.Values['name'], []);
- Response.ContentType:='image/jpeg';
- Response.ContentStream := CreateBlobStream(FieldByName('source'), bmRead);
+ 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
+ res:=TResourceStream.Create(HInstance,'PngImage_1',RT_RCDATA);
+ try
+ Response.ContentStream:=res;
+ finally
+ res.Free;
+ end;
+ end
+ else
+ Response.ContentStream:=nil;
end;
end;
with Response.Cookies.Add do
begin
Name := 'user';
- Value := hash(Request.ContentFields.Values['password']);
+ Value := Request.ContentFields.Values['password'];
Expires := Now + 14;
+ Secure := true;
end;
i := DataModule1.FDTable1.Lookup('database',
Request.ContentFields.Values['record'], 'dbnum');
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
procedure TTWebModule1.WebModuleCreate(Sender: TObject);
var
- a: Variant;
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']);
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'), 7]);
+ false, a, 30, hash('admin')]);
end;
end;
OSDN Git Service
