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   System.Zip, ReqMulti;
  67
  68 { %CLASSGROUP 'Vcl.Controls.TControl' }
  69
  70 {$R *.dfm}
  71
  72 var
  73   mustache: TSynMustache;
  74
  75 procedure TWebModule1.magsHTMLTag(Sender: TObject; Tag: TTag;
  76   const TagString: string; TagParams: TStrings; var ReplaceText: string);
  77 begin
  78   if TagString = 'main' then
  79     ReplaceText := backnumber.Content;
  80 end;
  81
  82 procedure TWebModule1.uploadHTMLTag(Sender: TObject; Tag: TTag;
  83   const TagString: string; TagParams: TStrings; var ReplaceText: string);
  84 begin
  85   if TagString = 'main' then
  86     ReplaceText := backnumber.Content;
  87 end;
  88
  89 procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;
  90   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  91 var
  92   data: TJSONObject;
  93 begin
  94   DataModule1.magListAll(readerId, data);
  95   if readerId = 0 then
  96     data.AddPair('id', TJSONFalse.Create)
  97   else
  98     data.AddPair('id', TJSONTrue.Create);
  99   if Request.QueryFields.Values['op'] <> '' then
 100     data.AddPair('comment', '2\8fd\93o\98^\82Å\82·\81B\93o\98^\82É\8e¸\94s\82µ\82Ü\82µ\82½\81B')
 101   else
 102     data.AddPair('comment', TJSONFalse.Create);
 103   mustache := TSynMustache.Parse(top.Content);
 104   Response.ContentType := 'text/html;charset=utf-8';
 105   Response.Content := mustache.RenderJSON(data.ToJSON);
 106   data.Free;
 107 end;
 108
 109 procedure TWebModule1.WebModule1detailAction(Sender: TObject;
 110   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 111 var
 112   data: TJSONObject;
 113 begin
 114   DataModule1.backnumber(Request.QueryFields.Values['id'], data);
 115   Response.ContentType := 'text/html;charset=utf-8';
 116   mustache := TSynMustache.Parse(mags.Content);
 117   Response.Content := mustache.RenderJSON(data.ToString);
 118 end;
 119
 120 procedure TWebModule1.WebModule1imageAction(Sender: TObject;
 121   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 122 var
 123   magnum, name: string;
 124   newsid: integer;
 125   str: string;
 126   data: TJSONObject;
 127   mem: TMemoryStream;
 128   raw: TBytes;
 129 begin
 130   data := TJSONObject.Create;
 131   newsid:= Request.QueryFields.Values['id'].ToInteger;
 132   magnum := Request.QueryFields.Values['num'];
 133   name:=Request.QueryFields.Values['name'];
 134   DataModule1.imageView(magNum, name, newsid, data);
 135   str:=data.Values['data'].Value;
 136   mem := TMemoryStream.Create;
 137   if data.Values['encode'].Value = 'true' then
 138   begin
 139     raw := TNetEncoding.Base64.DecodeStringToBytes(str);
 140     mem.WriteBuffer(raw, Length(raw));
 141     Finalize(raw);
 142   end
 143   else
 144     mem.WriteBuffer(PChar(str)^, SizeOf(Char)*Length(str));
 145   mem.Position := 0;
 146   Response.ContentType := 'jpeg/image';
 147   Response.ContentStream := mem;
 148 end;
 149
 150 procedure TWebModule1.WebModule1login2Action(Sender: TObject;
 151   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 152 var
 153   data: TJSONObject;
 154 begin
 155   data := TJSONObject.Create;
 156   data.AddPair('mail', Request.ContentFields.Values['mail']);
 157   data.AddPair('password', Request.ContentFields.Values['password']);
 158   writerId := DataModule1.loginWriter(data);
 159   if writerId = 0 then
 160     Response.SendRedirect('/writer/page')
 161   else
 162     Response.SendRedirect('/writer/top');
 163 end;
 164
 165 procedure TWebModule1.WebModule1loginAction(Sender: TObject;
 166   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 167 var
 168   data: TJSONObject;
 169 begin
 170   data := TJSONObject.Create;
 171   with Request.ContentFields do
 172   begin
 173     data.AddPair('mail', Values['mail']);
 174     data.AddPair('password', Values['password']);
 175   end;
 176   readerId := DataModule1.loginReader(data);
 177   data.Free;
 178   Handled := false;
 179 end;
 180
 181 procedure TWebModule1.WebModule1logoutAction(Sender: TObject;
 182   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 183 begin
 184   readerId := 0;
 185   writerId := 0;
 186   Handled := false;
 187 end;
 188
 189 procedure TWebModule1.WebModule1mainViewAction(Sender: TObject;
 190   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 191 var
 192   data: TJSONObject;
 193 begin
 194   Response.ContentType := 'text/html;charset=utf-8';
 195   DataModule1.mainView(readerId, data);
 196   mustache := TSynMustache.Parse(mainView.Content);
 197   Response.Content := mustache.RenderJSON(data.ToJSON);
 198 end;
 199
 200 procedure TWebModule1.WebModule1readerDataAction(Sender: TObject;
 201   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 202 var
 203   data, d: TJSONObject;
 204   num: TJSONNumber;
 205 begin
 206   with Request.ContentFields do
 207   begin
 208     data := TJSONObject.Create;
 209     data.AddPair('id', TJSONNumber.Create(readerId));
 210     data.AddPair('name', Values['reader']);
 211     data.AddPair('mail', Values['mail']);
 212     data.AddPair('password', Values['password']);
 213   end;
 214   case Request.MethodType of
 215     mtGet:
 216       if readerId = 0 then
 217       begin
 218         Handled := false;
 219         Exit;
 220       end;
 221     mtPut:
 222       if DataModule1.checkUserPassword(readerId, data.Values['password'].Value)
 223         = true then
 224       begin
 225         data.RemovePair('password');
 226         data.AddPair('password', Request.ContentFields.Values['new']);
 227         DataModule1.updateReaderId(data);
 228       end;
 229     mtPost:
 230       begin
 231         readerId := DataModule1.createReaderId(data);
 232         if readerId = 0 then
 233         begin
 234           Response.SendRedirect('/top?op=1#message');
 235           Exit;
 236         end;
 237       end;
 238     mtDelete:
 239       with Request.ContentFields do
 240       begin
 241         num := TJSONNumber.Create(readerId);
 242         data.AddPair('id', num);
 243         DataModule1.deleteReaderId(data);
 244         num.Free;
 245       end;
 246   end;
 247   data.Free;
 248   Response.ContentType := 'text/html;charset=utf-8';
 249   DataModule1.userView(readerId, data);
 250   DataModule1.readerData(readerId, d);
 251   data.AddPair('reader', d);
 252   mustache := TSynMustache.Parse(readerTop.Content);
 253   Response.Content := mustache.RenderJSON(data.ToJSON);
 254 end;
 255
 256 procedure TWebModule1.WebModule1readerTopAction(Sender: TObject;
 257   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 258 var
 259   data: TJSONObject;
 260 begin
 261   Response.ContentType := 'text/html;charset=utf-8';
 262   DataModule1.mainView(readerId, data);
 263   mustache := TSynMustache.Parse(mainView.Content);
 264   Response.Content := mustache.RenderJSON(data.ToJSON);
 265 end;
 266
 267 procedure TWebModule1.WebModule1selectionAction(Sender: TObject;
 268   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 269 var
 270   num: string;
 271 begin
 272   num := Request.ContentFields.Values['name'];
 273   case Request.MethodType of
 274     mtPost:
 275       DataModule1.magIdOn(readerId, num);
 276     mtDelete:
 277       DataModule1.magIdOff(readerId, num);
 278   end;
 279   Handled := false;
 280 end;
 281
 282 procedure TWebModule1.WebModule1uploadAction(Sender: TObject;
 283   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 284 var
 285   num: string;
 286   stream, mem: TStream;
 287   sub, data: TJSONObject;
 288 begin
 289   num := Request.QueryFields.Values['num'];
 290   if Request.MethodType = mtPost then
 291   begin
 292     stream := Request.Files[0].stream;
 293     mem := TMemoryStream.Create;
 294     mem.CopyFrom(stream, stream.Size);
 295     mem.Position := 0;
 296     DataModule1.zipFile(writerId, num, mem);
 297     mem.Free;
 298   end;
 299   Response.ContentType := 'text/html;charset=utf-8';
 300   DataModule1.backnumber(num, data);
 301   mustache := TSynMustache.Parse(upload.Content);
 302   Response.Content := mustache.RenderJSON(data.ToJSON);
 303 end;
 304
 305 procedure TWebModule1.WebModule1writeMagAction(Sender: TObject;
 306   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 307 var
 308   data: TJSONObject;
 309 begin
 310   data := TJSONObject.Create;
 311   data.AddPair('magName', Request.ContentFields.Values['name']);
 312   data.AddPair('comment', Request.ContentFields.Values['comment']);
 313   data.AddPair('day', Request.ContentFields.Values['day']);
 314   data.AddPair('enable', TJSONTrue.Create);
 315   DataModule1.createMagId(writerId, data);
 316   data.Free;
 317   Response.SendRedirect('/writer/top');
 318 end;
 319
 320 procedure TWebModule1.WebModule1writerDataAction(Sender: TObject;
 321   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 322 var
 323   data: TJSONObject;
 324 begin
 325   with Request.ContentFields do
 326   begin
 327     data := TJSONObject.Create;
 328     data.AddPair('mail', Values['mail']);
 329     data.AddPair('password', Values['password']);
 330   end;
 331   case Request.MethodType of
 332     mtGet:
 333       if writerId = 0 then
 334       begin
 335         Handled := false;
 336         Exit;
 337       end;
 338     mtPost:
 339       if Request.ContentFields.Values['_method'] = 'delete' then
 340       begin
 341         DataModule1.deleteWriter(writerId);
 342         Response.SendRedirect('/writer/page');
 343         Exit;
 344       end
 345       else if DataModule1.existsMail(data.Values['mail'].Value) = false then
 346       begin
 347         data.AddPair('name', Request.ContentFields.Values['writer']);
 348         if Request.ContentFields.Values['_method'] = 'put' then
 349           DataModule1.updateWriterId(writerId, data)
 350         else
 351           writerId := DataModule1.createWriterId(data);
 352         /// var param?
 353       end
 354       else
 355       begin
 356         { \83\81\81[\83\8b\83A\83h\83\8c\83X\82Ì2\8fd\93o\98^ };
 357         Response.SendRedirect('/writer/page');
 358         Exit;
 359       end;
 360     mtPut:
 361       DataModule1.updateWriterId(writerId, data);
 362     mtDelete:
 363       DataModule1.deleteWriter(writerId);
 364   end;
 365   data.Free;
 366   data := TJSONObject.Create;
 367   DataModule1.custData(writerId, data);
 368   Response.ContentType := 'text/html;charset=utf-8';
 369   mustache := TSynMustache.Parse(writerData.Content);
 370   Response.Content := mustache.RenderJSON(data.ToJSON);
 371   data.Free;
 372 end;
 373
 374 procedure TWebModule1.WebModule1writerpageAction(Sender: TObject;
 375   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 376 var
 377   data: TJSONObject;
 378 begin
 379   Response.ContentType := 'text/html;charset=utf-8';
 380   data := TJSONObject.Create;
 381   if writerId = 0 then
 382     data.AddPair('login', TJSONFalse.Create)
 383   else
 384     data.AddPair('login', TJSONTrue.Create);
 385   mustache := TSynMustache.Parse(writerpage.Content);
 386   Response.Content := mustache.RenderJSON(data.ToJSON);
 387 end;
 388
 389 procedure TWebModule1.WebModule1writerTopAction(Sender: TObject;
 390   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 391 var
 392   data: TJSONObject;
 393 begin
 394   if writerId = 0 then
 395   begin
 396     Handled := false;
 397     Exit;
 398   end;
 399   data := TJSONObject.Create;
 400   DataModule1.magazines(writerId, data);
 401   Response.ContentType := 'text/html;charset=utf-8';
 402   mustache := TSynMustache.Parse(writerTop.Content);
 403   Response.Content := mustache.RenderJSON(data.ToJSON);
 404   data.Free;
 405 end;
 406
 407 end.