wmusers.pp 7.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301
  1. unit wmusers;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils, FileUtil, LResources, HTTPDefs, websession, fpHTTP, fpWeb,
  6. db, dbf, fpwebdata, fpextjs,extjsjson,extjsxml;
  7. type
  8. { TFPWebModule1 }
  9. TFPWebModule1 = class(TFPWebModule)
  10. Dbf1: TDbf;
  11. procedure TFPWebActions0Request(Sender: TObject; ARequest: TRequest;
  12. AResponse: TResponse; var Handled: Boolean);
  13. procedure TFPWebActions1Request(Sender: TObject; ARequest: TRequest;
  14. AResponse: TResponse; var Handled: Boolean);
  15. procedure TFPWebActions2Request(Sender: TObject; ARequest: TRequest;
  16. AResponse: TResponse; var Handled: Boolean);
  17. procedure TFPWebActions3Request(Sender: TObject; ARequest: TRequest;
  18. AResponse: TResponse; var Handled: Boolean);
  19. private
  20. { private declarations }
  21. procedure GetAdaptorAndFormatter(P : TFPWebDataProvider; Var F :TExtJSDataFormatter; ARequest : TRequest; AResponse : TResponse);
  22. public
  23. { public declarations }
  24. end;
  25. var
  26. FPWebModule1: TFPWebModule1;
  27. Var
  28. ResponseFileName : String; // Set to non empty to write request responses to a file.
  29. implementation
  30. {$define wmdebug}
  31. {$ifdef wmdebug}
  32. uses dbugintf;
  33. {$endif}
  34. { TFPWebModule1 }
  35. Procedure SaveResponse(M : TStream);
  36. begin
  37. if (ResponseFileName<>'') then
  38. With TFileStream.Create(ResponseFileName,fmCreate) do
  39. try
  40. CopyFrom(M,0);
  41. finally
  42. Free;
  43. end;
  44. end;
  45. procedure TFPWebModule1.GetAdaptorAndFormatter(P : TFPWebDataProvider; Var F :TExtJSDataFormatter; ARequest : TRequest; AResponse : TResponse);
  46. begin
  47. If Request.QueryFields.values['format']='xml' then
  48. begin
  49. F:=TExtJSXMLDataFormatter.Create(Self);
  50. TExtJSXMLDataFormatter(F).TotalProperty:='total';
  51. AResponse.ContentType:='text/xml';
  52. P.Adaptor:=TExtJSXMLWebdataInputAdaptor.Create(Nil);
  53. end
  54. else
  55. begin
  56. P.Adaptor:=TExtJSJSonWebdataInputAdaptor.Create(Nil);
  57. F:=TExtJSJSONDataFormatter.Create(Self);
  58. end;
  59. P.Adaptor.Request:=ARequest;
  60. F.Adaptor:=P.Adaptor;
  61. F.Provider:=P;
  62. end;
  63. procedure TFPWebModule1.TFPWebActions0Request(Sender: TObject;
  64. ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
  65. Var
  66. PN : String;
  67. P : TFPWebDataProvider;
  68. F : TExtJSDataFormatter;
  69. DS : TDatasource;
  70. M : TMemoryStream;
  71. L : Text;
  72. begin
  73. // Providername;
  74. PN:=ARequest.GetNextPathInfo;
  75. P:=TFPWebDataProvider.Create(Self);
  76. try
  77. GetAdaptorAndFormatter(P,F,ARequest,AResponse);
  78. {$ifdef wmdebug} SendDebug(className+' '+F.ClassName);{$endif}
  79. try
  80. DS:=TDatasource.Create(Self);
  81. try
  82. DBF1.TableName:=ExtractFilePath(ParamStr(0))+'users.dbf';
  83. DS.Dataset:=DBf1;
  84. DBF1.Open;
  85. try
  86. P.Datasource:=DS;
  87. P.Adaptor.Action:=wdaRead;
  88. P.ApplyParams;
  89. M:=TMemoryStream.Create;
  90. try
  91. F.GetContent(ARequest,M,Handled);
  92. M.Position:=0;
  93. Response.ContentStream:=M;
  94. Response.SendResponse;
  95. Response.ContentStream:=Nil;
  96. SaveResponse(M);
  97. finally
  98. M.Free;
  99. end;
  100. finally
  101. DBF1.Close;
  102. end;
  103. finally
  104. DS.Free;
  105. end;
  106. finally
  107. F.Free;
  108. end;
  109. finally
  110. P.Free;
  111. end;
  112. end;
  113. procedure TFPWebModule1.TFPWebActions1Request(Sender: TObject;
  114. ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
  115. Var
  116. PN : String;
  117. P : TFPWebDataProvider;
  118. F : TExtJSDataFormatter;
  119. DS : TDatasource;
  120. M : TMemoryStream;
  121. L : Text;
  122. begin
  123. // Providername;
  124. PN:=ARequest.GetNextPathInfo;
  125. // P:=GetWebDataProvider(PN);
  126. P:=TFPWebDataProvider.Create(Self);
  127. try
  128. P.IDFieldName:='ID';
  129. GetAdaptorAndFormatter(P,F,ARequest,AResponse);
  130. {$ifdef wmdebug} SendDebug(className+' '+F.ClassName);{$endif}
  131. try
  132. DS:=TDatasource.Create(Self);
  133. try
  134. DBF1.TableName:=ExtractFilePath(ParamStr(0))+'users.dbf';
  135. DS.Dataset:=DBf1;
  136. DBF1.Open;
  137. try
  138. P.Datasource:=DS;
  139. P.Adaptor.Action:=wdaInsert;
  140. P.ApplyParams;
  141. M:=TMemoryStream.Create;
  142. try
  143. F.GetContent(ARequest,M,Handled);
  144. M.Position:=0;
  145. Response.ContentStream:=M;
  146. Response.SendResponse;
  147. Response.ContentStream:=Nil;
  148. SaveResponse(M);
  149. finally
  150. M.Free;
  151. end;
  152. finally
  153. DBF1.Close;
  154. end;
  155. finally
  156. DS.Free;
  157. end;
  158. finally
  159. F.Free;
  160. end;
  161. finally
  162. P.Free;
  163. end;
  164. end;
  165. procedure TFPWebModule1.TFPWebActions2Request(Sender: TObject;
  166. ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
  167. Var
  168. PN : String;
  169. P : TFPWebDataProvider;
  170. F : TExtJSDataFormatter;
  171. DS : TDatasource;
  172. M : TMemoryStream;
  173. L : Text;
  174. begin
  175. // Providername;
  176. {$ifdef wmdebug} SendDebug('Update request received');{$endif}
  177. PN:=ARequest.GetNextPathInfo;
  178. // P:=GetWebDataProvider(PN);
  179. P:=TFPWebDataProvider.Create(Self);
  180. try
  181. P.IDFieldName:='ID';
  182. GetAdaptorAndFormatter(P,F,ARequest,AResponse);
  183. {$ifdef wmdebug} SendDebug(className+' '+F.ClassName);{$endif}
  184. try
  185. DS:=TDatasource.Create(Self);
  186. try
  187. DBF1.TableName:=ExtractFilePath(ParamStr(0))+'users.dbf';
  188. DS.Dataset:=DBf1;
  189. DBF1.Open;
  190. try
  191. P.Datasource:=DS;
  192. P.Adaptor.Action:=wdaUpdate;
  193. P.ApplyParams;
  194. M:=TMemoryStream.Create;
  195. try
  196. F.GetContent(ARequest,M,Handled);
  197. M.Position:=0;
  198. Response.ContentStream:=M;
  199. Response.SendResponse;
  200. Response.ContentStream:=Nil;
  201. SaveResponse(M);
  202. finally
  203. M.Free;
  204. end;
  205. finally
  206. DBF1.Close;
  207. end;
  208. finally
  209. DS.Free;
  210. end;
  211. finally
  212. F.Free;
  213. end;
  214. finally
  215. P.Free;
  216. end;
  217. end;
  218. procedure TFPWebModule1.TFPWebActions3Request(Sender: TObject;
  219. ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
  220. Var
  221. PN : String;
  222. P : TFPWebDataProvider;
  223. F : TExtJSDataFormatter;
  224. DS : TDatasource;
  225. M : TMemoryStream;
  226. L : Text;
  227. begin
  228. // Providername;
  229. PN:=ARequest.GetNextPathInfo;
  230. // P:=GetWebDataProvider(PN);
  231. P:=TFPWebDataProvider.Create(Self);
  232. try
  233. P.IDFieldName:='ID';
  234. GetAdaptorAndFormatter(P,F,ARequest,AResponse);
  235. {$ifdef wmdebug} SendDebug('className '+F.ClassName);{$endif}
  236. try
  237. DS:=TDatasource.Create(Self);
  238. try
  239. DBF1.TableName:=ExtractFilePath(ParamStr(0))+'users.dbf';
  240. DS.Dataset:=DBf1;
  241. DBF1.Open;
  242. try
  243. P.Datasource:=DS;
  244. P.Adaptor.Action:=wdaDelete;
  245. P.ApplyParams;
  246. M:=TMemoryStream.Create;
  247. try
  248. F.GetContent(ARequest,M,Handled);
  249. M.Position:=0;
  250. Response.ContentStream:=M;
  251. Response.SendResponse;
  252. Response.ContentStream:=Nil;
  253. SaveResponse(M);
  254. finally
  255. M.Free;
  256. end;
  257. finally
  258. DBF1.Close;
  259. end;
  260. finally
  261. DS.Free;
  262. end;
  263. finally
  264. F.Free;
  265. end;
  266. finally
  267. P.Free;
  268. end;
  269. end;
  270. initialization
  271. {$I wmusers.lrs}
  272. RegisterHTTPModule('Provider', TFPWebModule1);
  273. end.