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     procedure WebModule1DefaultHandlerAction(Sender: TObject;
  16       Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  17     procedure WebModuleCreate(Sender: TObject);
  18     procedure WebModule1writeMagAction(Sender: TObject; Request: TWebRequest;
  19       Response: TWebResponse; var Handled: Boolean);
  20     procedure WebModule1selectionAction(Sender: TObject; Request: TWebRequest;
  21       Response: TWebResponse; var Handled: Boolean);
  22     procedure WebModule1writerDataAction(Sender: TObject; Request: TWebRequest;
  23       Response: TWebResponse; var Handled: Boolean);
  24     procedure WebModule1readerDataAction(Sender: TObject; Request: TWebRequest;
  25       Response: TWebResponse; var Handled: Boolean);
  26     procedure WebModule1detailAction(Sender: TObject; Request: TWebRequest;
  27       Response: TWebResponse; var Handled: Boolean);
  28     procedure WebModule1writerTopAction(Sender: TObject; Request: TWebRequest;
  29       Response: TWebResponse; var Handled: Boolean);
  30     procedure WebModule1loginAction(Sender: TObject; Request: TWebRequest;
  31       Response: TWebResponse; var Handled: Boolean);
  32     procedure WebModule1logoutAction(Sender: TObject; Request: TWebRequest;
  33       Response: TWebResponse; var Handled: Boolean);
  34     procedure WebModule1mainViewAction(Sender: TObject; Request: TWebRequest;
  35       Response: TWebResponse; var Handled: Boolean);
  36     procedure WebModule1imageAction(Sender: TObject; Request: TWebRequest;
  37       Response: TWebResponse; var Handled: Boolean);
  38     procedure WebModule1readerTopAction(Sender: TObject; Request: TWebRequest;
  39       Response: TWebResponse; var Handled: Boolean);
  40   private
  41     { private \90é\8c¾ }
  42     writerId: integer;
  43     readerId: integer;
  44   public
  45     { public \90é\8c¾ }
  46   end;
  47
  48 var
  49   WebModuleClass: TComponentClass = TWebModule1;
  50
  51 implementation
  52
  53 uses SynMustache, SynCommons, System.JSON, Unit1, System.NetEncoding;
  54
  55 { %CLASSGROUP 'Vcl.Controls.TControl' }
  56
  57 {$R *.dfm}
  58
  59 var
  60   mustache: TSynMustache;
  61
  62 procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;
  63   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  64 var
  65   data: TJSONObject;
  66 begin
  67   DataModule1.magListAll(data);
  68   if readerId = 0 then
  69     data.AddPair('id',TJSONFalse.Create)
  70   else
  71     data.AddPair('id',TJSONTrue.Create);
  72   if Request.QueryFields.Values['op'] <> '' then
  73     data.AddPair('comment','2\8fd\93o\98^\82Å\82·\81B\93o\98^\82É\8e¸\94s\82µ\82Ü\82µ\82½\81B')
  74   else
  75     data.AddPair('comment',TJSONFalse.Create);
  76   mustache := TSynMustache.Parse(top.Content);
  77   Response.ContentType := 'text/html;charset=utf-8';
  78   Response.Content := mustache.RenderJSON(data.ToJSON);
  79   data.Free;
  80 end;
  81
  82 procedure TWebModule1.WebModule1detailAction(Sender: TObject;
  83   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  84 var
  85   data: TJSONObject;
  86 begin
  87   DataModule1.backnumber(Request.QueryFields.Values['id'].ToInteger, data);
  88   Response.ContentType := 'text/html;charset=utf-8';
  89   mustache := TSynMustache.Parse(backnumber.Content);
  90   Response.Content := mustache.RenderJSON(data.ToString);
  91 end;
  92
  93 procedure TWebModule1.WebModule1imageAction(Sender: TObject;
  94   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  95 var
  96   id: integer;
  97   data: TJSONObject;
  98   mem: TMemoryStream;
  99   raw: TBytes;
 100 begin
 101   data:=TJSONObject.Create;
 102   data.AddPair('id',TJSONNumber.Create(Request.QueryFields.Values['id']));
 103   data.AddPair('number',TJSONNumber.Create(Request.QueryFields.Values['num']));
 104   id :=DataModule1.imageId(data);
 105   DataModule1.imageView(id,data);
 106   mem:=TMemoryStream.Create;
 107   raw:=TNetEncoding.Base64.DecodeStringToBytes(data.Values['data'].Value);
 108   mem.WriteBuffer(raw,Length(raw));
 109   mem.Position:=0;
 110   Finalize(raw);
 111   Response.ContentType:='jpeg/image';
 112   Response.ContentStream:=mem;
 113 end;
 114
 115 procedure TWebModule1.WebModule1loginAction(Sender: TObject;
 116   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 117 var
 118   data: TJSONObject;
 119 begin
 120   data:=TJSONObject.Create;
 121   with Request.ContentFields do
 122   begin
 123     data.AddPair('mail',Values['mail']);
 124     data.AddPair('password',Values['password']);
 125   end;
 126   readerId:=DataModule1.loginReader(data);
 127   data.Free;
 128   Handled:=false;
 129 end;
 130
 131 procedure TWebModule1.WebModule1logoutAction(Sender: TObject;
 132   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 133 begin
 134   readerId:=0;
 135   writerId:=0;
 136   Handled:=false;
 137 end;
 138
 139 procedure TWebModule1.WebModule1mainViewAction(Sender: TObject;
 140   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 141 var
 142   data: TJSONObject;
 143 begin
 144   Response.ContentType:='text/html;charset=utf-8';
 145   DataModule1.mainView(readerId,data);
 146   mustache:=TSynMustache.Parse(mainView.Content);
 147   Response.Content := mustache.RenderJSON(data.ToJSON);
 148 end;
 149
 150 procedure TWebModule1.WebModule1readerDataAction(Sender: TObject;
 151   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 152 var
 153   data, d: TJSONObject;
 154   num: TJSONNumber;
 155 begin
 156   with Request.ContentFields do
 157   begin
 158     data := TJSONObject.Create;
 159     data.AddPair('id',TJSONNumber.Create(readerId));
 160     data.AddPair('name', Values['reader']);
 161     data.AddPair('mail', Values['mail']);
 162     data.AddPair('password', Values['password']);
 163   end;
 164   case Request.MethodType of
 165     mtGet:
 166       if readerId = 0 then
 167       begin
 168         Handled := false;
 169         Exit;
 170       end;
 171     mtPut:
 172       if DataModule1.checkUserPassword(readerId, data.Values['password'].Value)
 173         = true then
 174       begin
 175         data.RemovePair('password');
 176         data.AddPair('password',Request.ContentFields.Values['new']);
 177         DataModule1.updateReaderId(data);
 178       end;
 179     mtPost:
 180       if DataModule1.createReaderId(data) = false then
 181       begin
 182         Response.SendRedirect('/top?op=1#message');
 183         Exit;
 184       end;
 185     mtDelete:
 186       with Request.ContentFields do
 187       begin
 188         num := TJSONNumber.Create(readerId);
 189         data.AddPair('id', num);
 190         DataModule1.deleteReaderId(data);
 191         num.Free;
 192       end;
 193   end;
 194   data.Free;
 195   Response.ContentType := 'text/html;charset=utf-8';
 196   DataModule1.userView(readerId, data);
 197   DataModule1.readerData(readerId,d);
 198   data.AddPair('reader',d);
 199   mustache := TSynMustache.Parse(readerTop.Content);
 200   Response.Content := mustache.RenderJSON(data.ToJSON);
 201 end;
 202
 203 procedure TWebModule1.WebModule1readerTopAction(Sender: TObject;
 204   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 205 var
 206   data: TJSONObject;
 207 begin
 208   Response.ContentType:='text/html;charset=utf-8';
 209   DataModule1.getView(readerId,data);
 210   mustache:=TSynMustache.Parse(mainView.Content);
 211   Response.Content:=mustache.RenderJSON(data.ToJSON);
 212 end;
 213
 214 procedure TWebModule1.WebModule1selectionAction(Sender: TObject;
 215   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 216 var
 217   id: integer;
 218 begin
 219   id := DataModule1.magid(Request.ContentFields.Values['name']);
 220   case Request.MethodType of
 221     mtGet:
 222       Handled := false;
 223     mtPost:
 224       DataModule1.magIdOn(readerId, id);
 225     mtDelete:
 226       DataModule1.magIdOff(readerId, id);
 227   end;
 228 end;
 229
 230 procedure TWebModule1.WebModule1writeMagAction(Sender: TObject;
 231   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 232 var
 233   data: TJSONObject;
 234 begin
 235   data := TJSONObject.Create;
 236   data.AddPair('magName', Request.ContentFields.Values['name']);
 237   data.AddPair('comment', Request.ContentFields.Values['comment']);
 238   data.AddPair('day', Request.ContentFields.Values['day']);
 239   data.AddPair('enable', TJSONTrue.Create);
 240   DataModule1.createMagId(writerId, data);
 241   data.Free;
 242   Response.SendRedirect('/writer/top');
 243 end;
 244
 245 procedure TWebModule1.WebModule1writerDataAction(Sender: TObject;
 246   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 247 var
 248   data: TJSONObject;
 249 begin
 250   with Request.ContentFields do
 251   begin
 252     data := TJSONObject.Create;
 253     data.AddPair('mail', Values['mail']);
 254     data.AddPair('password', Values['password']);
 255   end;
 256   case Request.MethodType of
 257     mtGet:
 258       if writerId = 0 then
 259       begin
 260         Handled := false;
 261         Exit;
 262       end;
 263     mtPost:
 264       if Request.ContentFields.Values['_method'] = 'delete' then
 265         DataModule1.deleteWriter(writerId)
 266       else if DataModule1.existsMail(data.Values['mail'].Value) = false then
 267       begin
 268         data.AddPair('name', Request.ContentFields.Values['writer']);
 269         if Request.ContentFields.Values['_method'] = 'put' then
 270           DataModule1.updateWriterId(writerId, data)
 271         else
 272           DataModule1.createWriterId(data);
 273       end
 274       else
 275       {\83\81\81[\83\8b\83A\83h\83\8c\83X\82Ì2\8fd\93o\98^};
 276     mtPut:
 277       DataModule1.updateWriterId(writerId, data);
 278     mtDelete:
 279       DataModule1.deleteWriter(writerId);
 280   end;
 281   data.Free;
 282   data := TJSONObject.Create;
 283   DataModule1.custData(writerId, data);
 284   Response.ContentType := 'text/html;charset=utf-8';
 285   mustache := TSynMustache.Parse(writerData.Content);
 286   Response.Content := mustache.RenderJSON(data.ToJSON);
 287   data.Free;
 288 end;
 289
 290 procedure TWebModule1.WebModule1writerTopAction(Sender: TObject;
 291   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 292 var
 293   data: TJSONObject;
 294 begin
 295   data := TJSONObject.Create;
 296   DataModule1.magazines(writerId, data);
 297   Response.ContentType := 'text/html;charset=utf-8';
 298   mustache := TSynMustache.Parse(writerTop.Content);
 299   Response.Content := mustache.RenderJSON(data.ToJSON);
 300   data.Free;
 301 end;
 302
 303 procedure TWebModule1.WebModuleCreate(Sender: TObject);
 304 begin
 305   writerId := 1;
 306 end;
 307
 308 end.