Develop and Download Open Source Software

Browse Subversion Repository

Contents of /WebModuleUnit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 20 - (show annotations) (download) (as text)
Thu Sep 29 14:15:09 2016 UTC (7 years, 6 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 23102 byte(s)
Error occurred while calculating annotation data.
アーカイブの問題をクリア
ユーザーがだれでも使えるようにした
1 unit WebModuleUnit1;
2
3
4 interface
5
6 uses System.SysUtils, System.Classes, Web.HTTPApp, FireDAC.Stan.Intf,
7 FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS,
8 FireDAC.Phys.Intf, FireDAC.DApt.Intf, FireDAC.Stan.Async, FireDAC.DApt,
9 FireDAC.UI.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Phys,
10 FireDAC.Phys.SQLite, FireDAC.Phys.SQLiteDef, FireDAC.Stan.ExprFuncs, Data.DB,
11 FireDAC.Comp.Client, FireDAC.Comp.DataSet, Web.HTTPProd, Web.DSProd,
12 AnsiStrings, System.DateUtils, System.Types, Vcl.AppEvnts, System.NetEncoding;
13
14 type
15 TWebModule1 = class(TWebModule)
16 FDTable2: TFDTable;
17 FDTable2home: TWideMemoField;
18 FDTable2title: TWideMemoField;
19 FDTable2title2: TWideMemoField;
20 FDTable2pass: TWideMemoField;
21 PageProducer1: TPageProducer;
22 DataSetPageProducer2: TDataSetPageProducer;
23 adminDS: TDataSetPageProducer;
24 FDTable2ngwords: TWideMemoField;
25 FDTable3: TFDTable;
26 FDTable3link: TIntegerField;
27 FDTable3count: TIntegerField;
28 FDTable3line: TIntegerField;
29 FDTable2mente: TBooleanField;
30 FDTable1: TFDTable;
31 FDTable1name: TWideMemoField;
32 FDTable1no: TIntegerField;
33 FDTable1date: TWideMemoField;
34 FDTable1sub: TWideMemoField;
35 FDTable1com: TWideMemoField;
36 FDTable1pass: TWideMemoField;
37 FDTable1line: TIntegerField;
38 FDConnection1: TFDConnection;
39 procedure WebModule1DefaultHandlerAction(Sender: TObject;
40 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
41 procedure PageProducer1HTMLTag(Sender: TObject; Tag: TTag;
42 const TagString: string; TagParams: TStrings; var ReplaceText: string);
43 procedure WebModule1registAction(Sender: TObject; Request: TWebRequest;
44 Response: TWebResponse; var Handled: Boolean);
45 procedure DataSetPageProducer2HTMLTag(Sender: TObject; Tag: TTag;
46 const TagString: string; TagParams: TStrings; var ReplaceText: string);
47 procedure WebModule1userdelAction(Sender: TObject; Request: TWebRequest;
48 Response: TWebResponse; var Handled: Boolean);
49 procedure WebModule1adminAction(Sender: TObject; Request: TWebRequest;
50 Response: TWebResponse; var Handled: Boolean);
51 procedure WebModule1admindelAction(Sender: TObject; Request: TWebRequest;
52 Response: TWebResponse; var Handled: Boolean);
53 procedure WebModule1loginAction(Sender: TObject; Request: TWebRequest;
54 Response: TWebResponse; var Handled: Boolean);
55 procedure WebModuleBeforeDispatch(Sender: TObject; Request: TWebRequest;
56 Response: TWebResponse; var Handled: Boolean);
57 procedure WebModule1setupAction(Sender: TObject; Request: TWebRequest;
58 Response: TWebResponse; var Handled: Boolean);
59 procedure WebModule1searchAction(Sender: TObject; Request: TWebRequest;
60 Response: TWebResponse; var Handled: Boolean);
61 procedure WebModuleCreate(Sender: TObject);
62 procedure WebModuleDestroy(Sender: TObject);
63 procedure WebModule1adminsetAction(Sender: TObject; Request: TWebRequest;
64 Response: TWebResponse; var Handled: Boolean);
65 procedure WebModule1cssAction(Sender: TObject; Request: TWebRequest;
66 Response: TWebResponse; var Handled: Boolean);
67 procedure WebModuleAfterDispatch(Sender: TObject; Request: TWebRequest;
68 Response: TWebResponse; var Handled: Boolean);
69 procedure WebModule1archivesAction(Sender: TObject; Request: TWebRequest;
70 Response: TWebResponse; var Handled: Boolean);
71 private
72 { private ���� }
73 public
74 { public ���� }
75 user: string;
76 time: Int64;
77 words: TStringList;
78 position: integer;
79 uri: string;
80 er: string;
81 foo: string;
82 function footer(const path: string): string;
83 procedure regist(var com: string);
84 function search: string;
85 end;
86
87 var
88 WebModuleClass: TComponentClass = TWebModule1;
89
90 implementation
91
92 { %CLASSGROUP 'Vcl.Controls.TControl' }
93
94 {$R *.dfm}
95
96 procedure TWebModule1.DataSetPageProducer2HTMLTag(Sender: TObject; Tag: TTag;
97 const TagString: string; TagParams: TStrings; var ReplaceText: string);
98 begin
99 ReplaceText := FDTable1.FieldByName(TagString).AsString;
100 if TagString = 'com' then
101 regist(ReplaceText);
102 end;
103
104 function TWebModule1.footer(const path: string): string;
105 var
106 s1, s2, t1, t2: string;
107 home: string;
108 i, k, count: integer;
109 function linkcontent: string;
110 var
111 j, link: integer;
112 begin
113 result := '';
114 link := FDTable3.FieldByName('link').AsInteger;
115 if position > link div 2 then
116 begin
117 if (FDTable1.RecordCount - 1) div count < position + link div 2 then
118 i := FDTable1.RecordCount div count - link - position
119 else
120 i := -(link div 2)
121 end
122 else if position = -1 then
123 i := -position + FDTable1.RecordCount div count - link
124 else
125 i := -position;
126 for j := 0 to link do
127 begin
128 if FDTable1.RecordCount <= (position + i + j) * count then
129 break;
130 if position + i + j < 0 then
131 continue;
132 if i + j = 0 then
133 result := result + ' ' + IntToStr(position + 1) + ' '
134 else
135 result := result + Format(' <a href="' + home + path +
136 '?pos=%d#article">%d</a> ',
137 [position + i + j, position + 1 + i + j]);
138 end;
139 end;
140
141 begin
142 count := FDTable3.FieldByName('count').AsInteger;
143 home := FDTable2.FieldByName('home').AsString;
144 if position <= -1 then
145 begin
146 s1 := '<nav>���V%d�����L�����\��<br><center>Pages : [<b>';
147 s2 := '<<' + linkcontent + '>></b>] <b>���V</b><br></center></nav>';
148 result := Format(s1, [count]) + s2;
149 end
150 else
151 begin
152 if position = 0 then
153 t1 := '?pos=0'
154 else
155 t1 := '?pos=' + IntToStr(position - 1);
156 i := (FDTable1.RecordCount - 1) div count;
157 if position > i then
158 position := i;
159 if position = i then
160 begin
161 t2 := '?pos=' + position.ToString + '#article';
162 k := FDTable1.RecordCount;
163 end
164 else
165 begin
166 t2 := '?pos=' + IntToStr(position + 1) + '#article';
167 k := (position + 1) * count;
168 end;
169 s1 := '<nav>%d ���� %d ������ %d �������\��<br><center>Page : [<b>';
170 s2 := '<a href="' + home + path + t1 + '#article"><<</a>' + linkcontent +
171 '<a href="' + home + path + t2 + '">>></a></b>] <b><a href="' + home +
172 path + '#article">���V</a></b></center></nav>';
173 result := Format(s1, [FDTable1.RecordCount, position * count + 1, k]) + s2;
174 end;
175 end;
176
177 procedure TWebModule1.PageProducer1HTMLTag(Sender: TObject; Tag: TTag;
178 const TagString: string; TagParams: TStrings; var ReplaceText: string);
179 var
180 i, j, count: integer;
181 s: TDataSetPageProducer;
182 begin
183 if TagString = 'home' then
184 ReplaceText := FDTable2.FieldByName('home').AsString;
185 if (TagString = 'title') or (TagString = 'title2') then
186 ReplaceText := FDTable2.FieldByName(TagString).AsString;
187 if TagString = 'username' then
188 ReplaceText := user;
189 if TagString = 'main' then
190 begin
191 if FDTable1.RecordCount = 0 then
192 begin
193 if uri = '/index' then
194 ReplaceText := '<hr>�������e������������.<hr>';
195 end
196 else
197 begin
198 count := FDTable3.FieldByName('count').AsInteger;
199 if uri = '/admin' then
200 s := adminDS
201 else
202 s := DataSetPageProducer2;
203 if position < -1 then
204 position := -1;
205 if (position + 1) * count > FDTable1.RecordCount then
206 position := (FDTable1.RecordCount - 1) div count;
207 if position = -1 then
208 begin
209 if FDTable1.RecordCount < count then
210 j := FDTable1.RecordCount mod count
211 else
212 j := count;
213 end
214 else if FDTable1.RecordCount < (position + 1) * count then
215 j := FDTable1.RecordCount - position * count
216 else
217 j := count;
218 if position = -1 then
219 FDTable1.Last
220 else
221 FDTable1.RecNo := (position + 1) * count;
222 for i := 1 to j do
223 begin
224 ReplaceText := ReplaceText + s.Content;
225 FDTable1.Prior;
226 end;
227 ReplaceText := '<article>' + ReplaceText + '</article>' + '<hr>';
228 end;
229 end;
230 if TagString = 'footer' then
231 if foo <> '' then
232 ReplaceText := foo
233 else
234 begin
235 foo := footer(uri);
236 ReplaceText := foo;
237 end;
238 if TagString = 'text' then
239 if FDTable1.Filtered = false then
240 ReplaceText := '����������'
241 else
242 ReplaceText := '�Y������ ' + IntToStr(FDTable1.RecordCount) + ' ��' +
243 '<br><#main>';
244 if TagString = 'pass' then
245 ReplaceText := FDTable2.FieldByName('pass').AsString;
246 if TagString = 'content' then
247 ReplaceText := er;
248 if (TagString = 'mente') and (FDTable2.FieldByName('mente').AsBoolean = True)
249 then
250 ReplaceText := 'checked="checked"';
251 if TagString = 'archives' then
252 ReplaceText := search;
253 end;
254
255 procedure TWebModule1.regist(var com: string);
256 var
257 i: integer;
258 s: TStringList;
259 begin
260 s := TStringList.Create;
261 try
262 s.Text := com;
263 for i := 0 to s.count - 1 do
264 s[i] := '<p>' + s[i] + '</p>';
265 com := s.Text;
266 finally
267 s.Free;
268 end;
269 end;
270
271 function TWebModule1.search: string;
272 var
273 s: TSearchRec;
274 t: TStringList;
275 i: integer;
276 begin
277 t := TStringList.Create;
278 try
279 if FindFirst('.\*.sdb', 0, s) = 0 then
280 begin
281 repeat
282 t.Add(s.Name);
283 until FindNext(s) <> 0;
284 for i := 0 to t.count - 1 do
285 case i mod 5 of
286 0:
287 t[i] := String.Format
288 ('<tr><td><a href=%s/archives?name=%s>%s</a></td>',
289 [FDTable2.FieldByName('home').AsString, t[i], t[i]]);
290 4:
291 t[i] := String.Format
292 ('<td><a href=%s/archives?name=%s>%s</a></td></tr>',
293 [FDTable2.FieldByName('home').AsString, t[i], t[i]]);
294 else
295 t[i] := String.Format('<td><a href=%s/archives?name=%s>%s</a></td>',
296 [FDTable2.FieldByName('home').AsString, t[i], t[i]]);
297 end;
298 end;
299 result := '<table border=1>' + t.Text + '</table>';
300 finally
301 FindClose(s);
302 t.Free;
303 end;
304 end;
305
306 procedure TWebModule1.WebModule1adminAction(Sender: TObject;
307 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
308 var
309 t: string;
310 x: Boolean;
311 procedure something;
312 var
313 s: TResourceStream;
314 begin
315 x := false;
316 s := TResourceStream.Create(HInstance, 'admin', RT_RCDATA);
317 try
318 uri := '/admin';
319 Response.ContentType := 'text/html; charset=utf-8;';
320 Response.Content := PageProducer1.ContentFromStream(s)
321 finally
322 s.Free;
323 end;
324 end;
325 procedure addcookie(day: integer; pass: string);
326 begin
327 with Response.Cookies.Add do
328 begin
329 path := '/';
330 Expires := Now + day;
331 Name := 'psw';
332 Value := AnsiString(pass);
333 end;
334 end;
335
336 begin
337 if Request.Query = 'del' then
338 begin
339 addcookie(-3, '');
340 Response.SendRedirect(FDTable2.FieldByName('home').AsAnsiString + '/');
341 Exit;
342 end;
343 x := True;
344 t := Request.ContentFields.Values['password'];
345 position := StrToIntDef(Request.QueryFields.Values['pos'], -1);
346 if t <> '' then
347 begin
348 addcookie(14, t);
349 if t = FDTable2.FieldByName('pass').AsString then
350 something;
351 end
352 else if Request.CookieFields.Values['psw'] = FDTable2.FieldByName('pass').AsString
353 then
354 something;
355 if x = True then
356 Response.SendRedirect(FDTable2.FieldByName('home').AsAnsiString + '/login');
357 end;
358
359 procedure TWebModule1.WebModule1admindelAction(Sender: TObject;
360 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
361 var
362 i: integer;
363 begin
364 for i := 0 to Request.ContentFields.count - 1 do
365 if FDTable1.Locate('no', Request.ContentFields.ValueFromIndex[i], []) = True
366 then
367 FDTable1.Delete;
368 Response.SendRedirect(FDTable2.FieldByName('home').AsAnsiString + '/admin');
369 end;
370
371 procedure TWebModule1.WebModule1adminsetAction(Sender: TObject;
372 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
373 var
374 s: string;
375 x: Boolean;
376 begin
377 s := Request.ContentFields.Values['pass'];
378 if FDTable2.FieldByName('pass').AsString <> s then
379 begin
380 FDTable2.Edit;
381 FDTable2.FieldByName('pass').AsString := s;
382 FDTable2.Post;
383 with Response.Cookies.Add do
384 begin
385 path := '/';
386 Expires := Now + 14;
387 Name := 'psw';
388 Value := AnsiString(s);
389 end;
390 end;
391 x := Request.ContentFields.Values['mente'] = 'on';
392 if FDTable2.FieldByName('mente').AsBoolean <> x then
393 begin
394 FDTable2.Edit;
395 FDTable2.FieldByName('mente').AsBoolean := x;
396 FDTable2.Post;
397 end;
398 Response.SendRedirect(FDTable2.FieldByName('home').AsAnsiString + '/admin');
399 end;
400
401 procedure TWebModule1.WebModule1archivesAction(Sender: TObject;
402 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
403 var
404 s: string;
405 t: TResourceStream;
406 begin
407 s := Request.QueryFields.Values['name'];
408 if s = '' then
409 begin
410 t := TResourceStream.Create(HInstance, 'archives', RT_RCDATA);
411 try
412 Response.ContentType := 'text/html; charset=utf-8;';
413 Response.Content := PageProducer1.ContentFromStream(t);
414 finally
415 t.Free;
416 end;
417 end
418 else if FileExists(s) = True then
419 begin
420 Handled := false;
421 with Response.Cookies.Add do
422 begin
423 Name := 'db';
424 path := '/';
425 Expires := Now + 1;
426 Value := s;
427 end;
428 FDConnection1.Open('Database=' + s + ';LockingMode=Normal;DriverID=SQLite');
429 FDTable1.Open;
430 FDTable2.Open;
431 FDTable3.Open;
432 end;
433 end;
434
435 procedure TWebModule1.WebModule1cssAction(Sender: TObject; Request: TWebRequest;
436 Response: TWebResponse; var Handled: Boolean);
437 var
438 s: string;
439 begin
440 s := Request.QueryFields.Values['css'];
441 if (s = 'main') or (s = 'pc') or (s = 'smart') or (s = 'tablet') then
442 begin
443 Response.ContentType := 'text/css';
444 Response.ContentStream := TResourceStream.Create(HInstance, s, RT_RCDATA);
445 end;
446 end;
447
448 procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;
449 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
450 var
451 s: TResourceStream;
452 t: TURLEncoding;
453 begin
454 if FDTable2.FieldByName('mente').AsBoolean = True then
455 begin
456 s := TResourceStream.Create(HInstance, 'mente', RT_RCDATA);
457 try
458 uri := '/mente';
459 Response.ContentType := 'text/html; charset=utf-8;';
460 Response.Content := PageProducer1.ContentFromStream(s);
461 finally
462 s.Free;
463 end;
464 Exit;
465 end;
466 position := StrToIntDef(Request.QueryFields.Values['pos'], -1);
467 s := TResourceStream.Create(HInstance, 'index', RT_RCDATA);
468 t := TURLEncoding.Create;
469 try
470 user := t.Decode(Request.CookieFields.Values['UID']);
471 uri := '/index';
472 Response.ContentType := 'text/html; charset=utf-8;';
473 Response.Content := PageProducer1.ContentFromStream(s);
474 finally
475 s.Free;
476 t.Free;
477 end;
478 end;
479
480 procedure TWebModule1.WebModule1loginAction(Sender: TObject;
481 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
482 var
483 s: TResourceStream;
484 begin
485 s := TResourceStream.Create(HInstance, 'login', RT_RCDATA);
486 try
487 uri := '/login';
488 Response.ContentType := 'text/html; charset=utf-8;';
489 Response.Content := PageProducer1.ContentFromStream(s);
490 finally
491 s.Free;
492 end;
493 end;
494
495 procedure TWebModule1.WebModule1registAction(Sender: TObject;
496 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
497 var
498 na, sub, com, pass: string;
499 s1: string;
500 no, line: integer;
501 i: integer;
502 s: TResourceStream;
503 t: TURLEncoding;
504 begin
505 with Request.ContentFields do
506 begin
507 na := Values['name'];
508 sub := Values['title'];
509 com := Values['comment'];
510 pass := Values['password'];
511 end;
512 er := '';
513 line := 0;
514 if na = '' then
515 na := '�N������';
516 if sub = '' then
517 sub := '�^�C�g������';
518 if com = '' then
519 er := '�{��������������.'#$D#$A
520 else
521 for i := 1 to Length(com) do
522 if Copy(com, i, i + 2) = #$D#$A then
523 inc(line);
524 for i := 0 to words.count - 1 do
525 if ContainsText(AnsiString(com), AnsiString(words[i])) = True then
526 begin
527 s1 := words[i];
528 if s1[1] = '<' then
529 begin
530 if Pos(' ', s1) = 0 then
531 s1 := Copy(s1, 2, Length(s1))
532 else
533 s1 := Copy(s1, 2, Pos(' ', s1) - 1);
534 er := er + '���~�^�O������������. ���:' + s1 + #$D#$A;
535 end
536 else
537 begin
538 er := er + '���~����������������.';
539 break;
540 end;
541 end;
542 if FDTable1.RecordCount = 0 then
543 no := 1
544 else
545 begin
546 FDTable1.Last;
547 no := FDTable1.FieldByName('no').AsInteger + 1;
548 if SecondsBetween(Now, StrToDateTime(FDTable1.FieldByName('date').AsString))
549 < time then
550 er := '����������������.';
551 end;
552 if er <> '' then
553 begin
554 Response.ContentType := 'text/html; charset=utf-8;';
555 s := TResourceStream.Create(HInstance, 'regist', RT_RCDATA);
556 try
557 Response.Content := PageProducer1.ContentFromStream(s);
558 finally
559 s.Free;
560 end;
561 Exit;
562 end;
563 t := TURLEncoding.Create;
564 try
565 FDTable1.AppendRecord([na, no, DateTimeToStr(Now), sub, com, pass, line]);
566 finally
567 t.Free;
568 end;
569 with Response.Cookies.Add do
570 begin
571 path := '/';
572 Name := 'UID';
573 Value := AnsiString(na);
574 Expires := Now + 1;
575 end;
576 Response.SendRedirect(FDTable2.FieldByName('home').AsAnsiString +
577 '/index#article');
578 end;
579
580 procedure TWebModule1.WebModule1searchAction(Sender: TObject;
581 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
582 var
583 s: TStringList;
584 t1, t2, t3: string;
585 i, j: integer;
586 m: TResourceStream;
587 begin
588 t1 := Request.ContentFields.Values['filter'];
589 t3 := '';
590 s := TStringList.Create;
591 try
592 s.DelimitedText := Request.ContentFields.Values['word1'];
593 for i := 0 to s.count - 1 do
594 begin
595 t2 := Trim(s[i]);
596 if t2 = '' then
597 continue;
598 if t3 <> '' then
599 t3 := t3 + ' and ';
600 t3 := t3 + t1 + ' LIKE ''%' + t2 + '%''';
601 end;
602 finally
603 s.Free;
604 end;
605 if t3 = '' then
606 begin
607 m := TResourceStream.Create(HInstance, 'search', RT_RCDATA);
608 try
609 Response.ContentType := 'text/html; charset=utf-8;';
610 Response.Content := PageProducer1.ContentFromStream(m);
611 finally
612 m.Free;
613 end;
614 Exit;
615 end;
616 FDTable1.Filter := t3;
617 FDTable1.Filtered := True;
618 m := TResourceStream.Create(HInstance, 'search', RT_RCDATA);
619 try
620 j := 0;
621 for i := 1 to FDTable1.RecordCount - 1 do
622 begin
623 inc(j, FDTable1.FieldByName('line').AsInteger);
624 FDTable1.Next;
625 end;
626 PageProducer1.HTMLDoc.LoadFromStream(m);
627 Response.ContentType := 'text/html; charset=utf-8;';
628 if (t3 <> '') and (j > FDTable3.FieldByName('line').AsInteger) then
629 begin
630 t1 := PageProducer1.Content;
631 i := Pos('<#main>', t1);
632 Delete(t1, i, Length('<#main>'));
633 Response.Content := t1 + Format('�\���s����%d�s��������������.',
634 [FDTable3.FieldByName('line').AsInteger]);
635 end
636 else
637 Response.Content := PageProducer1.ContentFromString
638 (PageProducer1.Content);
639 finally
640 FDTable1.Filtered := false;
641 m.Free;
642 end;
643 end;
644
645 procedure TWebModule1.WebModule1setupAction(Sender: TObject;
646 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
647 var
648 i: integer;
649 s: string;
650 begin
651 FDTable2.Edit;
652 for i := 0 to Request.ContentFields.count - 1 do
653 begin
654 s := Request.ContentFields.Names[i];
655 FDTable2.FieldByName(s).AsString := Request.ContentFields.ValueFromIndex[i]
656 end;
657 FDTable2.Post;
658 Handled := false;
659 end;
660
661 procedure TWebModule1.WebModule1userdelAction(Sender: TObject;
662 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
663 var
664 s: string;
665 i: integer;
666 begin
667 i := StrToIntDef(Request.ContentFields.Values['number'], 0);
668 if (i > 0) and (FDTable1.Locate('no', i, []) = True) then
669 begin
670 s := FDTable1.FieldByName('pass').AsString;
671 if (s <> '') and (s = Request.ContentFields.Values['password']) then
672 FDTable1.Delete;
673 end;
674 Handled := false;
675 end;
676
677 procedure TWebModule1.WebModuleAfterDispatch(Sender: TObject;
678 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
679 begin
680 foo := '';
681 end;
682
683 procedure TWebModule1.WebModuleBeforeDispatch(Sender: TObject;
684 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
685 var
686 m: TResourceStream;
687 s: string;
688 begin
689 s := Request.CookieFields.Values['db'];
690 if (FDConnection1.Connected = false) or
691 (s <> FDConnection1.Params.Values['DataBase']) then
692 begin
693 if (s <> '') and (s <> FDConnection1.Params.Values['DataBase']) then
694 FDConnection1.Open('Database=' + s +
695 ';LockingMode=Normal;DriverID=SQLite')
696 else
697 FDConnection1.Open
698 ('Database=data.sdb;LockingMode=Normal;DriverID=SQLite');
699 end;
700 if FDTable1.Exists = false then
701 FDTable1.CreateTable(false, [tpTable]);
702 if FDTable2.Exists = false then
703 begin
704 FDTable2.CreateTable(false, [tpTable]);
705 FDTable2.Open;
706 FDTable2.AppendRecord([Request.ScriptName, 'pbbs clone',
707 '<h1 style=font-family:Verdana;color:gray;font-weight:bold;text-align:center>P-BBS CLONE</h1>',
708 'admin', '����,����,����,<style,<script,<link', false]);
709 m := TResourceStream.Create(HInstance, 'setup', RT_RCDATA);
710 try
711 uri := '/setup';
712 Response.ContentType := 'text/html; charset=utf-8;';
713 Response.Content := PageProducer1.ContentFromStream(m);
714 finally
715 m.Free;
716 end;
717 Handled := True;
718 end
719 else if FDTable2.Active = false then
720 FDTable2.Open;
721 if FDTable3.Exists = false then
722 begin
723 FDTable3.CreateTable(false, [tpTable]);
724 FDTable3.Open;
725 FDTable3.AppendRecord([5, 20, 500]);
726 end
727 else if FDTable3.Active = false then
728 FDTable3.Open;
729 words.DelimitedText := FDTable2.FieldByName('ngwords').AsString;
730 if FDTable1.Active = false then
731 FDTable1.Open;
732 {
733 t:='';
734 ssl:=TStringList.Create;
735 try
736 ssl.Add('/login');
737 ssl.Add('/admin');
738 if (ssl.IndexOf(Request.PathInfo) > -1)and(StartsText('https',FDTable2.FieldByName('home').AsString) = false) then
739 begin
740 s:=FDTable2.FieldByName('home').AsAnsiString;
741 Delete(s,Length(s),1);
742 t:='https'+Copy(s,5,Length(s))+Request.PathInfo;
743 end;
744 finally
745 ssl.Free;
746 end;
747 if t <> '' then
748 begin
749 Response.SendRedirect(t);
750 Exit;
751 end;
752 }
753 end;
754
755 procedure TWebModule1.WebModuleCreate(Sender: TObject);
756 begin
757 time := 1;
758 words := TStringList.Create;
759 end;
760
761 procedure TWebModule1.WebModuleDestroy(Sender: TObject);
762 begin
763 words.Free;
764 end;
765
766 end.
767

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26