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