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 9 by yamat0jp, Sat Sep 17 04:45:16 2016 UTC revision 11 by yamat0jp, Mon Sep 19 00:45:34 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, Vcl.AppEvnts;    AnsiStrings, System.DateUtils, System.Types, Vcl.AppEvnts, System.NetEncoding;
12    
13  type  type
14    TWebModule1 = class(TWebModule)    TWebModule1 = class(TWebModule)
# Line 171  var Line 171  var
171    s: TDataSetPageProducer;    s: TDataSetPageProducer;
172  begin  begin
173    if TagString = 'home' then    if TagString = 'home' then
174        ReplaceText := FDTable2.FieldByName('home').AsString;      ReplaceText := FDTable2.FieldByName('home').AsString;
175    if (TagString = 'title') or (TagString = 'title2') then    if (TagString = 'title') or (TagString = 'title2') then
176      ReplaceText := FDTable2.FieldByName(TagString).AsString;      ReplaceText := FDTable2.FieldByName(TagString).AsString;
177    if TagString = 'username' then    if TagString = 'username' then
# Line 180  begin Line 180  begin
180    begin    begin
181      if FDTable1.RecordCount = 0 then      if FDTable1.RecordCount = 0 then
182      begin      begin
183        if uri = 'index' then        if uri = '/index' then
184          ReplaceText := '<hr>まだ投稿がありません.<hr>';          ReplaceText := '<hr>まだ投稿がありません.<hr>';
185      end      end
186      else      else
187      begin      begin
188        count := FDTable3.FieldByName('count').AsInteger;        count := FDTable3.FieldByName('count').AsInteger;
189        if uri = 'admin' then        if uri = '/admin' then
190          s := adminDS          s := adminDS
191        else        else
192          s := DataSetPageProducer2;          s := DataSetPageProducer2;
# Line 270  var Line 270  var
270      x := false;      x := false;
271      s := TResourceStream.Create(HInstance, 'admin', RT_RCDATA);      s := TResourceStream.Create(HInstance, 'admin', RT_RCDATA);
272      try      try
273        uri := 'admin';        uri := '/admin';
274        Response.ContentType := 'text/html; charset=utf-8;';        Response.ContentType := 'text/html; charset=utf-8;';
275        Response.Content := PageProducer1.ContentFromStream(s)        Response.Content := PageProducer1.ContentFromStream(s)
276      finally      finally
# Line 281  var Line 281  var
281    begin    begin
282      with Response.Cookies.Add do      with Response.Cookies.Add do
283      begin      begin
284        path := AnsiString('/admin');        path := '/';
285        Expires := Now + day;        Expires := Now + day;
286        Name := 'psw';        Name := 'psw';
287        Value := AnsiString(pass);        Value := AnsiString(pass);
# Line 292  begin Line 292  begin
292    if Request.Query = 'del' then    if Request.Query = 'del' then
293    begin    begin
294      addcookie(-3, '');      addcookie(-3, '');
295      Response.SendRedirect('/index');      Response.SendRedirect(FDTable2.FieldByName('home').AsAnsiString + '/index');
296      Exit;      Exit;
297    end;    end;
298    x := True;    x := True;
# Line 308  begin Line 308  begin
308    then    then
309      something;      something;
310    if x = True then    if x = True then
311      Response.SendRedirect('/login');      Response.SendRedirect(FDTable2.FieldByName('home').AsAnsiString + '/login');
312  end;  end;
313    
314  procedure TWebModule1.WebModule1admindelAction(Sender: TObject;  procedure TWebModule1.WebModule1admindelAction(Sender: TObject;
# Line 320  begin Line 320  begin
320      if FDTable1.Locate('no', Request.ContentFields.ValueFromIndex[i], []) = True      if FDTable1.Locate('no', Request.ContentFields.ValueFromIndex[i], []) = True
321      then      then
322        FDTable1.Delete;        FDTable1.Delete;
323    Response.SendRedirect('/admin');    Response.SendRedirect(FDTable2.FieldByName('home').AsAnsiString + '/admin');
324  end;  end;
325    
326  procedure TWebModule1.WebModule1adminsetAction(Sender: TObject;  procedure TWebModule1.WebModule1adminsetAction(Sender: TObject;
# Line 337  begin Line 337  begin
337      FDTable2.Post;      FDTable2.Post;
338      with Response.Cookies.Add do      with Response.Cookies.Add do
339      begin      begin
340        path := AnsiString('/admin');        path := AnsiString(FDTable2.FieldByName('home').AsAnsiString + '/admin');
341        Expires := Now + 14;        Expires := Now + 14;
342        Name := 'psw';        Name := 'psw';
343        Value := AnsiString(s);        Value := AnsiString(s);
# Line 350  begin Line 350  begin
350      FDTable2.FieldByName('mente').AsBoolean := x;      FDTable2.FieldByName('mente').AsBoolean := x;
351      FDTable2.Post;      FDTable2.Post;
352    end;    end;
353    Response.SendRedirect('/admin');    Response.SendRedirect(FDTable2.FieldByName('home').AsAnsiString + '/admin');
354  end;  end;
355    
356  procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;  procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;
357    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
358  var  var
359    s: TResourceStream;    s: TResourceStream;
360      t: TURLEncoding;
361  begin  begin
362    if FDTable2.FieldByName('mente').AsBoolean = True then    if FDTable2.FieldByName('mente').AsBoolean = True then
363    begin    begin
364      s := TResourceStream.Create(HInstance, 'mente', RT_RCDATA);      s := TResourceStream.Create(HInstance, 'mente', RT_RCDATA);
365      try      try
366        uri := 'mente';        uri := '/mente';
367        Response.ContentType := 'text/html; charset=utf-8;';        Response.ContentType := 'text/html; charset=utf-8;';
368        Response.Content := PageProducer1.ContentFromStream(s);        Response.Content := PageProducer1.ContentFromStream(s);
369      finally      finally
# Line 371  begin Line 372  begin
372      Exit;      Exit;
373    end;    end;
374    position := StrToIntDef(Request.QueryFields.Values['pos'], -1);    position := StrToIntDef(Request.QueryFields.Values['pos'], -1);
   user := Request.CookieFields.Values['UID'];  
375    s := TResourceStream.Create(HInstance, 'index', RT_RCDATA);    s := TResourceStream.Create(HInstance, 'index', RT_RCDATA);
376      t := TURLEncoding.Create;
377    try    try
378      uri := 'index';      user := t.Decode(Request.CookieFields.Values['UID']);
379        uri := '/index';
380      Response.ContentType := 'text/html; charset=utf-8;';      Response.ContentType := 'text/html; charset=utf-8;';
381      Response.Content := PageProducer1.ContentFromStream(s);      Response.Content := PageProducer1.ContentFromStream(s);
382    finally    finally
# Line 389  var Line 391  var
391  begin  begin
392    s := TResourceStream.Create(HInstance, 'login', RT_RCDATA);    s := TResourceStream.Create(HInstance, 'login', RT_RCDATA);
393    try    try
394      uri := 'login';      uri := '/login';
395      Response.ContentType := 'text/html; charset=utf-8;';      Response.ContentType := 'text/html; charset=utf-8;';
396      Response.Content := PageProducer1.ContentFromStream(s);      Response.Content := PageProducer1.ContentFromStream(s);
397    finally    finally
# Line 452  begin Line 454  begin
454    FDTable1.AppendRecord([na, no, DateTimeToStr(Now), sub, com, pass, line]);    FDTable1.AppendRecord([na, no, DateTimeToStr(Now), sub, com, pass, line]);
455    with Response.Cookies.Add do    with Response.Cookies.Add do
456    begin    begin
457      path := FDTable2.FieldByName('home').AsAnsiString;      path := '/';
458      Name := 'UID';      Name := 'UID';
459      Value := AnsiString(na);      Value := AnsiString(na);
460      Expires := Now + 1;      Expires := Now + 1;
461    end;    end;
462    Response.SendRedirect('/index#article');    Response.SendRedirect(FDTable2.FieldByName('home').AsAnsiString +
463        '/index#article');
464  end;  end;
465    
466  procedure TWebModule1.WebModule1searchAction(Sender: TObject;  procedure TWebModule1.WebModule1searchAction(Sender: TObject;
# Line 564  end; Line 567  end;
567  procedure TWebModule1.WebModuleBeforeDispatch(Sender: TObject;  procedure TWebModule1.WebModuleBeforeDispatch(Sender: TObject;
568    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);    Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
569  var  var
   s: AnsiString;  
570    m: TResourceStream;    m: TResourceStream;
571  begin  begin
572    if FDTable1.Exists = false then    if FDTable1.Exists = false then
# Line 580  begin Line 582  begin
582        s := 'http://' + String(Request.Host) + ':' +        s := 'http://' + String(Request.Host) + ':' +
583        IntToStr(Request.ServerPort);        IntToStr(Request.ServerPort);
584      }      }
585      if Request.ScriptName <> '' then      FDTable2.AppendRecord([Request.ScriptName, 'pbbs clone',
       s := 'http://' + Request.Host + Request.ScriptName + '/'  
     else  
       s := 'http://' + Request.Host + '/';  
     FDTable2.AppendRecord([s, 'pbbs clone',  
586        '<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>',
587        'admin', 'あほ,ばか,死ね', false]);        'admin', 'あほ,ばか,死ね', false]);
588      m := TResourceStream.Create(HInstance, 'setup', RT_RCDATA);      m := TResourceStream.Create(HInstance, 'setup', RT_RCDATA);
589      try      try
590        uri := 'setup';        uri := '/setup';
591        Response.ContentType := 'text/html; charset=utf-8;';        Response.ContentType := 'text/html; charset=utf-8;';
592        Response.Content := PageProducer1.ContentFromStream(m);        Response.Content := PageProducer1.ContentFromStream(m);
593      finally      finally
Legend:
Removed from v.9  
changed lines
  Added in v.11
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help