Develop and Download Open Source Software

Browse Subversion Repository

Contents of /WebModuleUnit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 19 - (show annotations) (download) (as text)
Thu Sep 29 11:11:08 2016 UTC (7 years, 6 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 22847 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 FDConnection1: TFDConnection;
17 FDTable2: TFDTable;
18 FDTable2home: TWideMemoField;
19 FDTable2title: TWideMemoField;
20 FDTable2title2: TWideMemoField;
21 FDTable2pass: TWideMemoField;
22 PageProducer1: TPageProducer;
23 DataSetPageProducer2: TDataSetPageProducer;
24 adminDS: TDataSetPageProducer;
25 FDTable2ngwords: TWideMemoField;
26 FDTable3: TFDTable;
27 FDTable3link: TIntegerField;
28 FDTable3count: TIntegerField;
29 FDTable3line: TIntegerField;
30 FDTable2mente: TBooleanField;
31 FDTable1: TFDTable;
32 FDTable1name: TWideMemoField;
33 FDTable1no: TIntegerField;
34 FDTable1date: TWideMemoField;
35 FDTable1sub: TWideMemoField;
36 FDTable1com: TWideMemoField;
37 FDTable1pass: TWideMemoField;
38 FDTable1line: TIntegerField;
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 + '/index');
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 FDConnection1.Open('Database=' + s +
421 ';LockingMode=Normal;DriverID=SQLite;');
422 FDTable1.Open;
423 FDTable2.Open;
424 FDTable3.Open;
425 Handled := false;
426 with Response.Cookies.Add do
427 begin
428 Name := 'db';
429 path := '/';
430 Expires := Now + 1;
431 Value := s;
432 end;
433 end;
434 end;
435
436 procedure TWebModule1.WebModule1cssAction(Sender: TObject; Request: TWebRequest;
437 Response: TWebResponse; var Handled: Boolean);
438 var
439 s: string;
440 begin
441 s := Request.QueryFields.Values['css'];
442 if (s = 'main') or (s = 'pc') or (s = 'smart') or (s = 'tablet') then
443 begin
444 Response.ContentType := 'text/css';
445 Response.ContentStream := TResourceStream.Create(HInstance, s, RT_RCDATA);
446 end;
447 end;
448
449 procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;
450 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
451 var
452 s: TResourceStream;
453 t: TURLEncoding;
454 begin
455 if FDTable2.FieldByName('mente').AsBoolean = True then
456 begin
457 s := TResourceStream.Create(HInstance, 'mente', RT_RCDATA);
458 try
459 uri := '/mente';
460 Response.ContentType := 'text/html; charset=utf-8;';
461 Response.Content := PageProducer1.ContentFromStream(s);
462 finally
463 s.Free;
464 end;
465 Exit;
466 end;
467 position := StrToIntDef(Request.QueryFields.Values['pos'], -1);
468 s := TResourceStream.Create(HInstance, 'index', RT_RCDATA);
469 t := TURLEncoding.Create;
470 try
471 user := t.Decode(Request.CookieFields.Values['UID']);
472 uri := '/index';
473 Response.ContentType := 'text/html; charset=utf-8;';
474 Response.Content := PageProducer1.ContentFromStream(s);
475 finally
476 s.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 s = '' then
691 FDConnection1.Open('Database=data.sdb;LockingMode=Normal;DriverID=SQLite')
692 else
693 FDConnection1.Open('Database='+s+';LockingMode=Normal;DriverID=SQLite');
694 if FDTable1.Exists = false then
695 FDTable1.CreateTable(false, [tpTable]);
696 if FDTable2.Exists = false then
697 begin
698 FDTable2.CreateTable(false, [tpTable]);
699 FDTable2.Active := True;
700 FDTable2.AppendRecord([Request.ScriptName, 'pbbs clone',
701 '<h1 style=font-family:Verdana;color:gray;font-weight:bold;text-align:center>P-BBS CLONE</h1>',
702 'admin', '����,����,����,<style,<script,<link', false]);
703 m := TResourceStream.Create(HInstance, 'setup', RT_RCDATA);
704 try
705 uri := '/setup';
706 Response.ContentType := 'text/html; charset=utf-8;';
707 Response.Content := PageProducer1.ContentFromStream(m);
708 finally
709 m.Free;
710 end;
711 Handled := True;
712 end
713 else
714 FDTable2.Active := True;
715 if FDTable3.Exists = false then
716 begin
717 FDTable3.CreateTable(false, [tpTable]);
718 FDTable3.Active := True;
719 FDTable3.AppendRecord([5, 20, 500]);
720 end
721 else
722 FDTable3.Active := True;
723 words.DelimitedText := FDTable2.FieldByName('ngwords').AsString;
724 FDTable1.Active := True;
725 {
726 t:='';
727 ssl:=TStringList.Create;
728 try
729 ssl.Add('/login');
730 ssl.Add('/admin');
731 if (ssl.IndexOf(Request.PathInfo) > -1)and(StartsText('https',FDTable2.FieldByName('home').AsString) = false) then
732 begin
733 s:=FDTable2.FieldByName('home').AsAnsiString;
734 Delete(s,Length(s),1);
735 t:='https'+Copy(s,5,Length(s))+Request.PathInfo;
736 end;
737 finally
738 ssl.Free;
739 end;
740 if t <> '' then
741 begin
742 Response.SendRedirect(t);
743 Exit;
744 end;
745 }
746 end;
747
748 procedure TWebModule1.WebModuleCreate(Sender: TObject);
749 begin
750 time := 1;
751 words := TStringList.Create;
752 end;
753
754 procedure TWebModule1.WebModuleDestroy(Sender: TObject);
755 begin
756 words.Free;
757 end;
758
759 end.
760

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