WebModuleUnit1.pas

   1 unit WebModuleUnit1;
   2
   3 interface
   4
   5 uses System.SysUtils, System.Classes, Web.HTTPApp, Web.HTTPProd;
   6
   7 type
   8   TWebModule1 = class(TWebModule)
   9     readerTop: TPageProducer;
  10     top: TPageProducer;
  11     writerTop: TPageProducer;
  12     writerData: TPageProducer;
  13     backnumber: TPageProducer;
  14     mainView: TPageProducer;
  15     writerpage: TPageProducer;
  16     upload: TPageProducer;
  17     mags: TPageProducer;
  18     procedure WebModule1DefaultHandlerAction(Sender: TObject;
  19       Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  20     procedure WebModule1writeMagAction(Sender: TObject; Request: TWebRequest;
  21       Response: TWebResponse; var Handled: Boolean);
  22     procedure WebModule1selectionAction(Sender: TObject; Request: TWebRequest;
  23       Response: TWebResponse; var Handled: Boolean);
  24     procedure WebModule1writerDataAction(Sender: TObject; Request: TWebRequest;
  25       Response: TWebResponse; var Handled: Boolean);
  26     procedure WebModule1readerDataAction(Sender: TObject; Request: TWebRequest;
  27       Response: TWebResponse; var Handled: Boolean);
  28     procedure WebModule1detailAction(Sender: TObject; Request: TWebRequest;
  29       Response: TWebResponse; var Handled: Boolean);
  30     procedure WebModule1writerTopAction(Sender: TObject; Request: TWebRequest;
  31       Response: TWebResponse; var Handled: Boolean);
  32     procedure WebModule1loginAction(Sender: TObject; Request: TWebRequest;
  33       Response: TWebResponse; var Handled: Boolean);
  34     procedure WebModule1logoutAction(Sender: TObject; Request: TWebRequest;
  35       Response: TWebResponse; var Handled: Boolean);
  36     procedure WebModule1mainViewAction(Sender: TObject; Request: TWebRequest;
  37       Response: TWebResponse; var Handled: Boolean);
  38     procedure WebModule1imageAction(Sender: TObject; Request: TWebRequest;
  39       Response: TWebResponse; var Handled: Boolean);
  40     procedure WebModule1readerTopAction(Sender: TObject; Request: TWebRequest;
  41       Response: TWebResponse; var Handled: Boolean);
  42     procedure WebModule1login2Action(Sender: TObject; Request: TWebRequest;
  43       Response: TWebResponse; var Handled: Boolean);
  44     procedure WebModule1writerpageAction(Sender: TObject; Request: TWebRequest;
  45       Response: TWebResponse; var Handled: Boolean);
  46     procedure WebModule1uploadAction(Sender: TObject; Request: TWebRequest;
  47       Response: TWebResponse; var Handled: Boolean);
  48     procedure uploadHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
  49       TagParams: TStrings; var ReplaceText: string);
  50     procedure magsHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
  51       TagParams: TStrings; var ReplaceText: string);
  52   private
  53     { private \90é\8c¾ }
  54     writerId: integer;
  55     readerId: integer;
  56   public
  57     { public \90é\8c¾ }
  58   end;
  59
  60 var
  61   WebModuleClass: TComponentClass = TWebModule1;
  62
  63 implementation
  64
  65 uses SynMustache, SynCommons, System.JSON, Unit1, System.NetEncoding;
  66
  67 { %CLASSGROUP 'Vcl.Controls.TControl' }
  68
  69 {$R *.dfm}
  70
  71 var
  72   mustache: TSynMustache;
  73
  74 procedure TWebModule1.magsHTMLTag(Sender: TObject; Tag: TTag;
  75   const TagString: string; TagParams: TStrings; var ReplaceText: string);
  76 begin
  77   if TagString = 'main' then
  78     ReplaceText:=backnumber.Content;
  79 end;
  80
  81 procedure TWebModule1.uploadHTMLTag(Sender: TObject; Tag: TTag;
  82   const TagString: string; TagParams: TStrings; var ReplaceText: string);
  83 begin
  84   if TagString = 'main' then
  85     ReplaceText:=backnumber.Content;
  86 end;
  87
  88 procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;
  89   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  90 var
  91   data: TJSONObject;
  92 begin
  93   DataModule1.magListAll(readerId, data);
  94   if readerId = 0 then
  95     data.AddPair('id', TJSONFalse.Create)
  96   else
  97     data.AddPair('id', TJSONTrue.Create);
  98   if Request.QueryFields.Values['op'] <> '' then
  99     data.AddPair('comment', '2\8fd\93o\98^\82Å\82·\81B\93o\98^\82É\8e¸\94s\82µ\82Ü\82µ\82½\81B')
 100   else
 101     data.AddPair('comment', TJSONFalse.Create);
 102   mustache := TSynMustache.Parse(top.Content);
 103   Response.ContentType := 'text/html;charset=utf-8';
 104   Response.Content := mustache.RenderJSON(data.ToJSON);
 105   data.Free;
 106 end;
 107
 108 procedure TWebModule1.WebModule1detailAction(Sender: TObject;
 109   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 110 var
 111   data: TJSONObject;
 112 begin
 113   DataModule1.backnumber(Request.QueryFields.Values['id'], data);
 114   Response.ContentType := 'text/html;charset=utf-8';
 115   mustache := TSynMustache.Parse(mags.Content);
 116   Response.Content := mustache.RenderJSON(data.ToString);
 117 end;
 118
 119 procedure TWebModule1.WebModule1imageAction(Sender: TObject;
 120   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 121 var
 122   id: integer;
 123   data: TJSONObject;
 124   mem: TMemoryStream;
 125   raw: TBytes;
 126 begin
 127   data := TJSONObject.Create;
 128   data.AddPair('id', TJSONNumber.Create(Request.QueryFields.Values['id']));
 129   data.AddPair('number', TJSONNumber.Create(Request.QueryFields.Values['num']));
 130   id := DataModule1.imageId(data);
 131   DataModule1.imageView(id, data);
 132   mem := TMemoryStream.Create;
 133   raw := TNetEncoding.Base64.DecodeStringToBytes(data.Values['data'].Value);
 134   mem.WriteBuffer(raw, Length(raw));
 135   mem.Position := 0;
 136   Finalize(raw);
 137   Response.ContentType := 'jpeg/image';
 138   Response.ContentStream := mem;
 139 end;
 140
 141 procedure TWebModule1.WebModule1login2Action(Sender: TObject;
 142   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 143 var
 144   data: TJSONObject;
 145 begin
 146   data:=TJSONObject.Create;
 147   data.AddPair('mail',Request.ContentFields.Values['mail']);
 148   data.AddPair('password',Request.ContentFields.Values['password']);
 149   writerId:=DataModule1.loginWriter(data);
 150   Response.SendRedirect('/writer/page');
 151 end;
 152
 153 procedure TWebModule1.WebModule1loginAction(Sender: TObject;
 154   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 155 var
 156   data: TJSONObject;
 157 begin
 158   data := TJSONObject.Create;
 159   with Request.ContentFields do
 160   begin
 161     data.AddPair('mail', Values['mail']);
 162     data.AddPair('password', Values['password']);
 163   end;
 164   readerId := DataModule1.loginReader(data);
 165   data.Free;
 166   Handled := false;
 167 end;
 168
 169 procedure TWebModule1.WebModule1logoutAction(Sender: TObject;
 170   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 171 begin
 172   readerId := 0;
 173   writerId := 0;
 174   Handled := false;
 175 end;
 176
 177 procedure TWebModule1.WebModule1mainViewAction(Sender: TObject;
 178   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 179 var
 180   data: TJSONObject;
 181 begin
 182   Response.ContentType := 'text/html;charset=utf-8';
 183   DataModule1.mainView(readerId, data);
 184   mustache := TSynMustache.Parse(mainView.Content);
 185   Response.Content := mustache.RenderJSON(data.ToJSON);
 186 end;
 187
 188 procedure TWebModule1.WebModule1readerDataAction(Sender: TObject;
 189   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 190 var
 191   data, d: TJSONObject;
 192   num: TJSONNumber;
 193 begin
 194   with Request.ContentFields do
 195   begin
 196     data := TJSONObject.Create;
 197     data.AddPair('id', TJSONNumber.Create(readerId));
 198     data.AddPair('name', Values['reader']);
 199     data.AddPair('mail', Values['mail']);
 200     data.AddPair('password', Values['password']);
 201   end;
 202   case Request.MethodType of
 203     mtGet:
 204       if readerId = 0 then
 205       begin
 206         Handled := false;
 207         Exit;
 208       end;
 209     mtPut:
 210       if DataModule1.checkUserPassword(readerId, data.Values['password'].Value)
 211         = true then
 212       begin
 213         data.RemovePair('password');
 214         data.AddPair('password', Request.ContentFields.Values['new']);
 215         DataModule1.updateReaderId(data);
 216       end;
 217     mtPost:
 218       begin
 219         readerId := DataModule1.createReaderId(data);
 220         if readerId = 0 then
 221         begin
 222           Response.SendRedirect('/top?op=1#message');
 223           Exit;
 224         end;
 225       end;
 226     mtDelete:
 227       with Request.ContentFields do
 228       begin
 229         num := TJSONNumber.Create(readerId);
 230         data.AddPair('id', num);
 231         DataModule1.deleteReaderId(data);
 232         num.Free;
 233       end;
 234   end;
 235   data.Free;
 236   Response.ContentType := 'text/html;charset=utf-8';
 237   DataModule1.userView(readerId, data);
 238   DataModule1.readerData(readerId, d);
 239   data.AddPair('reader', d);
 240   mustache := TSynMustache.Parse(readerTop.Content);
 241   Response.Content := mustache.RenderJSON(data.ToJSON);
 242 end;
 243
 244 procedure TWebModule1.WebModule1readerTopAction(Sender: TObject;
 245   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 246 var
 247   data: TJSONObject;
 248 begin
 249   Response.ContentType := 'text/html;charset=utf-8';
 250   DataModule1.getView(readerId, data);
 251   mustache := TSynMustache.Parse(mainView.Content);
 252   Response.Content := mustache.RenderJSON(data.ToJSON);
 253 end;
 254
 255 procedure TWebModule1.WebModule1selectionAction(Sender: TObject;
 256   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 257 var
 258   id: integer;
 259 begin
 260   id := DataModule1.magid(Request.ContentFields.Values['name']);
 261   case Request.MethodType of
 262     mtPost:
 263       DataModule1.magIdOn(readerId, id);
 264     mtDelete:
 265       DataModule1.magIdOff(readerId, id);
 266   end;
 267   Handled := false;
 268 end;
 269
 270 procedure TWebModule1.WebModule1uploadAction(Sender: TObject;
 271   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 272 var
 273   num: string;
 274   data: TJSONObject;
 275 begin
 276   if Request.MethodType = mtPost then
 277   begin
 278     num:=Request.ContentFields.Values['magNum'];
 279   end;
 280   Response.ContentType:='text/html;charset=utf-8';
 281   data:=TJSONObject.Create;
 282   DataModule1.backNumber(num,data);
 283   mustache:=TSynMustAche.Parse(upload.Content);
 284   Response.Content:=mustache.RenderJSON(data.ToJSON);
 285 end;
 286
 287 procedure TWebModule1.WebModule1writeMagAction(Sender: TObject;
 288   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 289 var
 290   data: TJSONObject;
 291 begin
 292   data := TJSONObject.Create;
 293   data.AddPair('magName', Request.ContentFields.Values['name']);
 294   data.AddPair('comment', Request.ContentFields.Values['comment']);
 295   data.AddPair('day', Request.ContentFields.Values['day']);
 296   data.AddPair('enable', TJSONTrue.Create);
 297   DataModule1.createMagId(writerId, data);
 298   data.Free;
 299   Response.SendRedirect('/writer/top');
 300 end;
 301
 302 procedure TWebModule1.WebModule1writerDataAction(Sender: TObject;
 303   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 304 var
 305   data: TJSONObject;
 306 begin
 307   with Request.ContentFields do
 308   begin
 309     data := TJSONObject.Create;
 310     data.AddPair('mail', Values['mail']);
 311     data.AddPair('password', Values['password']);
 312   end;
 313   case Request.MethodType of
 314     mtGet:
 315       if writerId = 0 then
 316       begin
 317         Handled := false;
 318         Exit;
 319       end;
 320     mtPost:
 321       if Request.ContentFields.Values['_method'] = 'delete' then
 322         DataModule1.deleteWriter(writerId)
 323       else if DataModule1.existsMail(data.Values['mail'].Value) = false then
 324       begin
 325         data.AddPair('name', Request.ContentFields.Values['writer']);
 326         if Request.ContentFields.Values['_method'] = 'put' then
 327           DataModule1.updateWriterId(writerId, data)
 328         else
 329           DataModule1.createWriterId(data);
 330       end
 331       else
 332         { \83\81\81[\83\8b\83A\83h\83\8c\83X\82Ì2\8fd\93o\98^ };
 333     mtPut:
 334       DataModule1.updateWriterId(writerId, data);
 335     mtDelete:
 336       DataModule1.deleteWriter(writerId);
 337   end;
 338   data.Free;
 339   data := TJSONObject.Create;
 340   DataModule1.custData(writerId, data);
 341   Response.ContentType := 'text/html;charset=utf-8';
 342   mustache := TSynMustache.Parse(writerData.Content);
 343   Response.Content := mustache.RenderJSON(data.ToJSON);
 344   data.Free;
 345 end;
 346
 347 procedure TWebModule1.WebModule1writerpageAction(Sender: TObject;
 348   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 349 var
 350   data: TJSONObject;
 351 begin
 352   Response.ContentType:='text/html;charset=utf-8';
 353   data:=TJSONObject.Create;
 354   if writerId = 0 then
 355     data.AddPair('login',TJSONFalse.Create)
 356   else
 357     data.AddPair('login',TJSONTrue.Create);
 358   mustache:=TSynMustAche.Parse(writerpage.Content);
 359   Response.Content:=mustache.RenderJSON(data.ToJSON);
 360 end;
 361
 362 procedure TWebModule1.WebModule1writerTopAction(Sender: TObject;
 363   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 364 var
 365   data: TJSONObject;
 366 begin
 367   if writerId = 0 then
 368   begin
 369     Handled:=false;
 370     Exit;
 371   end;
 372   data := TJSONObject.Create;
 373   DataModule1.magazines(writerId, data);
 374   Response.ContentType := 'text/html;charset=utf-8';
 375   mustache := TSynMustache.Parse(writerTop.Content);
 376   Response.Content := mustache.RenderJSON(data.ToJSON);
 377   data.Free;
 378 end;
 379
 380 end.