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 2 by yamat0jp, Thu Sep 24 00:46:08 2015 UTC revision 3 by yamat0jp, Thu Sep 24 05:40:03 2015 UTC
# Line 58  type Line 58  type
58        Response: TWebResponse; var Handled: Boolean);        Response: TWebResponse; var Handled: Boolean);
59      procedure WebModuleCreate(Sender: TObject);      procedure WebModuleCreate(Sender: TObject);
60      procedure WebModuleDestroy(Sender: TObject);      procedure WebModuleDestroy(Sender: TObject);
61        procedure WebModule1adminsetAction(Sender: TObject; Request: TWebRequest;
62          Response: TWebResponse; var Handled: Boolean);
63    private    private
64      { private 宣言 }      { private 宣言 }
65    public    public
# Line 67  type Line 69  type
69      words: TStringList;      words: TStringList;
70      position: integer;      position: integer;
71      uri: string;      uri: string;
72        er: string;
73      foo: string;      foo: string;
74      function footer(const path: string): string;      function footer(const path: string): string;
75      function regist(var com: string): integer;      function regist(var com: string): integer;
76        procedure AddCookie(day: integer; const pass: string);
77    end;    end;
78    
79  var  var
# Line 81  implementation Line 85  implementation
85    
86  {$R *.dfm}  {$R *.dfm}
87    
88    procedure TWebModule1.AddCookie(day: integer; const pass: string);
89    begin
90      with Response.Cookies.Add do
91      begin
92        Path := ReplaceText(FDTable2.FieldByName('home').AsAnsiString + 'admin','http','https');
93        Expires := Now + day;
94        Name := 'psw';
95        Value := AnsiString(pass);
96        Secure := True;
97      end;
98    end;
99    
100  procedure TWebModule1.DataSetPageProducer2HTMLTag(Sender: TObject; Tag: TTag;  procedure TWebModule1.DataSetPageProducer2HTMLTag(Sender: TObject; Tag: TTag;
101    const TagString: string; TagParams: TStrings; var ReplaceText: string);    const TagString: string; TagParams: TStrings; var ReplaceText: string);
102  begin  begin
# Line 234  begin Line 250  begin
250      else      else
251        ReplaceText := '該当結果 ' + IntToStr(FDTable1.RecordCount) + ' 件' +        ReplaceText := '該当結果 ' + IntToStr(FDTable1.RecordCount) + ' 件' +
252          '<br><#main>';          '<br><#main>';
253      if TagString = 'pass' then
254        ReplaceText:=FDTable2.FieldByName('pass').AsString;
255      if TagString = 'content' then
256        ReplaceText:=er;
257  end;  end;
258    
259  function TWebModule1.regist(var com: string): integer;  function TWebModule1.regist(var com: string): integer;
# Line 257  end; Line 277  end;
277  procedure TWebModule1.WebModule1adminAction(Sender: TObject;  procedure TWebModule1.WebModule1adminAction(Sender: TObject;
278    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
279  var  var
280    s: string;    t: string;
281    x: Boolean;    x: Boolean;
282    procedure something;    procedure something;
283    var    var
# Line 274  var Line 294  var
294        s.Free;        s.Free;
295      end;      end;
296    end;    end;
   procedure AddCookie(day: integer);  
   begin  
     with Response.Cookies.Add do  
     begin  
       Path := ReplaceText(FDTable2.FieldByName('home').AsAnsiString + 'admin','http','https');  
       Expires := Now + day;  
       Name := 'psw';  
       Value := AnsiString(s);  
       Secure := True;  
     end;  
   end;  
297    
298  begin  begin
299    if Request.Query = 'del' then    if Request.Query = 'del' then
300    begin    begin
301      AddCookie(-3);      AddCookie(-3,'');
302      Response.SendRedirect(FDTable2.FieldByName('home').AsAnsiString);      Response.SendRedirect(FDTable2.FieldByName('home').AsAnsiString);
303      Exit;      Exit;
304    end;    end;
305    x := True;    x := True;
306    s := Request.ContentFields.Values['password'];    t := Request.ContentFields.Values['password'];
307    position := StrToIntDef(Request.QueryFields.Values['pos'], -1);    position := StrToIntDef(Request.QueryFields.Values['pos'], -1);
308    if s <> '' then    if t <> '' then
309    begin    begin
310      AddCookie(1);      AddCookie(1,t);
311      if s = FDTable2.FieldByName('pass').AsString then      if t = FDTable2.FieldByName('pass').AsString then
312        something;        something;
313    end    end
314    else if Request.CookieFields.Values['psw'] = FDTable2.FieldByName('pass').AsString    else if Request.CookieFields.Values['psw'] = FDTable2.FieldByName('pass').AsString
# Line 314  procedure TWebModule1.WebModule1admindel Line 323  procedure TWebModule1.WebModule1admindel
323  var  var
324    i: integer;    i: integer;
325  begin  begin
326    for i := 0 to Request.ContentFields.count - 1 do    for i := 0 to Request.ContentFields.Count - 1 do
327      if FDTable1.Locate('no', Request.ContentFields.ValueFromIndex[i], []) = True      if FDTable1.Locate('no', Request.ContentFields.ValueFromIndex[i], []) = True
328      then      then
329        FDTable1.Delete;        FDTable1.Delete;
# Line 322  begin Line 331  begin
331      'admin', 'http', 'https'));      'admin', 'http', 'https'));
332  end;  end;
333    
334    procedure TWebModule1.WebModule1adminsetAction(Sender: TObject;
335      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
336    var
337      s: string;
338    begin
339      s:=Request.ContentFields.Values['pass'];
340      FDTable2.Edit;
341      FDTable2.FieldByName('pass').AsString:=s;
342      FDTable2.Post;
343      AddCookie(1,s);
344      Response.SendRedirect(ReplaceText(FDTable2.FieldByName('home').AsAnsiString+'admin','http','https'));
345    end;
346    
347  procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;  procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;
348    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
349  var  var
# Line 362  var Line 384  var
384    na, sub, com, pass: string;    na, sub, com, pass: string;
385    no, line: integer;    no, line: integer;
386    i: integer;    i: integer;
387      s: TResourceStream;
388  begin  begin
389    with Request.ContentFields do    with Request.ContentFields do
390    begin    begin
# Line 370  begin Line 393  begin
393      com := Values['comment'];      com := Values['comment'];
394      pass := Values['password'];      pass := Values['password'];
395    end;    end;
396      er:='';
397    line:=0;    line:=0;
398    if na = '' then    if na = '' then
399      na := '誰かさん';      na := '誰かさん';
400    if sub = '' then    if sub = '' then
401      sub := 'タイトルなし';      sub := 'タイトルなし';
402    if com = '' then    if com = '' then
403      Response.Content := '本文がありません.'#$D#$A      er := '本文がありません.'#$D#$A
404    else    else
405      line := regist(com);      line := regist(com);
406    for i := 0 to words.count - 1 do    for i := 0 to words.count - 1 do
407      if ContainsText(AnsiString(com), AnsiString(words[i])) = True then      if ContainsText(AnsiString(com), AnsiString(words[i])) = True then
408      begin      begin
409        Response.Content := Response.Content + '禁止語句が含まれます.';        er:=er + '禁止語句が含まれます.';
410        break;        break;
411      end;      end;
412    if FDTable1.RecordCount = 0 then    if FDTable1.RecordCount = 0 then
# Line 393  begin Line 417  begin
417      no := FDTable1.FieldByName('no').AsInteger + 1;      no := FDTable1.FieldByName('no').AsInteger + 1;
418      if SecondsBetween(Now, StrToDateTime(FDTable1.FieldByName('date').AsString))      if SecondsBetween(Now, StrToDateTime(FDTable1.FieldByName('date').AsString))
419        < time then        < time then
420        Response.Content := '混み合っています.';        er := '混み合っています.';
421    end;    end;
422    if Response.Content <> '' then    if er <> '' then
423    begin    begin
424      Response.ContentType := 'text/plain;';      Response.ContentType := 'text/html; charset=utf-8;';
425        s:=TResourceStream.Create(HInstance,'regist',RT_RCDATA);
426        try
427          Response.Content:=PageProducer1.ContentFromStream(s);
428        finally
429          s.Free;
430        end;
431      Exit;      Exit;
432    end;    end;
433    FDTable1.AppendRecord([na, no, DateTimeToStr(Now), sub, com, pass, line]);    FDTable1.AppendRecord([na, no, DateTimeToStr(Now), sub, com, pass, line]);
# Line 441  begin Line 471  begin
471      m:=TResourceStream.Create(HInstance,'search',RT_RCDATA);      m:=TResourceStream.Create(HInstance,'search',RT_RCDATA);
472      try      try
473        PageProducer1.HTMLDoc.LoadFromStream(m);        PageProducer1.HTMLDoc.LoadFromStream(m);
474        Response.ContentType := 'text/html; charset=utf-8;';        Response.ContentType := 'text/html; cahrset=utf-8';
475        Response.Content := PageProducer1.Content;        Response.Content := PageProducer1.Content;
476      finally      finally
477        m.Free;        m.Free;
# Line 512  end; Line 542  end;
542  procedure TWebModule1.WebModuleBeforeDispatch(Sender: TObject;  procedure TWebModule1.WebModuleBeforeDispatch(Sender: TObject;
543    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
544  var  var
545    s, t: string;    s: string;
546    m: TResourceStream;    m: TResourceStream;
   ssl: TStringList;  
547  begin  begin
548    if FDTable1.Exists = false then    if FDTable1.Exists = false then
549      FDTable1.CreateTable(false, [tpTable]);      FDTable1.CreateTable(false, [tpTable]);
Legend:
Removed from v.2  
changed lines
  Added in v.3
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help