5 uses System.SysUtils, System.Classes, Web.HTTPApp, Web.DSProd, Web.HTTPProd,
6 Web.DBWeb, System.Variants, System.NetEncoding, System.RegularExpressions,
7 Data.DB, Web.DBXpressWeb, System.Types;
10 TTWebModule1 = class(TWebModule)
11 articles: TDataSetPageProducer;
12 index: TDataSetPageProducer;
13 admin: TDataSetTableProducer;
14 search: TPageProducer;
15 items: TDataSetPageProducer;
18 master: TPageProducer;
19 alert: TDataSetPageProducer;
20 footer: TDataSetPageProducer;
26 header: TDataSetPageProducer;
27 login: TDataSetPageProducer;
32 adhead: TPageProducer;
35 ti: TDataSetPageProducer;
36 procedure indexHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
37 TagParams: TStrings; var ReplaceText: string);
38 procedure TWebModule1indexpageAction(Sender: TObject; Request: TWebRequest;
39 Response: TWebResponse; var Handled: Boolean);
40 procedure TWebModule1registAction(Sender: TObject; Request: TWebRequest;
41 Response: TWebResponse; var Handled: Boolean);
42 procedure WebModuleCreate(Sender: TObject);
43 procedure TWebModule1adminAction(Sender: TObject; Request: TWebRequest;
44 Response: TWebResponse; var Handled: Boolean);
45 procedure TWebModule1topAction(Sender: TObject; Request: TWebRequest;
46 Response: TWebResponse; var Handled: Boolean);
47 procedure itemsHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
48 TagParams: TStrings; var ReplaceText: string);
49 procedure topHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
50 TagParams: TStrings; var ReplaceText: string);
51 procedure TWebModule1searchAction(Sender: TObject; Request: TWebRequest;
52 Response: TWebResponse; var Handled: Boolean);
53 procedure TWebModule1helpAction(Sender: TObject; Request: TWebRequest;
54 Response: TWebResponse; var Handled: Boolean);
55 procedure searchHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
56 TagParams: TStrings; var ReplaceText: string);
57 procedure masterHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
58 TagParams: TStrings; var ReplaceText: string);
59 procedure articlesHTMLTag(Sender: TObject; Tag: TTag;
60 const TagString: string; TagParams: TStrings; var ReplaceText: string);
61 procedure footerHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
62 TagParams: TStrings; var ReplaceText: string);
63 procedure TWebModule1alertAction(Sender: TObject; Request: TWebRequest;
64 Response: TWebResponse; var Handled: Boolean);
65 procedure TWebModule1masterAction(Sender: TObject; Request: TWebRequest;
66 Response: TWebResponse; var Handled: Boolean);
67 procedure mailHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
68 TagParams: TStrings; var ReplaceText: string);
69 procedure alertHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
70 TagParams: TStrings; var ReplaceText: string);
71 procedure TWebModule1deleteAction(Sender: TObject; Request: TWebRequest;
72 Response: TWebResponse; var Handled: Boolean);
73 procedure TWebModule1jumpAction(Sender: TObject; Request: TWebRequest;
74 Response: TWebResponse; var Handled: Boolean);
75 procedure TWebModule1linkAction(Sender: TObject; Request: TWebRequest;
76 Response: TWebResponse; var Handled: Boolean);
77 procedure headerHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
78 TagParams: TStrings; var ReplaceText: string);
79 procedure adminFormatCell(Sender: TObject; CellRow, CellColumn: Integer;
80 var BgColor: THTMLBgColor; var Align: THTMLAlign; var VAlign: THTMLVAlign;
81 var CustomAttrs, CellData: string);
82 procedure TWebModule1admdelAction(Sender: TObject; Request: TWebRequest;
83 Response: TWebResponse; var Handled: Boolean);
84 procedure TWebModule1loginAction(Sender: TObject; Request: TWebRequest;
85 Response: TWebResponse; var Handled: Boolean);
86 procedure TWebModule1adminsetAction(Sender: TObject; Request: TWebRequest;
87 Response: TWebResponse; var Handled: Boolean);
88 procedure adheadHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
89 TagParams: TStrings; var ReplaceText: string);
90 procedure TWebModule1logoutAction(Sender: TObject; Request: TWebRequest;
91 Response: TWebResponse; var Handled: Boolean);
92 procedure TWebModule1imgAction(Sender: TObject; Request: TWebRequest;
93 Response: TWebResponse; var Handled: Boolean);
94 procedure TWebModule1fileAction(Sender: TObject; Request: TWebRequest;
95 Response: TWebResponse; var Handled: Boolean);
96 procedure titleHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
97 TagParams: TStrings; var ReplaceText: string);
98 procedure TWebModule1titleAction(Sender: TObject; Request: TWebRequest;
99 Response: TWebResponse; var Handled: Boolean);
100 procedure tiHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
101 TagParams: TStrings; var ReplaceText: string);
102 procedure helpHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
103 TagParams: TStrings; var ReplaceText: string);
104 procedure loginHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
105 TagParams: TStrings; var ReplaceText: string);
109 procedure pages(count: Integer; var page: Integer);
110 function hash(str: string): string;
111 function mente: Boolean;
112 function detail(ts, pid: string): string;
118 WebModuleClass: TComponentClass = TTWebModule1;
122 { %CLASSGROUP 'Vcl.Controls.TControl' }
124 uses Unit1, IdHashSHA, IdGlobal, IdHash, IdHashMessageDigest;
129 promotion = '
\8dL
\8d\90:';
132 procedure TTWebModule1.adheadHTMLTag(Sender: TObject; Tag: TTag;
133 const TagString: string; TagParams: TStrings; var ReplaceText: string);
135 if TagString = 'pr' then
136 ReplaceText := promotion
137 else if (TagString = 'mente') and
138 (DataModule1.FDTable3.FieldByName('mente').AsBoolean = true) then
139 ReplaceText := 'checked'
140 else if TagString = 'password' then
141 ReplaceText := Request.CookieFields.Values['user'];
144 procedure TTWebModule1.adminFormatCell(Sender: TObject;
145 CellRow, CellColumn: Integer; var BgColor: THTMLBgColor;
146 var Align: THTMLAlign; var VAlign: THTMLVAlign;
147 var CustomAttrs, CellData: string);
149 if (CellColumn = 0) and (CellRow > 0) then
150 CellData := Format('<input name=check%d type=checkbox>', [CellRow]);
153 procedure TTWebModule1.alertHTMLTag(Sender: TObject; Tag: TTag;
154 const TagString: string; TagParams: TStrings; var ReplaceText: string);
159 if TagString = 'article' then
163 FDTable1.Locate('dbnum', FDTable4.FieldByName('dbname').AsInteger);
164 FDTable2.Locate('number', FDTable4.FieldByName('posnum').AsInteger);
166 s := TStringList.Create;
168 s.Text := articles.Content;
171 for i := s.count - 1 downto 0 do
172 if Copy(s[i], 1, 18) = '<section id=master' then
177 ReplaceText := s.Text;
182 else if TagString = 'request' then
183 ReplaceText := DataModule1.FDTable4.FieldByName('request').AsString;
186 procedure TTWebModule1.articlesHTMLTag(Sender: TObject; Tag: TTag;
187 const TagString: string; TagParams: TStrings; var ReplaceText: string);
189 if TagString = 'comment' then
190 ReplaceText := DataModule1.FDTable2.FieldByName('comment').AsString;
193 function TTWebModule1.detail(ts, pid: string): string;
197 for i := 0 to ComponentCount - 1 do
198 if Components[i].Name = ts + pid then
199 result := (Components[i] as TPageProducer).Content;
202 procedure TTWebModule1.footerHTMLTag(Sender: TObject; Tag: TTag;
203 const TagString: string; TagParams: TStrings; var ReplaceText: string);
207 if TagString = 'link' then
210 if i = index.Tag then
211 ReplaceText := ReplaceText + ' ' + i.ToString + ' '
213 ReplaceText := ReplaceText +
214 Format(' <a style=text-decoration-line:none href="%s?db=%d&num=%d">%d</a> ',
215 [PString(Self.Tag)^, DataModule1.FDTable1.FieldByName('dbnum')
218 else if TagString = 'recent' then
219 if index.Tag = -1 then
220 ReplaceText := TagString
222 ReplaceText := '<a style=text-decoration-line:none href="' +
223 PString(Self.Tag)^ + '?db=' + DataModule1.FDTable1.FieldByName('dbnum')
224 .AsString + '">recent</a>';
227 function TTWebModule1.hash(str: string): string;
229 with TIdHashSHA1.Create do
232 result := HashStringAsHex(str);
239 procedure TTWebModule1.headerHTMLTag(Sender: TObject; Tag: TTag;
240 const TagString: string; TagParams: TStrings; var ReplaceText: string);
244 if TagString = 'cookie' then
246 s := TagParams.Values['param'];
247 ReplaceText := TNetEncoding.URL.Decode(Request.CookieFields.Values[s]);
249 else if (TagString = 'check') and
250 (Request.ContentFields.Values['show'] <> 'false') then
251 ReplaceText := 'checked'
252 else if TagString = 'preview' then
253 ReplaceText := Request.ContentFields.Values['preview']
254 else if TagString = 'raw' then
255 ReplaceText := Request.ContentFields.Values['raw']
256 else if TagString = 'pass' then
257 ReplaceText := Request.ContentFields.Values['password']
258 else if TagString = 'title' then
259 ReplaceText := Request.ContentFields.Values['title'];
262 procedure TTWebModule1.helpHTMLTag(Sender: TObject; Tag: TTag;
263 const TagString: string; TagParams: TStrings; var ReplaceText: string);
265 if TagString = 'pr' then
266 ReplaceText := promotion;
269 procedure TTWebModule1.indexHTMLTag(Sender: TObject; Tag: TTag;
270 const TagString: string; TagParams: TStrings; var ReplaceText: string);
275 if TagString = 'pr' then
276 ReplaceText := promotion
277 else if TagString = 'article' then
279 x := DataModule1.FDTable1.FieldByName('dbnum')
280 .AsInteger = DataModule1.FDTable3.FieldByName('info').AsInteger;
281 for i := 1 to DataModule1.FDTable3.FieldByName('count').AsInteger do
283 if DataModule1.FDTable2.Eof = true then
286 ReplaceText := ReplaceText + articles.Content
288 ReplaceText := articles.Content + ReplaceText;
289 if DataModule1.FDTable2.Eof = false then
290 DataModule1.FDTable2.Next;
293 else if TagString = 'footer' then
294 ReplaceText := footer.Content
295 else if TagString = 'header' then
297 i := DataModule1.FDTable3.FieldByName('count').AsInteger;
298 if 10 * i <= DataModule1.FDTable2.RecordCount then
299 ReplaceText := '<h1>
\82±
\82ê
\88È
\8fã
\93\8a\8de
\82Å
\82«
\82Ü
\82¹
\82ñ.</h1>'
301 ReplaceText := header.Content;
303 else if (TagString = 'css') or (TagString = 'js') then
304 ReplaceText := detail(TagString, TagParams.Values['id'])
305 else if TagString = 'dbnum' then
306 ReplaceText := DataModule1.FDTable1.FieldByName('dbnum').AsString
307 else if TagString = 'database' then
308 ReplaceText := DataModule1.FDTable1.FieldByName('database').AsString;
311 procedure TTWebModule1.itemsHTMLTag(Sender: TObject; Tag: TTag;
312 const TagString: string; TagParams: TStrings; var ReplaceText: string);
318 if TagString = 'item' then
320 s := TStringList.Create;
322 s.Text := DataModule1.FDTable2.FieldByName('raw').AsString;
323 for i := 0 to s.count - 1 do
324 for j := 0 to ss.count - 1 do
325 if Pos(ss[j], s[i]) > 0 then
327 s[i] := '<p style=background-color:aqua>' + s[i]
329 s[i] := '<p style=background-color:yellow>' + s[i];
330 with DataModule1.FDTable2 do
332 i := FieldByName('dbnum').AsInteger;
333 j := FieldByName('number').AsInteger;
334 str := Request.QueryFields.Values['db'];
336 t := Format('<a href="/jump?db=%d&num=%d">[ %d-%d ]</a>',
337 [DataModule1.FDTable1.FieldByName('dbnum').AsInteger, j, i, j])
339 t := Format('<a href="/jump?db=%s&num=%d">[ %d ]</a>', [str, j, j]);
341 ReplaceText := t + s.Text;
348 procedure TTWebModule1.loginHTMLTag(Sender: TObject; Tag: TTag;
349 const TagString: string; TagParams: TStrings; var ReplaceText: string);
351 if TagString = 'pr' then
352 ReplaceText := promotion;
355 procedure TTWebModule1.masterHTMLTag(Sender: TObject; Tag: TTag;
356 const TagString: string; TagParams: TStrings; var ReplaceText: string);
358 if TagString = 'pr' then
359 ReplaceText := promotion
360 else if TagString = 'request' then
361 with DataModule1.FDTable4 do
364 ReplaceText := '<table border=1 align=center>';
367 ReplaceText := ReplaceText + alert.Content;
370 ReplaceText := ReplaceText + '</table>';
374 function TTWebModule1.mente: Boolean;
376 if DataModule1.FDTable3.FieldByName('mente').AsBoolean = true then
380 '<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>' +
381 '<p style=text-align:center><a href=/admin>
\8aÇ
\97\9d\8eÒ
\97p
\83\8d\83O
\83C
\83\93</a>'
387 procedure TTWebModule1.pages(count: Integer; var page: Integer);
391 max := DataModule1.FDTable3.FieldByName('count').AsInteger;
392 if (page > -1) and (count < max * (page - 1)) then
394 page := (count div max) + 1;
395 if count mod max = 0 then
401 DataModule1.FDTable2.Last;
402 DataModule1.FDTable2.MoveBy(1 - max);
405 DataModule1.FDTable2.First;
406 DataModule1.FDTable2.MoveBy(max * (page - 1));
410 procedure TTWebModule1.mailHTMLTag(Sender: TObject; Tag: TTag;
411 const TagString: string; TagParams: TStrings; var ReplaceText: string);
413 if TagString = 'pr' then
414 ReplaceText := promotion
415 else if TagString = 'content' then
416 ReplaceText := articles.Content
417 else if TagString = 'query' then
418 ReplaceText := '?' + Request.Query
419 else if TagString = 'number' then
420 ReplaceText := Request.QueryFields.Values['num'];
423 procedure TTWebModule1.searchHTMLTag(Sender: TObject; Tag: TTag;
424 const TagString: string; TagParams: TStrings; var ReplaceText: string);
433 DataModule1.FDTable2.First;
434 while DataModule1.FDTable2.Eof = false do
436 s.Text := DataModule1.FDTable2.FieldByName('raw').AsString;
437 ss.DelimitedText := Request.ContentFields.Values['word1'];
438 for j := 0 to ss.count - 1 do
439 for i := 0 to s.count - 1 do
440 if Pos(ss[j], s[i]) > 0 then
443 ReplaceText := ReplaceText + items.Content;
448 if j = ss.count - 1 then
450 ReplaceText := ReplaceText + items.Content;
456 else if i = s.count - 1 then
459 DataModule1.FDTable2.Next;
464 if TagString = 'pr' then
465 ReplaceText := promotion
466 else if (Request.MethodType = mtPost) and (TagString = 'items') then
468 if Request.ContentFields.Values['type'] = 'OR' then
472 s := TStringList.Create;
473 ss := TStringList.Create;
476 ss.StrictDelimiter := false;
477 if Request.QueryFields.Values['db'] = '' then
479 DataModule1.FDTable1.First;
480 while DataModule1.FDTable1.Eof = false do
483 DataModule1.FDTable1.Next;
493 else if TagString = 'query' then
495 ReplaceText := Request.Query;
496 if ReplaceText <> '' then
497 ReplaceText := '?' + ReplaceText;
499 else if TagString = 'css' then
500 ReplaceText := css2.Content;
503 procedure TTWebModule1.tiHTMLTag(Sender: TObject; Tag: TTag;
504 const TagString: string; TagParams: TStrings; var ReplaceText: string);
506 if TagString = 'count' then
508 DataModule1.FDTable1.Locate('dbnum',
509 DataModule1.FDQuery1.FieldByName('dbnum').AsInteger);
510 ReplaceText := DataModule1.FDTable2.RecordCount.ToString;
512 else if TagString = 'database' then
513 ReplaceText := DataModule1.FDTable1.Lookup('dbnum',
514 DataModule1.FDQuery1.FieldByName('dbnum').AsInteger, 'database');
517 procedure TTWebModule1.titleHTMLTag(Sender: TObject; Tag: TTag;
518 const TagString: string; TagParams: TStrings; var ReplaceText: string);
520 if TagString = 'pr' then
521 ReplaceText := promotion
522 else if TagString = 'js' then
523 ReplaceText := detail(TagString, TagParams.Values['id'])
524 else if TagString = 'main' then
525 with DataModule1.FDQuery1 do
530 ReplaceText := ReplaceText + ti.Content;
537 procedure TTWebModule1.topHTMLTag(Sender: TObject; Tag: TTag;
538 const TagString: string; TagParams: TStrings; var ReplaceText: string);
543 if TagString = 'pr' then
544 ReplaceText := promotion
545 else if TagString = 'list' then
547 i := DataModule1.FDTable3.FieldByName('info').AsInteger;
548 for k := 0 to tcnt do
550 if DataModule1.FDTable1.Eof = true then
553 j := DataModule1.FDTable1.FieldByName('dbnum').AsInteger;
556 DataModule1.FDTable1.Next;
559 s := DataModule1.FDTable1.FieldByName('database').AsString;
560 DataModule1.FDTable2.Last;
561 if Now - DataModule1.FDTable2.FieldByName('date').AsDateTime < 1 then
562 t := 'background-color:aqua;';
563 if DataModule1.FDTable2.RecordCount >= 10 *
564 DataModule1.FDTable3.FieldByName('count').AsInteger then
565 t := t + 'color:red;';
568 ReplaceText := ReplaceText +
569 Format('<p><a%s target=_blank href="/index?db=%d">%s</a><br></p>',
571 DataModule1.FDTable1.Next;
574 else if TagString = 'info' then
575 ReplaceText := DataModule1.FDTable1.Lookup('dbnum',
576 DataModule1.FDTable3.FieldByName('info').AsInteger, 'database')
577 else if TagString = 'dbnum' then
578 ReplaceText := DataModule1.FDTable3.FieldByName('info').AsString
579 else if (TagString = 'css') or (TagString = 'js') then
580 ReplaceText := detail(TagString, TagParams.Values['id'])
581 else if TagString = 'slide' then
583 for i := 1 to (DataModule1.FDTable1.RecordCount div tcnt) + 1 do
584 ReplaceText := ReplaceText +
585 '<div class="slide"><img src="/src?name=slide' + i.ToString +
586 '.jpg" style=float:right;height:465px><#list></div>';
590 procedure TTWebModule1.TWebModule1admdelAction(Sender: TObject;
591 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
598 DataModule1.FDTable2.RecNo := admin.Tag;
599 for i := 0 to Request.ContentFields.count - 1 do
601 reg := TRegEx.Create('\d+');
602 match := reg.match(Request.ContentFields[i]);
603 if match.Success = true then
605 k := match.Value.ToInteger - j - 1;
606 j := match.Value.ToInteger;
608 DataModule1.FDTable2.Next;
609 DataModule1.FDTable2.Delete;
612 TWebModule1adminAction(nil, Request, Response, Handled);
615 procedure TTWebModule1.TWebModule1adminAction(Sender: TObject;
616 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
621 if hash(Request.CookieFields.Values['user']) <>
622 DataModule1.FDTable3.FieldByName('password').AsString then
624 Response.SendRedirect('/login');
627 admin.MaxRows := DataModule1.FDTable3.FieldByName('count').AsInteger;
628 s := Request.QueryFields.Values['db'];
630 DataModule1.FDTable1.Locate('dbnum', s, []);
631 s := Request.QueryFields.Values['num'];
632 i := StrToIntDef(s, -1);
633 pages(DataModule1.FDTable2.RecordCount, i);
636 Self.Tag := Integer(@s);
637 i := footer.HTMLDoc.Add
638 ('<p style=text-align:center><a href="/index?db=<#dbnum>">
\96ß
\82é</a>');
639 admin.header.Text := adhead.Content;
640 if admin.Tag = 0 then
641 admin.footer.Insert(3, footer.Content)
644 admin.footer.Delete(3);
645 admin.footer.Insert(3, footer.Content);
647 admin.Tag := DataModule1.FDTable2.RecNo;
648 footer.HTMLDoc.Delete(i);
649 Response.ContentType := 'text/html;charset=utf-8';
650 Response.Content := admin.Content;
653 procedure TTWebModule1.TWebModule1adminsetAction(Sender: TObject;
654 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
658 s := Request.ContentFields.Values['pass'];
659 with DataModule1.FDTable3 do
662 FieldByName('mente').AsBoolean := Request.ContentFields.Values
664 FieldByName('password').AsString := hash(s);
667 with Response.Cookies.Add do
674 Request.CookieFields.Values['user'] := s;
675 TWebModule1adminAction(nil, Request, Response, Handled);
678 procedure TTWebModule1.TWebModule1alertAction(Sender: TObject;
679 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
681 num1, num2, i, dbnum: Integer;
683 dbnum := DataModule1.FDTable1.FieldByName('dbnum').AsInteger;
684 num1 := DataModule1.FDTable1.FieldByName('dbnum').AsInteger;
685 num2 := Request.QueryFields.Values['num'].ToInteger;
686 if Request.MethodType = mtGet then
688 DataModule1.FDTable2.Locate('number', num2, []);
689 Response.ContentType := 'text/html;charset=utf-8';
690 Response.Content := mail.Content;
693 with DataModule1.FDTable4 do
696 i := FieldByName('id').AsInteger + 1;
697 AppendRecord([i, num1, num2, Now, Request.ContentFields.Values
699 pages(DataModule1.FDTable2.RecNo, i);
700 Response.SendRedirect(Format('/index?db=%d&num=%d#%d', [dbnum, i, num2]));
704 procedure TTWebModule1.TWebModule1deleteAction(Sender: TObject;
705 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
710 s := Request.ContentFields.Values['num'];
714 s := hash(Request.ContentFields.Values['password']);
715 with DataModule1.FDTable2 do
716 if Locate('number;pass', VarArrayOf([num, s])) = true then
719 FieldByName('title').AsString := '';
720 FieldByName('name').AsString := ' - - - ';
721 FieldByName('comment').AsString := '<em>
\93\8a\8de
\8eÒ
\82É
\82æ
\82è
\8dí
\8f\9c\82³
\82ê
\82Ü
\82µ
\82½.</em>';
722 FieldByName('raw').AsString := '';
723 FieldByName('date').AsDateTime := Now;
725 TWebModule1jumpAction(nil, Request, Response, Handled);
728 TWebModule1indexpageAction(nil, Request, Response, Handled);
731 procedure TTWebModule1.TWebModule1fileAction(Sender: TObject;
732 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
736 s := Request.QueryFields.Values['type'];
738 Response.ContentType := 'text/javascript'
739 else if s = 'css' then
740 Response.ContentType := 'text/css';
741 Response.Content := detail(s, Request.QueryFields.Values['id']);
744 procedure TTWebModule1.TWebModule1helpAction(Sender: TObject;
745 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
750 Response.ContentType := 'text/html;charset=utf-8';
751 if Request.MethodType = mtPost then
753 i := DataModule1.FDTable1.FieldByName('dbnum').AsInteger;;
754 j := DataModule1.FDTable2.FieldByName('number').AsInteger;
755 s := Request.ContentFields.Values['help'];
756 DataModule1.FDTable4.AppendRecord([i, j, s]);
758 Response.Content := help.Content;
761 procedure TTWebModule1.TWebModule1imgAction(Sender: TObject;
762 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
765 res: TResourceStream;
767 with DataModule1.FDTable5 do
769 s:= Request.ContentFields.Values['name'];
770 Response.ContentType := 'image/jpeg';
771 if Locate('name', s) = true then
772 Response.ContentStream := CreateBlobStream(FieldByName('source'), bmRead)
774 if s = 'sprites.png' then
776 res:=TResourceStream.Create(HInstance,'PngImage_1',RT_RCDATA);
778 Response.ContentStream:=res;
784 Response.ContentStream:=nil;
788 procedure TTWebModule1.TWebModule1indexpageAction(Sender: TObject;
789 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
794 s := Request.QueryFields.Values['db'];
796 DataModule1.FDTable1.Locate('dbnum', s, []);
797 int := StrToIntDef(Request.QueryFields.Values['num'], -1);
798 pages(DataModule1.FDTable2.RecordCount, int);
801 Self.Tag := Integer(@s);
802 Response.ContentType := 'text/html; charset="utf-8"';
803 if mente = false then
804 Response.Content := index.Content;
807 procedure TTWebModule1.TWebModule1jumpAction(Sender: TObject;
808 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
813 DB := Request.QueryFields.Values['db'];
814 s := Request.ContentFields.Values['num'];
816 DataModule1.FDTable1.Locate('dbnum', DB.ToInteger, []);
817 DataModule1.FDTable2.Locate('number', s.ToInteger, []);
819 pages(DataModule1.FDTable2.RecNo, page);
820 Response.SendRedirect(Format('/index?db=%s&num=%d#%s', [DB, page, s]));
823 procedure TTWebModule1.TWebModule1linkAction(Sender: TObject;
824 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
829 s := Request.QueryFields.Values['num'];
833 if DataModule1.FDTable2.Locate('number', num, []) = true then
835 Response.ContentType := 'text/html;charset=utf-8';
836 Response.Content := articles.Content;
840 procedure TTWebModule1.TWebModule1loginAction(Sender: TObject;
841 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
845 if Request.MethodType = mtGet then
847 Response.ContentType := 'text/html;charset=utf-8';
848 Response.Content := login.Content;
851 with Response.Cookies.Add do
854 Value := Request.ContentFields.Values['password'];
858 i := DataModule1.FDTable1.Lookup('database',
859 Request.ContentFields.Values['record'], 'dbnum');
860 Response.SendRedirect('/admin?db=' + i.ToString);
863 procedure TTWebModule1.TWebModule1logoutAction(Sender: TObject;
864 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
866 with Response.Cookies.Add do
871 TWebModule1indexpageAction(nil, Request, Response, Handled);
874 procedure TTWebModule1.TWebModule1masterAction(Sender: TObject;
875 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
880 if Request.MethodType = mtPost then
882 s := Request.ContentFields.Values['delete'];
884 with DataModule1.FDTable4 do
885 while (Bof = false) or (Eof = false) do
889 DataModule1.FDTable4.First;
890 while DataModule1.FDTable4.Eof = false do
892 i := DataModule1.FDTable4.FieldByName('dbname').AsInteger;
893 if DataModule1.FDTable1.Locate('dbnum', i) = true then
895 i := DataModule1.FDTable4.FieldByName('posnum').AsInteger;
896 if DataModule1.FDTable2.Locate('number', i) = false then
898 DataModule1.FDTable4.Delete;
902 DataModule1.FDTable4.Next;
906 Response.ContentType := 'text/html;charset=utf-8';
907 Response.Content := master.Content;
910 procedure TTWebModule1.TWebModule1registAction(Sender: TObject;
911 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
914 title, na, raw, pass, kotoba, error: string;
915 comment: TStringList;
917 function scan(Text: string): string;
920 coll: TMatchCollection;
924 Text := TNetEncoding.HTML.Encode(Text);
925 s := TNetEncoding.HTML.Encode('>>');
926 reg := TRegEx.Create(s + '(\d+)');
927 coll := reg.Matches(Text);
928 for j := coll.count - 1 downto 0 do
930 Delete(Text, coll[j].index, coll[j].Length);
931 t := Copy(coll[j].Value, Length(s) + 1, coll[j].Length);
933 ('<a class=minpreview data-preview-url=/link?num=%s href=/jump?num=%s>>>%s</a>',
935 Insert(result, Text, coll[j].index);
942 kotoba := Request.ContentFields.Values['aikotoba'];
943 if kotoba <> '
\82°
\82ñ
\82«' then
944 error := '<section style=color:red><p>
\8d\87\8c¾
\97t
\82ª
\82¿
\82ª
\82¢
\82Ü
\82·.';
945 with DataModule1.FDTable2 do
948 number := FieldByName('number').AsInteger + 1;
950 with Request.ContentFields do
952 title := Values['title'];
953 na := Values['name'];
954 raw := Values['comment'];
955 pass := hash(Values['password']);
958 title := '
\83^
\83C
\83g
\83\8b\82È
\82µ.';
959 with Response.Cookies.Add do
963 Value := '
\92N
\82©
\82³
\82ñ.'
969 with Response.Cookies.Add do
975 comment := TStringList.Create;
978 for i := 0 to comment.count - 1 do
980 if Pos('ng', comment[i]) > 0 then
982 error := error + '<p>
\8bÖ
\8e~
\8cê
\8bå
\82ª
\8aÜ
\82Ü
\82ê
\82Ä
\82¢
\82Ü
\82·.';
985 comment[i] := '<p>' + scan(comment[i]);
987 x := Request.ContentFields.Values['show'] = 'true';
989 error := error + '</section>'
990 else if x = true then
992 error := '<p style=font-size:2.3em;color:blue>
\81«
\81«
\83v
\83\8c\83r
\83\85\81[
\81«
\81«<p>' +
994 Request.ContentFields.Values['show'] := 'false';
995 Request.ContentFields.Values['preview'] := error;
996 Request.ContentFields.Values['raw'] := raw;
1000 i := DataModule1.FDTable1.FieldByName('dbnum').AsInteger;
1001 DataModule1.FDTable2.AppendRecord([i, number, title, na, comment.Text,
1003 Response.SendRedirect('index?db=' + i.ToString + '#article');
1009 TWebModule1indexpageAction(nil, Request, Response, Handled);
1012 procedure TTWebModule1.TWebModule1searchAction(Sender: TObject;
1013 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1015 Response.ContentType := 'text/html;charset=utf-8';
1016 Response.Content := search.Content;
1019 procedure TTWebModule1.TWebModule1titleAction(Sender: TObject;
1020 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1022 Response.ContentType := 'text/html;charset=utf-8';
1023 Response.Content := title.Content;
1026 procedure TTWebModule1.TWebModule1topAction(Sender: TObject;
1027 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
1029 Response.ContentType := 'text/html;charset=utf-8';
1030 DataModule1.FDTable1.First;
1031 if mente = false then
1032 Response.Content := top.ContentFromString(top.Content);
1035 procedure TTWebModule1.WebModuleCreate(Sender: TObject);
1042 if FDTable1.Exists = false then
1043 FDTable1.CreateTable;
1044 if FDTable2.Exists = false then
1045 FDTable2.CreateTable;
1046 if FDTable3.Exists = false then
1047 FDTable3.CreateTable;
1048 if FDTable4.Exists = false then
1049 FDTable4.CreateTable;
1050 if FDTable5.Exists = false then
1051 FDTable5.CreateTable;
1061 if DataModule1.FDTable1.Bof and DataModule1.FDTable1.Eof then
1063 DataModule1.FDTable1.AppendRecord([0, 'info']);
1065 DataModule1.FDTable1.AppendRecord([i, '
\8cf
\8e¦
\94Â' + i.ToString]);
1067 if DataModule1.FDTable3.Bof and DataModule1.FDTable3.Eof then
1069 a := DataModule1.FDTable1.Lookup('database', 'info', 'dbnum');
1070 DataModule1.FDTable3.AppendRecord
1071 (['
\82Æ
\82é
\82Ë
\81`
\82Ç
\8d\86',
1072 '<h1 style=color:maron;text-align:center;font-style:italic>
\82Æ
\82é
\82Ë
\81`
\82Ç
\8d\86</h1>',
1073 false, a, 30, hash('admin')]);