Develop and Download Open Source Software

mybbs

Browse Subversion Repository

/[bbs-as-pbbs]/WebModuleUnit1.pas

Diff of /WebModuleUnit1.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 18 by yamat0jp, Thu Sep 29 08:48:40 2016 UTC revision 19 by yamat0jp, Thu Sep 29 11:11:08 2016 UTC
# Line 12  uses System.SysUtils, System.Classes, We Line 12  uses System.SysUtils, System.Classes, We
12    
13  type  type
14    TWebModule1 = class(TWebModule)    TWebModule1 = class(TWebModule)
     FDTable1: TFDTable;  
15      FDConnection1: TFDConnection;      FDConnection1: TFDConnection;
16      FDTable2: TFDTable;      FDTable2: TFDTable;
17      FDTable2home: TWideMemoField;      FDTable2home: TWideMemoField;
# Line 21  type Line 20  type
20      FDTable2pass: TWideMemoField;      FDTable2pass: TWideMemoField;
21      PageProducer1: TPageProducer;      PageProducer1: TPageProducer;
22      DataSetPageProducer2: TDataSetPageProducer;      DataSetPageProducer2: TDataSetPageProducer;
     FDTable1name: TWideMemoField;  
     FDTable1no: TIntegerField;  
     FDTable1date: TWideMemoField;  
     FDTable1sub: TWideMemoField;  
     FDTable1com: TWideMemoField;  
     FDTable1pass: TWideMemoField;  
23      adminDS: TDataSetPageProducer;      adminDS: TDataSetPageProducer;
24      FDTable2ngwords: TWideMemoField;      FDTable2ngwords: TWideMemoField;
25      FDTable3: TFDTable;      FDTable3: TFDTable;
26      FDTable3link: TIntegerField;      FDTable3link: TIntegerField;
27      FDTable3count: TIntegerField;      FDTable3count: TIntegerField;
     FDTable1line: TIntegerField;  
28      FDTable3line: TIntegerField;      FDTable3line: TIntegerField;
29      FDTable2mente: TBooleanField;      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      procedure WebModule1DefaultHandlerAction(Sender: TObject;      procedure WebModule1DefaultHandlerAction(Sender: TObject;
39        Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);        Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
40      procedure PageProducer1HTMLTag(Sender: TObject; Tag: TTag;      procedure PageProducer1HTMLTag(Sender: TObject; Tag: TTag;
# Line 65  type Line 65  type
65        Response: TWebResponse; var Handled: Boolean);        Response: TWebResponse; var Handled: Boolean);
66      procedure WebModuleAfterDispatch(Sender: TObject; Request: TWebRequest;      procedure WebModuleAfterDispatch(Sender: TObject; Request: TWebRequest;
67        Response: TWebResponse; var Handled: Boolean);        Response: TWebResponse; var Handled: Boolean);
68        procedure WebModule1archivesAction(Sender: TObject; Request: TWebRequest;
69          Response: TWebResponse; var Handled: Boolean);
70    private    private
71      { private 宣言 }      { private 宣言 }
72    public    public
# Line 78  type Line 80  type
80      foo: string;      foo: string;
81      function footer(const path: string): string;      function footer(const path: string): string;
82      procedure regist(var com: string);      procedure regist(var com: string);
83        function search: string;
84    end;    end;
85    
86  var  var
# Line 244  begin Line 247  begin
247    if (TagString = 'mente') and (FDTable2.FieldByName('mente').AsBoolean = True)    if (TagString = 'mente') and (FDTable2.FieldByName('mente').AsBoolean = True)
248    then    then
249      ReplaceText := 'checked="checked"';      ReplaceText := 'checked="checked"';
250      if TagString = 'archives' then
251        ReplaceText := search;
252  end;  end;
253    
254  procedure TWebModule1.regist(var com: string);  procedure TWebModule1.regist(var com: string);
255  var  var
256    i: integer;    i: integer;
257    s: TSTringList;    s: TStringList;
258  begin  begin
259    s:=TStringList.Create;    s := TStringList.Create;
260    try    try
261      s.Text:=com;      s.Text := com;
262      for i := 0 to s.Count-1 do      for i := 0 to s.count - 1 do
263        s[i]:='<p>'+s[i]+'</p>';        s[i] := '<p>' + s[i] + '</p>';
264      com:=s.Text;      com := s.Text;
265    finally    finally
266      s.Free;      s.Free;
267    end;    end;
268  end;  end;
269    
270    function TWebModule1.search: string;
271    var
272      s: TSearchRec;
273      t: TStringList;
274      i: integer;
275    begin
276      t := TStringList.Create;
277      try
278        if FindFirst('.\*.sdb', 0, s) = 0 then
279        begin
280          repeat
281            t.Add(s.Name);
282          until FindNext(s) <> 0;
283          for i := 0 to t.count - 1 do
284            case i mod 5 of
285              0:
286                t[i] := String.Format
287                  ('<tr><td><a href=%s/archives?name=%s>%s</a></td>',
288                  [FDTable2.FieldByName('home').AsString, t[i], t[i]]);
289              4:
290                t[i] := String.Format
291                  ('<td><a href=%s/archives?name=%s>%s</a></td></tr>',
292                  [FDTable2.FieldByName('home').AsString, t[i], t[i]]);
293            else
294              t[i] := String.Format('<td><a href=%s/archives?name=%s>%s</a></td>',
295                [FDTable2.FieldByName('home').AsString, t[i], t[i]]);
296            end;
297        end;
298        result := '<table border=1>' + t.Text + '</table>';
299      finally
300        FindClose(s);
301        t.Free;
302      end;
303    end;
304    
305  procedure TWebModule1.WebModule1adminAction(Sender: TObject;  procedure TWebModule1.WebModule1adminAction(Sender: TObject;
306    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
307  var  var
# Line 341  begin Line 381  begin
381      FDTable2.Post;      FDTable2.Post;
382      with Response.Cookies.Add do      with Response.Cookies.Add do
383      begin      begin
384        path := AnsiString(FDTable2.FieldByName('home').AsAnsiString + '/admin');        path := '/';
385        Expires := Now + 14;        Expires := Now + 14;
386        Name := 'psw';        Name := 'psw';
387        Value := AnsiString(s);        Value := AnsiString(s);
# Line 357  begin Line 397  begin
397    Response.SendRedirect(FDTable2.FieldByName('home').AsAnsiString + '/admin');    Response.SendRedirect(FDTable2.FieldByName('home').AsAnsiString + '/admin');
398  end;  end;
399    
400    procedure TWebModule1.WebModule1archivesAction(Sender: TObject;
401      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
402    var
403      s: string;
404      t: TResourceStream;
405    begin
406      s := Request.QueryFields.Values['name'];
407      if s = '' then
408      begin
409        t := TResourceStream.Create(HInstance, 'archives', RT_RCDATA);
410        try
411          Response.ContentType := 'text/html; charset=utf-8;';
412          Response.Content := PageProducer1.ContentFromStream(t);
413        finally
414          t.Free;
415        end;
416      end
417      else if FileExists(s) = True then
418      begin
419        FDConnection1.Open('Database=' + s +
420          ';LockingMode=Normal;DriverID=SQLite;');
421        FDTable1.Open;
422        FDTable2.Open;
423        FDTable3.Open;
424        Handled := false;
425        with Response.Cookies.Add do
426        begin
427          Name := 'db';
428          path := '/';
429          Expires := Now + 1;
430          Value := s;
431        end;
432      end;
433    end;
434    
435  procedure TWebModule1.WebModule1cssAction(Sender: TObject; Request: TWebRequest;  procedure TWebModule1.WebModule1cssAction(Sender: TObject; Request: TWebRequest;
436    Response: TWebResponse; var Handled: Boolean);    Response: TWebResponse; var Handled: Boolean);
437  var  var
# Line 608  procedure TWebModule1.WebModuleBeforeDis Line 683  procedure TWebModule1.WebModuleBeforeDis
683    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
684  var  var
685    m: TResourceStream;    m: TResourceStream;
686      s: string;
687  begin  begin
688      s:=Request.CookieFields.Values['db'];
689      if s = '' then
690        FDConnection1.Open('Database=data.sdb;LockingMode=Normal;DriverID=SQLite')
691      else
692        FDConnection1.Open('Database='+s+';LockingMode=Normal;DriverID=SQLite');
693    if FDTable1.Exists = false then    if FDTable1.Exists = false then
694      FDTable1.CreateTable(false, [tpTable]);      FDTable1.CreateTable(false, [tpTable]);
695    if FDTable2.Exists = false then    if FDTable2.Exists = false then
# Line 665  end; Line 746  end;
746    
747  procedure TWebModule1.WebModuleCreate(Sender: TObject);  procedure TWebModule1.WebModuleCreate(Sender: TObject);
748  begin  begin
   FDConnection1.Open('Database=data.sdb;LockingMode=Normal;DriverID=SQLite');  
749    time := 1;    time := 1;
750    words := TStringList.Create;    words := TStringList.Create;
751  end;  end;
Legend:
Removed from v.18  
changed lines
  Added in v.19
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help