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.Phys.MySQL, FireDAC.Phys.MySQLDef, FireDAC.VCLUI.Wait,
+ FireDAC.Comp.UI;
type
TWebModule1 = class(TWebModule)
master: TPageProducer;
alert: TDataSetPageProducer;
mail: TPageProducer;
- css1: TPageProducer;
css2: TPageProducer;
css3: TPageProducer;
css4: TPageProducer;
header: TDataSetPageProducer;
js1: TPageProducer;
js2: TPageProducer;
- js3: TPageProducer;
- js4: TPageProducer;
adhead: TPageProducer;
js5: TPageProducer;
title: TPageProducer;
FDTable2DATE: TDateField;
FDTable2PASS: TWideStringField;
FDTable5: TFDTable;
- FDQuery1: TFDQuery;
FDTable4: TFDTable;
FDTable4ID: TIntegerField;
FDTable4DBNAME: TIntegerField;
FDTable3: TFDTable;
FDTable3TITLE: TWideStringField;
FDTable3TITLE2: TWideStringField;
- FDTable3mente: TBooleanField;
FDTable3INFO: TIntegerField;
FDTable3COUNT: TIntegerField;
FDTable3password: TWideStringField;
FDTable1: TFDTable;
FDTable1DBNUM: TIntegerField;
FDTable1DATABASE: TWideStringField;
- FDTable5ID: TIntegerField;
- FDTable5NAME: TWideStringField;
- FDTable5SOURCE: TBlobField;
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 WebModule1indexpageAction(Sender: TObject; Request: TWebRequest;
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;
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;
ReplaceText := promotion
else if TagString = 'uri' then
ReplaceText := Request.ScriptName
- else if (TagString = 'mente') and
- (FDTable3.FieldByName('mente').AsBoolean = true) then
- ReplaceText := 'checked'
+ 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;
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 TWebModule1.alertHTMLTag(Sender: TObject; Tag: TTag;
'/jump?db=<#dbname>&num=<#posnum>>[ <#dbname>-<#posnum> ]</a>'
else if TagString = 'article' then
begin
- if (FDTable1.Locate('dbnum', FDTable4.FieldByName('dbname').AsInteger)
- = false) or (FDTable2.Locate('number', FDTable4.FieldByName('posnum')
- .AsInteger) = false) then
+ if alert.Tag = 1 then
begin
ReplaceText := '<p>\83\8a\83N\83G\83X\83g';
Exit;
finally
s.Free;
end;
- end
- else if TagString = 'request' then
- ReplaceText := FDTable4.FieldByName('request').AsString;
+ end;
end;
procedure TWebModule1.articlesHTMLTag(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=%d&num=%d">%d</a> ',
- [Request.ScriptName + PString(Self.Tag)^,
- FDTable1.FieldByName('dbnum').AsInteger, i, i]);
- end
- else if TagString = 'recent' then
- if index.Tag = -1 then
- ReplaceText := TagString
- else
- ReplaceText := '<a style=text-decoration-line:none href="' +
- Request.ScriptName + PString(Self.Tag)^ + '?db=' +
- FDTable1.FieldByName('dbnum').AsString + '">recent</a>';
+ 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;
function TWebModule1.hash(str: string): string;
ReplaceText := Request.ScriptName
else if TagString = 'database' then
begin
- i := StrToIntDef(Request.QueryFields.Values['db'], -1);
+ i := StrToIntDef(Request.QueryFields.Values['db'],
+ FDTable3.FieldByName('info').AsInteger);
if FDTable1.Locate('dbnum', i) = true then
ReplaceText := FDTable1.FieldByName('database').AsString;
end;
procedure TWebModule1.masterHTMLTag(Sender: TObject; Tag: TTag;
const TagString: string; TagParams: TStrings; var ReplaceText: string);
+var
+ i, j: Integer;
begin
if TagString = 'pr' then
ReplaceText := promotion
with FDTable4 do
begin
First;
- ReplaceText := '<table border=1 align=center>';
while Eof = false do
begin
- if FieldByName('posnum').AsInteger = -1 then
- alert.Tag := 1
+ i := FieldByName('dbname').AsInteger;
+ j := FieldByName('posnum').AsInteger;
+ if FDTable2.Locate('dbnum;number', VarArrayOf([i, j])) = true then
+ alert.Tag := 0
else
- alert.Tag := 0;
+ alert.Tag := 1;
ReplaceText := ReplaceText + alert.ContentFromString(alert.Content);
Next;
end;
- ReplaceText := ReplaceText + '</table>';
+ if ReplaceText <> '' then
+ ReplaceText := '<table border=1 align=center>' + ReplaceText +
+ '</table>';
end;
end;
function TWebModule1.mente: Boolean;
+var
+ s: string;
begin
- if FDTable3.FieldByName('mente').AsBoolean = true then
+ 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>\8aÇ\97\9d\8eÒ\97p\83\8d\83O\83C\83\93</a>',
- [Request.ScriptName]);
+ 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;
reg: TRegEx;
coll: TMatchCollection;
i, j: Integer;
- s, t: string;
+ s, t, str: string;
begin
i := Request.QueryFields.Values['db'].ToInteger;
+ s := Request.ScriptName;
text := TNetEncoding.HTML.Encode(text);
- s := TNetEncoding.HTML.Encode('>>');
- reg := TRegEx.Create(s + '(\d+)');
+ 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(s) + 1, 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=/jump?db=%d&num=%s>>>%s</a>',
- [Request.ScriptName, i, t, i, t, t]);
+ ('<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;
x := true;
break;
end;
- for i := 0 to list.Count-1 do
- list[i]:='<p>'+scan(list[i]);
+ for i := 0 to list.count - 1 do
+ list[i] := '<p>' + scan(list[i]);
finally
s.Free;
end;
if TagString = 'uri' then
ReplaceText := Request.ScriptName
else if TagString = 'count' then
- ReplaceText := FDTable2.RecordCount.ToString
+ ReplaceText := FDTable2.RecordCount.toString
else if TagString = 'database' then
ReplaceText := FDTable1.FieldByName('database').AsString
else if TagString = 'date' then
- with FDTable2 do
- begin
- Last;
- ReplaceText := FieldByName('date').AsString;
- end;
+ ReplaceText := FDQuery1.FieldByName('max(date)').AsString;
end;
procedure TWebModule1.titleHTMLTag(Sender: TObject; Tag: TTag;
else if TagString = 'main' then
begin
FDQuery1.Open;
- FDTable1.First;
- while (FDQuery1.Eof = false) and (FDTable1.Eof = false) do
+ while FDQuery1.Eof = false do
begin
- if FDTable1.FieldByName('dbnum').AsInteger = FDQuery1.FieldByName('dbnum')
- .AsInteger then
- begin
- ReplaceText := ReplaceText + ti.Content;
- FDQuery1.Next;
- end
- else if FDTable2.Eof = false then
- ReplaceText := ReplaceText + ti.Content;
- FDTable1.Next;
+ FDTable1.Locate('dbnum', FDQuery1.FieldByName('dbnum').AsInteger);
+ ReplaceText := ReplaceText + ti.Content;
+ FDQuery1.Next;
end;
FDQuery1.Close;
end;
[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 := FDTable1.Lookup('dbnum', FDTable3.FieldByName('info')
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="slide"><img src="%s/src?name=slide%d.jpg"',
- [Request.ScriptName, i]) +
- ' style=float:right;height:465px><#list></div>';
+ 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;
pages(FDTable2.RecordCount, i);
index.Tag := i;
tagstr := '/admin';
- Self.Tag := Integer(@tagstr);
admin.header.text := adhead.Content;
admin.footer.Clear;
admin.footer.Add
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
s: string;
+ i: Integer;
begin
s := Request.ContentFields.Values['pass'];
with FDTable3 do
begin
Edit;
- FieldByName('mente').AsBoolean := Request.ContentFields.Values
- ['mente'] = 'on';
- if s <> '' then
+ 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);
num1, num2, i: Integer;
s: string;
begin
- num1 := FDTable1.FieldByName('dbnum').AsInteger;
+ num1 := Request.QueryFields.Values['db'].ToInteger;
num2 := StrToIntDef(Request.QueryFields.Values['num'], -1);
if num2 = -1 then
- num1 := -1;
+ Exit;
if Request.MethodType = mtGet then
begin
- FDTable2.Locate('number', num2, []);
+ FDTable1.Locate('dbnum', num1);
+ FDTable2.Locate('number', num2);
Response.ContentType := 'text/html;charset=utf-8';
Response.Content := mail.Content;
end
s := '(No Comment)';
AppendRecord([i, num1, num2, Now, s]);
end;
- if num1 > -1 then
- Response.SendRedirect(Format('%s/index?db=%d&num=%d#%d',
- [Request.ScriptName, num1, num2, num2]))
- else
- Response.SendRedirect('/');
+ WebModule1jumpAction(nil, Request, Response, Handled);
end;
end;
Response: TWebResponse; var Handled: Boolean);
var
s: string;
- res: TStream;
+ p: TBytes;
+ res: TMemoryStream;
begin
with FDTable5 do
begin
- s := Request.ContentFields.Values['name'];
- Response.ContentType := 'image/jpeg';
+ s := Request.QueryFields.Values['name'];
+ if ExtractFileExt(s) = '.ico' then
+ Response.ContentType:='image/x-ico'
+ else
+ Response.ContentType := 'image/jpeg';
if Locate('name', s) = true then
begin
- res := CreateBlobStream(FieldByName('source'), bmRead);
- Response.ContentStream := res;
- end
- else if s = 'sprites.png' then
- begin
- Response.ContentType := 'image/png';
- res := TResourceStream.Create(HInstance, 'PngImage_1', RT_RCDATA);
+ s := FieldByName('source').AsString;
+ p := TNetEncoding.Base64.DecodeStringToBytes(s);
+ res := TMemoryStream.Create;
+ res.WriteBuffer(p, Length(p));
Response.ContentStream := res;
end
else
i: Integer;
s: string;
begin
+ Response.ContentType := 'text/html; charset="utf-8"';
+ if mente = true then
+ Exit;
s := Request.QueryFields.Values['db'];
if s <> '' then
FDTable1.Locate('dbnum', s, []);
pages(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;
+ Response.Content := index.Content;
end;
procedure TWebModule1.WebModule1jumpAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
DB, s: string;
- page: Integer;
+ i: Integer;
begin
DB := Request.QueryFields.Values['db'];
s := Request.QueryFields.Values['num'];
- if DB <> '' then
- FDTable1.Locate('dbnum', DB.ToInteger);
- FDTable2.Locate('number', s.ToInteger);
- page := 10;
- pages(FDTable2.RecNo, page);
+ if s = '' then
+ s := Request.ContentFields.Values['num'];
+ i := 10;
+ pages(s.ToInteger, i);
Response.SendRedirect(Format('%s/index?db=%s&num=%d#%s', [Request.ScriptName,
- DB, page, s]));
+ DB, i, s]));
end;
procedure TWebModule1.WebModule1linkAction(Sender: TObject;
var
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;
- if FDTable2.Locate('number', s.ToInteger) = 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;
var
v: Variant;
i: Integer;
- s: string;
+ s, t: string;
begin
if Request.MethodType = mtGet then
begin
end;
s := Request.ContentFields.Values['record'];
v := FDTable1.Lookup('database', s, 'dbnum');
- if VarIsNull(v) = false then
+ 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 := hash(Request.ContentFields.Values['password']);
+ Value := t;
Expires := Now + 14;
// Secure := true;
end;
if s = 'master' then
Response.SendRedirect(Request.ScriptName + '/master')
else
- Response.SendRedirect(Request.ScriptName + '/admin?db=' + i.ToString);
+ Response.SendRedirect(Request.ScriptName + '/admin?db=' + i.toString);
end
- else
+ else if VarIsNull(v) = false then
begin
- Response.ContentType := 'text/html;charset=utf-8';
- Response.Content := login.Content;
- end;
+ t := v;
+ Response.SendRedirect(Request.ScriptName + '/login?db=' + t);
+ end
+ else
+ Response.SendRedirect(Request.ScriptName + '/login');
end;
procedure TWebModule1.WebModule1logoutAction(Sender: TObject;
begin
if loginCheck = false then
begin
- with FDTable1 do
- if Locate('database', 'master') = false then
- begin
- Last;
- i := FieldByName('dbnum').AsInteger + 1;
- AppendRecord([i, 'master']);
- end;
+ 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'];
- if s = 'all' then
- with FDTable4 do
- while (Bof = false) or (Eof = false) do
+ FDTable4.First;
+ with FDTable4 do
+ if s = 'all' then
+ while not((Bof = true) and (Eof = true)) do
Delete
- else
- begin
- FDTable4.First;
- while FDTable4.Eof = false do
- begin
- i := FDTable4.FieldByName('dbname').AsInteger;
- if FDTable1.Locate('dbnum', i) = true then
+ else
+ while Eof = false do
begin
- i := FDTable4.FieldByName('posnum').AsInteger;
- if FDTable2.Locate('number', i) = false then
- FDTable4.Delete
+ 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
- FDTable4.Next;
- end
- else
- FDTable4.Delete;
- end;
- end;
+ Delete;
+ end;
end;
+ FDTable4.First;
Response.ContentType := 'text/html;charset=utf-8';
Response.Content := master.Content;
end;
title := Values['title'];
na := Values['name'];
raw := Values['comment'];
+ Values['comment'] := '';
pass := hash(Values['password']);
end;
if title = '' then
finally
comment.Free;
end;
+ review := false;
end
else
review := true;
- Request.ContentFields.Values['comment'] := raw;
+ Request.ContentFields.Values['raw'] := raw;
if Error <> '' then
Request.ContentFields.Values['preview'] := '<section style=color:red>' +
Error + '</section>'
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 +
+ Response.SendRedirect(Request.ScriptName + '/index?db=' + i.toString +
'#article');
end;
Exit;
Response.Content := top.ContentFromString(top.Content);
end;
+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
i: Integer;
FDTable3.Open;
FDTable4.Open;
FDTable5.Open;
- if FDTable1.Bof and FDTable1.Eof then
+ FDTable1.Refresh;
+ FDTable3.Refresh;
+ FDTable4.Refresh;
+ FDTable5.Refresh;
+ if (FDTable1.Bof = true) and (FDTable1.Eof = true) then
begin
FDTable1.AppendRecord([0, 'info']);
+ FDTable1.AppendRecord([1, 'master']);
for i := 1 to 10 do
- FDTable1.AppendRecord([i, '\8cf\8e¦\94Â' + i.ToString]);
+ FDTable1.AppendRecord([i + 1, '\8cf\8e¦\94Â' + i.toString]);
end;
- if FDTable3.Bof and FDTable3.Eof then
+ if (FDTable3.Bof = true) and (FDTable3.Eof = true) then
begin
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>',
- false, i, 30, hash(hash('admin')), s]);
+ 0, i, 30, hash(hash('admin')), s]);
end;
+ admin.MaxRows := FDTable3.FieldByName('count').AsInteger;
end;
end.
OSDN Git Service
