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 3 by yamat0jp, Thu Sep 24 05:40:03 2015 UTC revision 4 by yamat0jp, Thu Sep 24 07:42:33 2015 UTC
# Line 1  Line 1 
1  unit WebModuleUnit1;  unit WebModuleUnit1;
2    
3  interface  interface
4    
5  uses System.SysUtils, System.Classes, Web.HTTPApp, FireDAC.Stan.Intf,  uses System.SysUtils, System.Classes, Web.HTTPApp, FireDAC.Stan.Intf,
# Line 34  type Line 34  type
34      FDTable3count: TIntegerField;      FDTable3count: TIntegerField;
35      FDTable1line: TIntegerField;      FDTable1line: TIntegerField;
36      FDTable3line: TIntegerField;      FDTable3line: TIntegerField;
37        FDTable2mente: TBooleanField;
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 89  procedure TWebModule1.AddCookie(day: int Line 90  procedure TWebModule1.AddCookie(day: int
90  begin  begin
91    with Response.Cookies.Add do    with Response.Cookies.Add do
92    begin    begin
93      Path := ReplaceText(FDTable2.FieldByName('home').AsAnsiString + 'admin','http','https');      path := ReplaceText(FDTable2.FieldByName('home').AsAnsiString + 'admin',
94          'http', 'https');
95      Expires := Now + day;      Expires := Now + day;
96      Name := 'psw';      Name := 'psw';
97      Value := AnsiString(pass);      Value := AnsiString(pass);
# Line 187  var Line 189  var
189  begin  begin
190    if TagString = 'home' then    if TagString = 'home' then
191    begin    begin
192      if (uri = 'admin')or(uri = 'login')or(TagParams.Values['ssl'] = 'true') then      if (uri = 'admin') or (uri = 'login') or (TagParams.Values['ssl'] = 'true')
193        ReplaceText := String(AnsiReplaceText(FDTable2.FieldByName('home').AsAnsiString, 'http', 'https'))      then
194          ReplaceText := String(AnsiReplaceText(FDTable2.FieldByName('home')
195            .AsAnsiString, 'http', 'https'))
196      else      else
197        ReplaceText := FDTable2.FieldByName('home').AsString;        ReplaceText := FDTable2.FieldByName('home').AsString;
198    end;    end;
# Line 251  begin Line 255  begin
255        ReplaceText := '該当結果 ' + IntToStr(FDTable1.RecordCount) + ' 件' +        ReplaceText := '該当結果 ' + IntToStr(FDTable1.RecordCount) + ' 件' +
256          '<br><#main>';          '<br><#main>';
257    if TagString = 'pass' then    if TagString = 'pass' then
258      ReplaceText:=FDTable2.FieldByName('pass').AsString;      ReplaceText := FDTable2.FieldByName('pass').AsString;
259    if TagString = 'content' then    if TagString = 'content' then
260      ReplaceText:=er;      ReplaceText := er;
261      if (TagString = 'mente') and (FDTable2.FieldByName('mente').AsBoolean = true)
262      then
263        ReplaceText := 'checked="checked"';
264  end;  end;
265    
266  function TWebModule1.regist(var com: string): integer;  function TWebModule1.regist(var com: string): integer;
# Line 284  var Line 291  var
291      s: TResourceStream;      s: TResourceStream;
292    begin    begin
293      x := false;      x := false;
294      s := TResourceStream.Create(HInstance,'admin',RT_RCDATA);      s := TResourceStream.Create(HInstance, 'admin', RT_RCDATA);
295      try      try
296        uri:='admin';        uri := 'admin';
       PageProducer1.HTMLDoc.LoadFromStream(s);  
297        Response.ContentType := 'text/html; charset=utf-8;';        Response.ContentType := 'text/html; charset=utf-8;';
298        Response.Content := PageProducer1.Content;        Response.Content := PageProducer1.ContentFromStream(s)
299      finally      finally
300        s.Free;        s.Free;
301      end;      end;
# Line 298  var Line 304  var
304  begin  begin
305    if Request.Query = 'del' then    if Request.Query = 'del' then
306    begin    begin
307      AddCookie(-3,'');      AddCookie(-3, '');
308      Response.SendRedirect(FDTable2.FieldByName('home').AsAnsiString);      Response.SendRedirect(FDTable2.FieldByName('home').AsAnsiString);
309      Exit;      Exit;
310    end;    end;
# Line 307  begin Line 313  begin
313    position := StrToIntDef(Request.QueryFields.Values['pos'], -1);    position := StrToIntDef(Request.QueryFields.Values['pos'], -1);
314    if t <> '' then    if t <> '' then
315    begin    begin
316      AddCookie(1,t);      AddCookie(14, t);
317      if t = FDTable2.FieldByName('pass').AsString then      if t = FDTable2.FieldByName('pass').AsString then
318        something;        something;
319    end    end
# Line 315  begin Line 321  begin
321    then    then
322      something;      something;
323    if x = True then    if x = True then
324      Response.SendRedirect(AnsiReplaceText(FDTable2.FieldByName('home').AsAnsiString,'http','https') + 'login');      Response.SendRedirect(ReplaceText(FDTable2.FieldByName('home').AsAnsiString,
325          'http', 'https') + 'login');
326  end;  end;
327    
328  procedure TWebModule1.WebModule1admindelAction(Sender: TObject;  procedure TWebModule1.WebModule1admindelAction(Sender: TObject;
# Line 323  procedure TWebModule1.WebModule1admindel Line 330  procedure TWebModule1.WebModule1admindel
330  var  var
331    i: integer;    i: integer;
332  begin  begin
333    for i := 0 to Request.ContentFields.Count - 1 do    for i := 0 to Request.ContentFields.count - 1 do
334      if FDTable1.Locate('no', Request.ContentFields.ValueFromIndex[i], []) = True      if FDTable1.Locate('no', Request.ContentFields.ValueFromIndex[i], []) = True
335      then      then
336        FDTable1.Delete;        FDTable1.Delete;
# Line 335  procedure TWebModule1.WebModule1adminset Line 342  procedure TWebModule1.WebModule1adminset
342    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
343  var  var
344    s: string;    s: string;
345      x: Boolean;
346  begin  begin
347    s:=Request.ContentFields.Values['pass'];    s := Request.ContentFields.Values['pass'];
348    FDTable2.Edit;    if FDTable2.FieldByName('pass').AsString <> s then
349    FDTable2.FieldByName('pass').AsString:=s;    begin
350    FDTable2.Post;      FDTable2.Edit;
351    AddCookie(1,s);      FDTable2.FieldByName('pass').AsString := s;
352    Response.SendRedirect(ReplaceText(FDTable2.FieldByName('home').AsAnsiString+'admin','http','https'));      FDTable2.Post;
353        AddCookie(14, s);
354      end;
355      x := Request.ContentFields.Values['mente'] = 'on';
356      if FDTable2.FieldByName('mente').AsBoolean <> x then
357      begin
358        FDTable2.Edit;
359        FDTable2.FieldByName('mente').AsBoolean := x;
360        FDTable2.Post;
361      end;
362      Response.SendRedirect(ReplaceText(FDTable2.FieldByName('home').AsAnsiString +
363        'admin', 'http', 'https'));
364  end;  end;
365    
366  procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;  procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;
# Line 349  procedure TWebModule1.WebModule1DefaultH Line 368  procedure TWebModule1.WebModule1DefaultH
368  var  var
369    s: TResourceStream;    s: TResourceStream;
370  begin  begin
371      if FDTable2.FieldByName('mente').AsBoolean = True then
372      begin
373        s := TResourceStream.Create(HInstance, 'mente', RT_RCDATA);
374        try
375          uri := 'mente';
376          Response.ContentType := 'text/html; charset=utf-8;';
377          Response.Content := PageProducer1.ContentFromStream(s);
378        finally
379          s.Free;
380        end;
381        Exit;
382      end;
383    position := StrToIntDef(Request.QueryFields.Values['pos'], -1);    position := StrToIntDef(Request.QueryFields.Values['pos'], -1);
384    user := Request.CookieFields.Values['UID'];    user := Request.CookieFields.Values['UID'];
385    s:=TResourceStream.Create(HInstance,'index',RT_RCDATA);    s := TResourceStream.Create(HInstance, 'index', RT_RCDATA);
386    try    try
387      uri:='index';      uri := 'index';
     PageProducer1.HTMLDoc.LoadFromStream(s);  
388      Response.ContentType := 'text/html; charset=utf-8;';      Response.ContentType := 'text/html; charset=utf-8;';
389      Response.Content := PageProducer1.Content;      Response.Content := PageProducer1.ContentFromStream(s);
390    finally    finally
391      s.Free;      s.Free;
392    end;    end;
# Line 367  procedure TWebModule1.WebModule1loginAct Line 397  procedure TWebModule1.WebModule1loginAct
397  var  var
398    s: TResourceStream;    s: TResourceStream;
399  begin  begin
400    s:=TResourceStream.Create(HInstance,'login',RT_RCDATA);    s := TResourceStream.Create(HInstance, 'login', RT_RCDATA);
401    try    try
402      uri:='login';      uri := 'login';
     PageProducer1.HTMLDoc.LoadFromStream(s);  
403      Response.ContentType := 'text/html; charset=utf-8;';      Response.ContentType := 'text/html; charset=utf-8;';
404      Response.Content := PageProducer1.Content;      Response.Content := PageProducer1.ContentFromStream(s);
405    finally    finally
406      s.Free;      s.Free;
407    end;    end;
# Line 393  begin Line 422  begin
422      com := Values['comment'];      com := Values['comment'];
423      pass := Values['password'];      pass := Values['password'];
424    end;    end;
425    er:='';    er := '';
426    line:=0;    line := 0;
427    if na = '' then    if na = '' then
428      na := '誰かさん';      na := '誰かさん';
429    if sub = '' then    if sub = '' then
# Line 406  begin Line 435  begin
435    for i := 0 to words.count - 1 do    for i := 0 to words.count - 1 do
436      if ContainsText(AnsiString(com), AnsiString(words[i])) = True then      if ContainsText(AnsiString(com), AnsiString(words[i])) = True then
437      begin      begin
438        er:=er + '禁止語句が含まれます.';        er := er + '禁止語句が含まれます.';
439        break;        break;
440      end;      end;
441    if FDTable1.RecordCount = 0 then    if FDTable1.RecordCount = 0 then
# Line 422  begin Line 451  begin
451    if er <> '' then    if er <> '' then
452    begin    begin
453      Response.ContentType := 'text/html; charset=utf-8;';      Response.ContentType := 'text/html; charset=utf-8;';
454      s:=TResourceStream.Create(HInstance,'regist',RT_RCDATA);      s := TResourceStream.Create(HInstance, 'regist', RT_RCDATA);
455      try      try
456        Response.Content:=PageProducer1.ContentFromStream(s);        Response.Content := PageProducer1.ContentFromStream(s);
457      finally      finally
458        s.Free;        s.Free;
459      end;      end;
# Line 468  begin Line 497  begin
497    end;    end;
498    if t3 = '' then    if t3 = '' then
499    begin    begin
500      m:=TResourceStream.Create(HInstance,'search',RT_RCDATA);      m := TResourceStream.Create(HInstance, 'search', RT_RCDATA);
501      try      try
502        PageProducer1.HTMLDoc.LoadFromStream(m);        Response.ContentType := 'text/html; charset=utf-8;';
503        Response.ContentType := 'text/html; cahrset=utf-8';        Response.Content := PageProducer1.ContentFromStream(m);
       Response.Content := PageProducer1.Content;  
504      finally      finally
505        m.Free;        m.Free;
506      end;      end;
# Line 480  begin Line 508  begin
508    end;    end;
509    FDTable1.Filter := t3;    FDTable1.Filter := t3;
510    FDTable1.Filtered := True;    FDTable1.Filtered := True;
511    m:=TResourceStream.Create(HInstance,'search',RT_RCDATA);    m := TResourceStream.Create(HInstance, 'search', RT_RCDATA);
512    try    try
513      j := 0;      j := 0;
514      for i := 1 to FDTable1.RecordCount - 1 do      for i := 1 to FDTable1.RecordCount - 1 do
# Line 513  var Line 541  var
541    i: integer;    i: integer;
542    s: string;    s: string;
543  begin  begin
544    for i := 0 to Request.ContentFields.Count - 1 do    for i := 0 to Request.ContentFields.count - 1 do
545    begin    begin
546      s := Request.ContentFields.Names[i];      s := Request.ContentFields.Names[i];
547      if s <> 'home' then      if s <> 'home' then
# Line 552  begin Line 580  begin
580      FDTable2.CreateTable(false, [tpTable]);      FDTable2.CreateTable(false, [tpTable]);
581      FDTable2.Active := True;      FDTable2.Active := True;
582      {      {
583      if (Request.ServerPort = 80) or (Request.ServerPort = 443) then        if (Request.ServerPort = 80) or (Request.ServerPort = 443) then
584        s := 'http://' + String(Request.Host)        s := 'http://' + String(Request.Host)
585      else        else
586        s := 'http://' + String(Request.Host) + ':' +        s := 'http://' + String(Request.Host) + ':' +
587          IntToStr(Request.ServerPort);        IntToStr(Request.ServerPort);
588          }      }
589      s:='http://'+String(Request.Host);      s := 'http://' + String(Request.Host);
590      if Request.ScriptName <> '' then      if Request.ScriptName <> '' then
591        s := s + String(Request.ScriptName) + '/'        s := s + String(Request.ScriptName) + '/'
592      else      else
593        s := s + '/';        s := s + '/';
594      FDTable2.AppendRecord([s, 'pbbs clone',      FDTable2.AppendRecord([s, 'pbbs clone',
595        '<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>',
596        'admin', 'あほ,ばか,死ね']);        'admin', 'あほ,ばか,死ね', false]);
597      m:=TResourceStream.Create(HInstance,'setup',RT_RCDATA);      m := TResourceStream.Create(HInstance, 'setup', RT_RCDATA);
598      try      try
599        uri:='setup';        uri := 'setup';
600        PageProducer1.HTMLDoc.LoadFromStream(m);        PageProducer1.HTMLDoc.LoadFromStream(m);
601        Response.ContentType := 'text/html; charset=utf-8;';        Response.ContentType := 'text/html; charset=utf-8;';
602        Response.Content := PageProducer1.Content;        Response.Content := PageProducer1.Content;
# Line 597  begin Line 625  begin
625      Handled := True;      Handled := True;
626    end;    end;
627    {    {
628    t:='';      t:='';
629    ssl:=TStringList.Create;      ssl:=TStringList.Create;
630    try      try
631      ssl.Add('/login');      ssl.Add('/login');
632      ssl.Add('/admin');      ssl.Add('/admin');
633      if (ssl.IndexOf(Request.PathInfo) > -1)and(StartsText('https',FDTable2.FieldByName('home').AsString) = false) then      if (ssl.IndexOf(Request.PathInfo) > -1)and(StartsText('https',FDTable2.FieldByName('home').AsString) = false) then
634      begin      begin
635        s:=FDTable2.FieldByName('home').AsAnsiString;      s:=FDTable2.FieldByName('home').AsAnsiString;
636        Delete(s,Length(s),1);      Delete(s,Length(s),1);
637        t:='https'+Copy(s,5,Length(s))+Request.PathInfo;      t:='https'+Copy(s,5,Length(s))+Request.PathInfo;
638      end;      end;
639    finally      finally
640      ssl.Free;      ssl.Free;
641    end;      end;
642    if t <> '' then      if t <> '' then
643    begin      begin
644      Response.SendRedirect(t);      Response.SendRedirect(t);
645      Exit;      Exit;
646    end;      end;
647    }    }
648  end;  end;
649    
# Line 631  begin Line 659  begin
659  end;  end;
660    
661  end.  end.
662    
Legend:
Removed from v.3  
changed lines
  Added in v.4
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help