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 6 by yamat0jp, Fri Sep 25 03:19:17 2015 UTC revision 7 by yamat0jp, Sat Sep 17 00:53:17 2016 UTC
# Line 8  uses System.SysUtils, System.Classes, We Line 8  uses System.SysUtils, System.Classes, We
8    FireDAC.UI.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Phys,    FireDAC.UI.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Phys,
9    FireDAC.Phys.SQLite, FireDAC.Phys.SQLiteDef, FireDAC.Stan.ExprFuncs, Data.DB,    FireDAC.Phys.SQLite, FireDAC.Phys.SQLiteDef, FireDAC.Stan.ExprFuncs, Data.DB,
10    FireDAC.Comp.Client, FireDAC.Comp.DataSet, Web.HTTPProd, Web.DSProd,    FireDAC.Comp.Client, FireDAC.Comp.DataSet, Web.HTTPProd, Web.DSProd,
11    AnsiStrings, System.DateUtils, System.Types;    AnsiStrings, System.DateUtils, System.Types, Vcl.AppEvnts;
12    
13  type  type
14    TWebModule1 = class(TWebModule)    TWebModule1 = class(TWebModule)
# Line 74  type Line 74  type
74      foo: string;      foo: string;
75      function footer(const path: string): string;      function footer(const path: string): string;
76      function regist(var com: string): integer;      function regist(var com: string): integer;
     procedure AddCookie(day: integer; const pass: string);  
77    end;    end;
78    
79  var  var
# Line 86  implementation Line 85  implementation
85    
86  {$R *.dfm}  {$R *.dfm}
87    
 procedure TWebModule1.AddCookie(day: integer; const pass: string);  
 begin  
   with Response.Cookies.Add do  
   begin  
     path := AnsiString('https://'+FDTable2.FieldByName('home').AsString + 'admin');  
     Expires := Now + day;  
     Name := 'psw';  
     Value := AnsiString(pass);  
     Secure := True;  
   end;  
 end;  
   
88  procedure TWebModule1.DataSetPageProducer2HTMLTag(Sender: TObject; Tag: TTag;  procedure TWebModule1.DataSetPageProducer2HTMLTag(Sender: TObject; Tag: TTag;
89    const TagString: string; TagParams: TStrings; var ReplaceText: string);    const TagString: string; TagParams: TStrings; var ReplaceText: string);
90  begin  begin
# Line 136  var Line 123  var
123          result := result + '  ' + IntToStr(position + 1) + '  '          result := result + '  ' + IntToStr(position + 1) + '  '
124        else        else
125          result := result + Format('  <a href="' + home + path +          result := result + Format('  <a href="' + home + path +
126            '?pos=%d#article">%d</a>  ', [position + i + j, position + 1 + i + j]);            '?pos=%d#article">%d</a>  ',
127              [position + i + j, position + 1 + i + j]);
128      end;      end;
129    end;    end;
130    
131  begin  begin
132    count := FDTable3.FieldByName('count').AsInteger;    count := FDTable3.FieldByName('count').AsInteger;
133    if path = 'admin' then    home := 'http://' + FDTable2.FieldByName('home').AsString;
     home := 'https://'+FDTable2.FieldByName('home').AsString  
   else  
     home := 'http://'+FDTable2.FieldByName('home').AsString;  
134    if position <= -1 then    if position <= -1 then
135    begin    begin
136      s1 := '最新%d件の記事を表示<br><center>Pages : [<b>';      s1 := '最新%d件の記事を表示<br><center>Pages : [<b>';
# Line 163  begin Line 148  begin
148        position := i;        position := i;
149      if position = i then      if position = i then
150      begin      begin
151        t2 := '?pos=' + position.ToString+'#article';        t2 := '?pos=' + position.ToString + '#article';
152        k := FDTable1.RecordCount;        k := FDTable1.RecordCount;
153      end      end
154      else      else
155      begin      begin
156        t2 := '?pos=' + IntToStr(position + 1)+'#article';        t2 := '?pos=' + IntToStr(position + 1) + '#article';
157        k := (position + 1) * count;        k := (position + 1) * count;
158      end;      end;
159      s1 := '%d 件中 %d 件から %d 件まで表示<br><center>Page : [<b>';      s1 := '%d 件中 %d 件から %d 件まで表示<br><center>Page : [<b>';
# Line 187  var Line 172  var
172  begin  begin
173    if TagString = 'home' then    if TagString = 'home' then
174    begin    begin
175      if (uri = 'admin') or (uri = 'login') or (TagParams.Values['ssl'] = 'true')      if uri = 'setup' then
176      then        ReplaceText := '/index'
       ReplaceText := 'https://'+FDTable2.FieldByName('home').AsString  
177      else      else
178        ReplaceText := 'http://'+FDTable2.FieldByName('home').AsString;        ReplaceText := 'http://' + FDTable2.FieldByName('home').AsString;
179    end;    end;
180    if (TagString = 'title') or (TagString = 'title2') then    if (TagString = 'title') or (TagString = 'title2') then
181      ReplaceText := FDTable2.FieldByName(TagString).AsString;      ReplaceText := FDTable2.FieldByName(TagString).AsString;
# Line 235  begin Line 219  begin
219          ReplaceText := ReplaceText + s.Content;          ReplaceText := ReplaceText + s.Content;
220          FDTable1.Prior;          FDTable1.Prior;
221        end;        end;
222        ReplaceText:=ReplaceText + '<hr>';        ReplaceText := ReplaceText + '<hr>';
223      end;      end;
224    end;    end;
225    if TagString = 'footer' then    if TagString = 'footer' then
# Line 256  begin Line 240  begin
240      ReplaceText := FDTable2.FieldByName('pass').AsString;      ReplaceText := FDTable2.FieldByName('pass').AsString;
241    if TagString = 'content' then    if TagString = 'content' then
242      ReplaceText := er;      ReplaceText := er;
243    if (TagString = 'mente') and (FDTable2.FieldByName('mente').AsBoolean = true)    if (TagString = 'mente') and (FDTable2.FieldByName('mente').AsBoolean = True)
244    then    then
245      ReplaceText := 'checked="checked"';      ReplaceText := 'checked="checked"';
246  end;  end;
# Line 298  var Line 282  var
282        s.Free;        s.Free;
283      end;      end;
284    end;    end;
285      procedure addcookie(day: integer; pass: string);
286      begin
287        with Response.Cookies.Add do
288        begin
289          path := AnsiString('/admin');
290          Expires := Now + day;
291          Name := 'psw';
292          Value := AnsiString(pass);
293        end;
294      end;
295    
296  begin  begin
297    if Request.Query = 'del' then    if Request.Query = 'del' then
298    begin    begin
299      AddCookie(-3, '');      addcookie(-3, '');
300      Response.SendRedirect('http://'+FDTable2.FieldByName('home').AsAnsiString);      Response.SendRedirect('/index');
301      Exit;      Exit;
302    end;    end;
303    x := True;    x := True;
# Line 311  begin Line 305  begin
305    position := StrToIntDef(Request.QueryFields.Values['pos'], -1);    position := StrToIntDef(Request.QueryFields.Values['pos'], -1);
306    if t <> '' then    if t <> '' then
307    begin    begin
308      AddCookie(14, t);      addcookie(14, t);
309      if t = FDTable2.FieldByName('pass').AsString then      if t = FDTable2.FieldByName('pass').AsString then
310        something;        something;
311    end    end
# Line 319  begin Line 313  begin
313    then    then
314      something;      something;
315    if x = True then    if x = True then
316      Response.SendRedirect('https://'+FDTable2.FieldByName('home').AsAnsiString + 'login');      Response.SendRedirect('/login');
317  end;  end;
318    
319  procedure TWebModule1.WebModule1admindelAction(Sender: TObject;  procedure TWebModule1.WebModule1admindelAction(Sender: TObject;
# Line 331  begin Line 325  begin
325      if FDTable1.Locate('no', Request.ContentFields.ValueFromIndex[i], []) = True      if FDTable1.Locate('no', Request.ContentFields.ValueFromIndex[i], []) = True
326      then      then
327        FDTable1.Delete;        FDTable1.Delete;
328    Response.SendRedirect('https://'+FDTable2.FieldByName('home').AsAnsiString + 'admin'))    Response.SendRedirect('/admin');
329  end;  end;
330    
331  procedure TWebModule1.WebModule1adminsetAction(Sender: TObject;  procedure TWebModule1.WebModule1adminsetAction(Sender: TObject;
# Line 346  begin Line 340  begin
340      FDTable2.Edit;      FDTable2.Edit;
341      FDTable2.FieldByName('pass').AsString := s;      FDTable2.FieldByName('pass').AsString := s;
342      FDTable2.Post;      FDTable2.Post;
343      AddCookie(14, s);      with Response.Cookies.Add do
344        begin
345          path := AnsiString('/admin');
346          Expires := Now + 14;
347          Name := 'psw';
348          Value := AnsiString(s);
349        end;
350    end;    end;
351    x := Request.ContentFields.Values['mente'] = 'on';    x := Request.ContentFields.Values['mente'] = 'on';
352    if FDTable2.FieldByName('mente').AsBoolean <> x then    if FDTable2.FieldByName('mente').AsBoolean <> x then
# Line 355  begin Line 355  begin
355      FDTable2.FieldByName('mente').AsBoolean := x;      FDTable2.FieldByName('mente').AsBoolean := x;
356      FDTable2.Post;      FDTable2.Post;
357    end;    end;
358    Response.SendRedirect('https://'+FDTable2.FieldByName('home').AsAnsiString + 'admin');    Response.SendRedirect('/admin');
359  end;  end;
360    
361  procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;  procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;
# Line 462  begin Line 462  begin
462      Value := AnsiString(na);      Value := AnsiString(na);
463      Expires := Now + 1;      Expires := Now + 1;
464    end;    end;
465    Response.SendRedirect(FDTable2.FieldByName('home').AsAnsiString+'index#article');    Response.SendRedirect('/index#article');
466  end;  end;
467    
468  procedure TWebModule1.WebModule1searchAction(Sender: TObject;  procedure TWebModule1.WebModule1searchAction(Sender: TObject;
# Line 536  var Line 536  var
536    i: integer;    i: integer;
537    s: string;    s: string;
538  begin  begin
539      FDTable2.Edit;
540    for i := 0 to Request.ContentFields.count - 1 do    for i := 0 to Request.ContentFields.count - 1 do
541    begin    begin
542      s := Request.ContentFields.Names[i];      s := Request.ContentFields.Names[i];
543      if s <> 'home' then      if s <> 'home' then
544        FDTable2.FieldByName(s).AsString :=        FDTable2.FieldByName(s).AsString :=
545          Request.ContentFields.ValueFromIndex[i];          Request.ContentFields.ValueFromIndex[i]
546        else
547          FDTable2.FieldByName(s).AsString := Request.ContentFields.Values[s];
548    end;    end;
549      FDTable2.Post;
550    Handled := false;    Handled := false;
551  end;  end;
552    
# Line 565  end; Line 569  end;
569  procedure TWebModule1.WebModuleBeforeDispatch(Sender: TObject;  procedure TWebModule1.WebModuleBeforeDispatch(Sender: TObject;
570    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
571  var  var
572    s: string;    s: AnsiString;
573    m: TResourceStream;    m: TResourceStream;
574  begin  begin
575    if FDTable1.Exists = false then    if FDTable1.Exists = false then
# Line 582  begin Line 586  begin
586        IntToStr(Request.ServerPort);        IntToStr(Request.ServerPort);
587      }      }
588      if Request.ScriptName <> '' then      if Request.ScriptName <> '' then
589        s := String(Request.Host + Request.ScriptName) + '/'        s := Request.Host + Request.ScriptName + '/'
590      else      else
591        s := String(Request.Host) + '/';        s := Request.Host + '/';
592      FDTable2.AppendRecord([s, 'pbbs clone',      FDTable2.AppendRecord([s, 'pbbs clone',
593        '<center><font size=5 face=Verdana color=gray><b>P-BBS CLONE</b></font></center>',        '<center><font size=5 face=Verdana color=gray><b>P-BBS CLONE</b></font></center>',
594        'admin', 'あほ,ばか,死ね', false]);        'admin', 'あほ,ばか,死ね', false]);
# Line 635  end; Line 639  end;
639    
640  procedure TWebModule1.WebModuleCreate(Sender: TObject);  procedure TWebModule1.WebModuleCreate(Sender: TObject);
641  begin  begin
642      FDConnection1.Open('Database=data.sdb;LockingMode=Normal;DriverID=SQLite');
643    time := 1;    time := 1;
644    words := TStringList.Create;    words := TStringList.Create;
645  end;  end;
Legend:
Removed from v.6  
changed lines
  Added in v.7
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help