brookutils.pas 32 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969
  1. (*
  2. Brook for Free Pascal
  3. Copyright (C) 2014-2019 Silvio Clecio
  4. See the file LICENSE.txt, included in this distribution,
  5. for details about the copyright.
  6. This library is distributed in the hope that it will be useful,
  7. but WITHOUT ANY WARRANTY; without even the implied warranty of
  8. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  9. *)
  10. { Utilities unit. }
  11. unit BrookUtils;
  12. {$i brook.inc}
  13. interface
  14. uses
  15. BrookException, BrookMessages, BrookConsts, BrookHTTPConsts, CustWeb,
  16. Classes, SysUtils, TypInfo;
  17. type
  18. { Defines an array of strings. }
  19. TBrookArrayOfString = array of string;
  20. { Defines an enumerator to represent the HTTP request methods. }
  21. TBrookRequestMethod = (
  22. rmUnknown, rmAll, rmGet, rmPost, rmPut, rmDelete, rmHead, rmOptions, rmTrace
  23. );
  24. { Stores the Brook settings. }
  25. TBrookSettings = record
  26. { Enables the mapping of HTTP request methods. }
  27. Mapped: Boolean;
  28. { Set the default application Charset. }
  29. Charset: ShortString;
  30. { Set the default application Content-Type. }
  31. ContentType: ShortString;
  32. { Set the 404 HTML page. The string will be sent as is. }
  33. Page404: string;
  34. { Set the 404 HTML page file. The file content will be sent.
  35. This has higher precedence than @code(TBrookSettings.Page404)
  36. so when both are set, this will be processed first and only
  37. if the file is not found or cannot be read the system will
  38. fallback to @code(TBrookSettings.Page404) }
  39. Page404File: string;
  40. { Set the 500 HTML page. The string will be sent as is. }
  41. Page500: string;
  42. { Set the 500 HTML page file. The file content will be sent.
  43. This has higher precedence than @code(TBrookSettings.Page500)
  44. so when both are set, this will be processed first and only
  45. if the file is not found or cannot be read the system will
  46. fallback to @code(TBrookSettings.Page500) }
  47. Page500File: string;
  48. { Set the default directory for uploads. }
  49. DirectoryForUploads: string;
  50. { Defines if the temporary uploaded files will be deleted. }
  51. DeleteUploadedFiles: Boolean;
  52. { Keeps the original name of the uploaded files. }
  53. KeepUploadedNames: Boolean;
  54. { Set a configuration for the application or for its object members. }
  55. Configuration: string;
  56. { Set the default root URL. This is used by methods such as
  57. @code(TBrookAction.UrlFor), @code(TBrookActionHelper.LinkTo),
  58. @code(TBrookActionHelper.ButtonTo) etc. By default, Brook assumes
  59. @code(SCRIPT_NAME) as root URL. }
  60. RootUrl: string;
  61. { Set the default application port. }
  62. Port: Word;
  63. { Enables the application log. }
  64. LogActive: Boolean;
  65. { Set a name for the application log file. }
  66. LogFile: TFileName;
  67. { Handles the application exceptions. }
  68. OnError: TOnShowRequestException;
  69. end;
  70. var
  71. { Global variable to store Brook settings. }
  72. BrookSettings: TBrookSettings = (
  73. Mapped: False;
  74. Charset: BROOK_HTTP_CHARSET_UTF_8;
  75. ContentType: BROOK_HTTP_CONTENT_TYPE_TEXT_HTML;
  76. Page404: BROOK_HTTP_RESPONSE_TEMPLATE_NOT_FOUND;
  77. Page404File: ES;
  78. Page500: BROOK_HTTP_RESPONSE_TEMPLATE_INTERNAL_SERVER_ERROR;
  79. Page500File: ES;
  80. DirectoryForUploads: ES;
  81. DeleteUploadedFiles: False;
  82. KeepUploadedNames: True;
  83. Configuration: ES;
  84. RootUrl: ES;
  85. Port: 0;
  86. LogActive: False;
  87. LogFile: ES;
  88. OnError: nil;
  89. );
  90. { Check whether a string starts with a given character. }
  91. function BrookStartsChar(const Ch: Char; const S: string): Boolean;
  92. { Check whether a string ends with a given character. }
  93. function BrookEndsChar(const Ch: Char; const S: string): Boolean;
  94. { Get the next pathinfo level. }
  95. procedure BrookExtractPathLevels(S: string; var R: string; out ALvl: string;
  96. out AEndDelim: Boolean; const ADelimiter: Char = US);
  97. { Get the path level passing the respective index. Exemple:
  98. @code(BrookGetPathLavel('/a/b/c/', 1)) = b. }
  99. function BrookGetPathLevel(const APath: string; const AIndex: SizeInt = 0;
  100. const ADelimiter: Char = US): string;
  101. { Get the path from the level correspondent to the index to the last level.
  102. Exemple:
  103. @code(BrookGetPathLevels('/a/b/c/', 1)) = b/c/. }
  104. function BrookGetPathLevels(const APath: string; const AIndex: SizeInt = 0;
  105. const ADelimiter: Char = US): string;
  106. { Checks if a string is equivalent an enumerator representing a HTTP request
  107. method. }
  108. function BrookMatchMethod(const ABrookMethod: TBrookRequestMethod;
  109. const AMethod: string): Boolean;
  110. { Get the datetime of a file. }
  111. function BrookFileDate(const AFileName: TFileName): TDateTime;
  112. { Writes a backtrace of the current exception. }
  113. function BrookDumpStack(const AEOL: ShortString = BR): string;
  114. { Writes a stack trace of the current exception. }
  115. function BrookDumpStackTrace(const AEOL: ShortString = BR): string;
  116. { Ensures Url ends without delimiter. }
  117. function BrookExcludeTrailingUrlDelimiter(const AUrl: string): string;
  118. { Ensures Url ends with delimiter. }
  119. function BrookIncludeTrailingUrlDelimiter(const AUrl: string): string;
  120. { Checks if a string exists in an array of strings. }
  121. function BrookExists(const S: string; const
  122. AParts: array of string): Boolean; overload;
  123. { Checks (ignoring case) if a string exists in an array of strings. }
  124. function BrookExists(const S: string; const AParts: array of string;
  125. const AIgnoreCase: Boolean): Boolean; overload;
  126. { Fills a published property of an object passing the property as
  127. @code(PPropInfo) and value as @code(string). }
  128. procedure BrookStringToObject(AObject: TObject; APropInfo: PPropInfo;
  129. const AValue: string); overload;
  130. { Fills a published property of an object passing the name and value as
  131. @code(string). }
  132. procedure BrookStringToObject(AObject: TObject; const AName,
  133. AValue: string); overload;
  134. { Fills a published property of an object passing the name and value as
  135. string and checking the params. }
  136. procedure BrookSafeStringToObject(AObject: TObject; const AName, AValue: string);
  137. { Fills the published properties of an object passing the names and values as
  138. a list of strings. }
  139. procedure BrookStringsToObject(AObject: TObject; AStrings: TStrings); overload;
  140. { Fills the published properties of an object passing the names and values as
  141. a list of strings. Allows to ignore properties via an array of strings. }
  142. procedure BrookStringsToObject(AObject: TObject; AStrings: TStrings;
  143. const AIgnoredProps: array of string); overload;
  144. { Fills the published properties of an object passing the names and values as
  145. a list of strings. Allows to ignore properties via a list of strings. }
  146. procedure BrookStringsToObject(AObject: TObject; AStrings: TStrings;
  147. const AIgnoredProps: TStrings); overload;
  148. { Fills the published properties of an object passing the names and values as
  149. a list of strings and checking the params. }
  150. procedure BrookSafeStringsToObject(AObject: TObject;
  151. AStrings: TStrings); overload;
  152. { Fills the published properties of an object passing the names and values as
  153. a list of strings and checking the params. Allows to ignore properties via an
  154. array of strings. }
  155. procedure BrookSafeStringsToObject(AObject: TObject; AStrings: TStrings;
  156. const AIgnoredProps: array of string); overload;
  157. { Fills the published properties of an object passing the names and values as
  158. a list of strings and checking the params. Allows to ignore properties via a
  159. list of strings. }
  160. procedure BrookSafeStringsToObject(AObject: TObject; AStrings: TStrings;
  161. const AIgnoredProps: TStrings); overload;
  162. { Reads a published property of an object passing the property as
  163. @code(PPropInfo) and getting the value as @code(string). }
  164. procedure BrookObjectToString(AObject: TObject; APropInfo: PPropInfo;
  165. out AValue: string); overload;
  166. { Reads a published property of an object passing the name as @code(string) and
  167. getting the value as @code(string). }
  168. procedure BrookObjectToString(AObject: TObject; const AName: string;
  169. out AValue: string); overload;
  170. { Reads a published property of an object passing the name, getting the value as
  171. string and checking the params. }
  172. procedure BrookSafeObjectToString(AObject: TObject; const AName: string;
  173. out AValue: string);
  174. { Reads the published properties of an object getting the names and values as
  175. a list of strings. }
  176. procedure BrookObjectToStrings(AObject: TObject; AStrings: TStrings); overload;
  177. { Reads the published properties of an object getting the names and values as
  178. a list of strings. Allows to ignore properties via an array of strings. }
  179. procedure BrookObjectToStrings(AObject: TObject; AStrings: TStrings;
  180. const AIgnoredProps: array of string); overload;
  181. { Reads the published properties of an object getting the names and values as
  182. a list of strings. Allows to ignore properties via a list of strings. }
  183. procedure BrookObjectToStrings(AObject: TObject; AStrings: TStrings;
  184. const AIgnoredProps: TStrings); overload;
  185. { Reads the published properties of an object getting the names and values as
  186. a list of strings and checking the params. }
  187. procedure BrookSafeObjectToStrings(AObject: TObject;
  188. AStrings: TStrings); overload;
  189. { Reads the published properties of an object getting the names and values as
  190. a list of strings and checking the params. Allows to ignore properties via an
  191. array of strings. }
  192. procedure BrookSafeObjectToStrings(AObject: TObject; AStrings: TStrings;
  193. const AIgnoredProps: array of string); overload;
  194. { Reads the published properties of an object getting the names and values as
  195. a list of strings and checking the params. }
  196. procedure BrookSafeObjectToStrings(AObject: TObject; AStrings: TStrings;
  197. const AIgnoredProps: TStrings); overload;
  198. { Copies the value of all properties from one object to another passing the
  199. prop. list and prop. count. }
  200. procedure BrookCopyObject(APropList: PPropList; const APropCount: Integer;
  201. AFrom, ATo: TObject); overload;
  202. { Copies the value of all properties from one object to another passing the
  203. prop. list and prop. count. Allows to ignore properties via an array of
  204. strings. }
  205. procedure BrookCopyObject(APropList: PPropList; const APropCount: Integer;
  206. AFrom, ATo: TObject; const AIgnoredProps: array of string); overload;
  207. { Copies the value of all properties from one object to another passing the
  208. prop. list and prop. count. Allows to ignore properties via a list of
  209. strings. }
  210. procedure BrookCopyObject(APropList: PPropList; const APropCount: Integer;
  211. AFrom, ATo: TObject; const AIgnoredProps: TStrings); overload;
  212. { Copies the value of all properties from one object to another. }
  213. procedure BrookCopyObject(AFrom, ATo: TObject); overload;
  214. { Copies the value of all properties from one object to another. Allows to
  215. ignore properties via an array of strings. }
  216. procedure BrookCopyObject(AFrom, ATo: TObject;
  217. const AIgnoredProps: array of string); overload;
  218. { Copies the value of all properties from one object to another. Allows to
  219. ignore properties via a list of strings. }
  220. procedure BrookCopyObject(AFrom, ATo: TObject;
  221. const AIgnoredProps: TStrings); overload;
  222. { Copies the value of all properties from one object to another passing the
  223. prop. list and prop. count and checking the params. }
  224. procedure BrookSafeCopyObject(APropList: PPropList; const APropCount: Integer;
  225. AFrom, ATo: TObject); overload;
  226. { Copies the value of all properties from one object to another passing the
  227. prop. list and prop. count and checking the params. Allows to ignore
  228. properties via an array of strings. }
  229. procedure BrookSafeCopyObject(APropList: PPropList; const APropCount: Integer;
  230. AFrom, ATo: TObject; const AIgnoredProps: array of string); overload;
  231. { Copies the value of all properties from one object to another passing the
  232. prop. list and prop. count and checking the params. Allows to ignore
  233. properties via a list of strings. }
  234. procedure BrookSafeCopyObject(APropList: PPropList; const APropCount: Integer;
  235. AFrom, ATo: TObject; const AIgnoredProps: TStrings); overload;
  236. { Copies the value of all properties from one object to another and checking the
  237. params. }
  238. procedure BrookSafeCopyObject(AFrom, ATo: TObject); overload;
  239. { Copies the value of all properties from one object to another and checking the
  240. params. Allows to ignore properties via an array of strings. }
  241. procedure BrookSafeCopyObject(AFrom, ATo: TObject;
  242. const AIgnoredProps: array of string); overload;
  243. { Copies the value of all properties from one object to another and checking the
  244. params. Allows to ignore properties via a list of strings. }
  245. procedure BrookSafeCopyObject(AFrom, ATo: TObject;
  246. const AIgnoredProps: TStrings); overload;
  247. implementation
  248. function BrookStartsChar(const Ch: Char; const S: string): Boolean;
  249. begin
  250. Result := (Length(S) > 0) and (S[1] = Ch);
  251. end;
  252. function BrookEndsChar(const Ch: Char; const S: string): Boolean;
  253. begin
  254. Result := (Length(S) > 0) and (S[Length(S)] = Ch);
  255. end;
  256. procedure BrookExtractPathLevels(S: string; var R: string; out ALvl: string;
  257. out AEndDelim: Boolean; const ADelimiter: Char = US);
  258. function IncHttpPathDelim(const P: string): string; inline;
  259. var
  260. L: Integer;
  261. begin
  262. Result := P;
  263. L := Length(Result);
  264. if (L > 0) and (Result[L] <> US) then
  265. Result += US;
  266. end;
  267. var
  268. P, L: Integer;
  269. begin
  270. L := Length(S);
  271. AEndDelim := (S <> ES) and (S[L] = ADelimiter);
  272. if AEndDelim then
  273. Delete(S, L, 1);
  274. if (S <> ES) and (S[1] = ADelimiter) then
  275. Delete(S, 1, 1);
  276. Delete(S, 1, Length(IncHttpPathDelim(R)));
  277. P := Pos(ADelimiter, S);
  278. if P = 0 then
  279. P := Length(S) + 1;
  280. ALvl := Copy(S, 1, P - 1);
  281. R := IncHttpPathDelim(R) + ALvl;
  282. end;
  283. {$PUSH}{$WARN 5093 OFF}
  284. function BrookGetPathLevel(const APath: string; const AIndex: SizeInt;
  285. const ADelimiter: Char): string;
  286. var
  287. C, L: SizeInt;
  288. VSrc, VDest: PChar;
  289. begin
  290. SetLength(Result, Length(APath));
  291. VSrc := PChar(APath);
  292. VDest := PChar(Result);
  293. C := Succ(AIndex);
  294. L := 0;
  295. while (VSrc^ <> NU) and (VSrc^ <> QU) do
  296. begin
  297. if (VSrc^ = ADelimiter) and (C <> 0) then
  298. Dec(C)
  299. else
  300. if C = 0 then
  301. begin
  302. if VSrc^ = ADelimiter then
  303. Break;
  304. VDest^ := VSrc^;
  305. Inc(VDest);
  306. Inc(L);
  307. end;
  308. Inc(VSrc);
  309. end;
  310. SetLength(Result, L);
  311. end;
  312. function BrookGetPathLevels(const APath: string; const AIndex: SizeInt;
  313. const ADelimiter: Char): string;
  314. var
  315. C, L: Integer;
  316. VSrc, VDest: PChar;
  317. begin
  318. SetLength(Result, Length(APath));
  319. VSrc := PChar(APath);
  320. VDest := PChar(Result);
  321. C := Succ(AIndex);
  322. L := 0;
  323. while (VSrc^ <> NU) and (VSrc^ <> QU) do
  324. begin
  325. if (VSrc^ = ADelimiter) and (C <> 0) then
  326. Dec(C)
  327. else
  328. if C = 0 then
  329. begin
  330. VDest^ := VSrc^;
  331. Inc(VDest);
  332. Inc(L);
  333. end;
  334. Inc(VSrc);
  335. end;
  336. SetLength(Result, L);
  337. end;
  338. {$POP}
  339. function BrookMatchMethod(const ABrookMethod: TBrookRequestMethod;
  340. const AMethod: string): Boolean;
  341. begin
  342. case ABrookMethod of
  343. rmAll: Result := True;
  344. rmGet: Result := AMethod = BROOK_HTTP_REQUEST_METHOD_GET;
  345. rmHead: Result := AMethod = BROOK_HTTP_REQUEST_METHOD_HEAD;
  346. rmOptions: Result := AMethod = BROOK_HTTP_REQUEST_METHOD_OPTIONS;
  347. rmPost: Result := AMethod = BROOK_HTTP_REQUEST_METHOD_POST;
  348. rmPut: Result := AMethod = BROOK_HTTP_REQUEST_METHOD_PUT;
  349. rmDelete: Result := AMethod = BROOK_HTTP_REQUEST_METHOD_DELETE;
  350. else
  351. Result := False;
  352. end;
  353. end;
  354. function BrookFileDate(const AFileName: TFileName): TDateTime;
  355. begin
  356. if not FileExists(AFileName) then
  357. raise EBrook.CreateFmt('BrookFileDate',
  358. SBrookFileNotFoundError, [AFileName]);
  359. Result := FileDateToDateTime(FileAge(AFileName));
  360. end;
  361. function BrookDumpStack(const AEOL: ShortString): string;
  362. var
  363. I: Integer;
  364. VReport: string;
  365. VFrames: PPointer;
  366. begin
  367. VReport := BackTraceStrFunc(ExceptAddr);
  368. VFrames := ExceptFrames;
  369. for I := 0 to Pred(ExceptFrameCount) do
  370. VReport += AEOL + BackTraceStrFunc(VFrames[I]);
  371. Result := VReport;
  372. end;
  373. function BrookDumpStackTrace(const AEOL: ShortString): string;
  374. var
  375. I: Longint;
  376. VReport: string;
  377. Vprevbp, VCallerFrame, VCallerAddress, Vbp: Pointer;
  378. const
  379. MaxDepth = 50;
  380. begin
  381. VReport := ES;
  382. Vbp := get_frame;
  383. // This trick skip SendCallstack item
  384. // Vbp:= get_caller_frame(get_frame);
  385. try
  386. Vprevbp := Vbp - 1;
  387. I := 0;
  388. while Vbp > Vprevbp do
  389. begin
  390. VCallerAddress := get_caller_addr(Vbp);
  391. VCallerFrame := get_caller_frame(Vbp);
  392. if VCallerAddress = nil then
  393. Break;
  394. VReport := VReport + BackTraceStrFunc(VCallerAddress) + AEOL;
  395. Inc(I);
  396. if (I >= MaxDepth) or (VCallerFrame = nil) then
  397. Break;
  398. Vprevbp := Vbp;
  399. Vbp := VCallerFrame;
  400. end;
  401. except
  402. { Prevent endless dump if an exception occured. }
  403. end;
  404. Result := VReport;
  405. end;
  406. function BrookExcludeTrailingUrlDelimiter(const AUrl: string): string;
  407. var
  408. L: Integer;
  409. begin
  410. L := Length(AUrl);
  411. if (L > 0) and (AUrl[L] = US) then
  412. Dec(L);
  413. Result := Copy(AUrl, 1, L);
  414. end;
  415. function BrookIncludeTrailingUrlDelimiter(const AUrl: string): string;
  416. var
  417. L: Integer;
  418. begin
  419. Result := AUrl;
  420. L := Length(Result);
  421. if (L = 0) or (Result[L] <> US) then
  422. Result += US;
  423. end;
  424. function BrookExists(const S: string; const AParts: array of string): Boolean;
  425. var
  426. I: Integer;
  427. begin
  428. for I := 0 to High(AParts) do
  429. begin
  430. Result := S = AParts[I];
  431. if Result then
  432. Exit;
  433. end;
  434. Result := False;
  435. end;
  436. function BrookExists(const S: string; const AParts: array of string;
  437. const AIgnoreCase: Boolean): Boolean;
  438. var
  439. I: Integer;
  440. begin
  441. if AIgnoreCase then
  442. begin
  443. for I := 0 to High(AParts) do
  444. begin
  445. Result := CompareText(S, AParts[I]) = 0;
  446. if Result then
  447. Exit;
  448. end;
  449. Result := False;
  450. end
  451. else
  452. Result := BrookUtils.BrookExists(S, AParts);
  453. end;
  454. procedure BrookStringToObject(AObject: TObject; APropInfo: PPropInfo;
  455. const AValue: string);
  456. begin
  457. if Assigned(APropInfo) then
  458. case APropInfo^.PropType^.Kind of
  459. tkAString: SetStrProp(AObject, APropInfo, AValue);
  460. tkChar: SetOrdProp(AObject, APropInfo, Ord(PChar(AValue)^));
  461. tkInteger: SetOrdProp(AObject, APropInfo, StrToIntDef(AValue, DefInt));
  462. tkInt64, tkQWord: SetInt64Prop(AObject, APropInfo,
  463. StrToInt64Def(AValue, DefInt64));
  464. tkBool: SetOrdProp(AObject, APropInfo,
  465. Ord((ShortCompareText(AValue, 'on') = 0) or
  466. StrToBoolDef(AValue, DefBool)));
  467. tkFloat:
  468. case APropInfo^.PropType^.Name of
  469. 'TDate': SetFloatProp(AObject, APropInfo,
  470. StrToDateDef(AValue, DefDate));
  471. 'TTime': SetFloatProp(AObject, APropInfo,
  472. StrToTimeDef(AValue, DefTime));
  473. 'TDateTime': SetFloatProp(AObject, APropInfo,
  474. StrToDateTimeDef(AValue, DefDateTime));
  475. 'Currency': SetFloatProp(AObject, APropInfo,
  476. StrToCurrDef(AValue, DefCurrency));
  477. else
  478. SetFloatProp(AObject, APropInfo, StrToFloatDef(AValue, DefFloat));
  479. end;
  480. tkEnumeration: SetEnumProp(AObject, APropInfo, AValue);
  481. tkSet: SetSetProp(AObject, APropInfo, AValue);
  482. end;
  483. end;
  484. procedure BrookStringToObject(AObject: TObject; const AName, AValue: string);
  485. begin
  486. BrookStringToObject(AObject,
  487. GetPropInfo(PTypeInfo(AObject.ClassInfo), AName), AValue);
  488. end;
  489. procedure BrookSafeStringToObject(AObject: TObject; const AName, AValue: string);
  490. begin
  491. if not Assigned(AObject) then
  492. raise EBrook.CreateFmt('BrookSafeStringToObject',
  493. SBrookNotNilError, ['AObject']);
  494. BrookStringToObject(AObject, AName, AValue);
  495. end;
  496. procedure BrookStringsToObject(AObject: TObject; AStrings: TStrings);
  497. var
  498. I: Integer;
  499. N, V: string;
  500. begin
  501. for I := 0 to Pred(AStrings.Count) do
  502. begin
  503. AStrings.GetNameValue(I, N, V);
  504. BrookStringToObject(AObject, N, V);
  505. end;
  506. end;
  507. procedure BrookStringsToObject(AObject: TObject; AStrings: TStrings;
  508. const AIgnoredProps: array of string);
  509. var
  510. I: Integer;
  511. N, V: string;
  512. begin
  513. for I := 0 to Pred(AStrings.Count) do
  514. begin
  515. AStrings.GetNameValue(I, N, V);
  516. if not BrookExists(N, AIgnoredProps, True) then
  517. BrookStringToObject(AObject, N, V);
  518. end;
  519. end;
  520. procedure BrookStringsToObject(AObject: TObject; AStrings: TStrings;
  521. const AIgnoredProps: TStrings);
  522. var
  523. I: Integer;
  524. N, V: string;
  525. begin
  526. for I := 0 to Pred(AStrings.Count) do
  527. begin
  528. AStrings.GetNameValue(I, N, V);
  529. if AIgnoredProps.IndexOf(N) = -1 then
  530. BrookStringToObject(AObject, N, V);
  531. end;
  532. end;
  533. procedure BrookSafeStringsToObject(AObject: TObject; AStrings: TStrings);
  534. begin
  535. if not Assigned(AObject) then
  536. raise EBrook.CreateFmt('BrookSafeStringsToObject', SBrookNotNilError,
  537. ['AObject']);
  538. if not Assigned(AStrings) then
  539. raise EBrook.CreateFmt('BrookSafeStringsToObject', SBrookNotNilError,
  540. ['AStrings']);
  541. BrookStringsToObject(AObject, AStrings);
  542. end;
  543. procedure BrookSafeStringsToObject(AObject: TObject; AStrings: TStrings;
  544. const AIgnoredProps: array of string);
  545. begin
  546. if not Assigned(AObject) then
  547. raise EBrook.CreateFmt('BrookSafeStringsToObject', SBrookNotNilError,
  548. ['AObject']);
  549. if not Assigned(AStrings) then
  550. raise EBrook.CreateFmt('BrookSafeStringsToObject', SBrookNotNilError,
  551. ['AStrings']);
  552. BrookStringsToObject(AObject, AStrings, AIgnoredProps);
  553. end;
  554. procedure BrookSafeStringsToObject(AObject: TObject; AStrings: TStrings;
  555. const AIgnoredProps: TStrings);
  556. begin
  557. if not Assigned(AObject) then
  558. raise EBrook.CreateFmt('BrookSafeStringsToObject', SBrookNotNilError,
  559. ['AObject']);
  560. if not Assigned(AStrings) then
  561. raise EBrook.CreateFmt('BrookSafeStringsToObject', SBrookNotNilError,
  562. ['AStrings']);
  563. if not Assigned(AIgnoredProps) then
  564. raise EBrook.CreateFmt('BrookSafeStringsToObject', SBrookNotNilError,
  565. ['AIgnoredProps']);
  566. BrookStringsToObject(AObject, AStrings, AIgnoredProps);
  567. end;
  568. procedure BrookObjectToString(AObject: TObject; APropInfo: PPropInfo;
  569. out AValue: string);
  570. begin
  571. if Assigned(APropInfo) then
  572. case APropInfo^.PropType^.Kind of
  573. tkAString: AValue := GetStrProp(AObject, APropInfo);
  574. tkChar: AValue := Char(GetOrdProp(AObject, APropInfo));
  575. tkInteger: AValue := IntToStr(GetOrdProp(AObject, APropInfo));
  576. tkInt64, tkQWord: AValue := IntToStr(GetInt64Prop(AObject, APropInfo));
  577. tkBool: AValue := BoolToStr(GetOrdProp(AObject, APropInfo) <> 0, True);
  578. tkFloat:
  579. case APropInfo^.PropType^.Name of
  580. 'TDate': AValue := DateToStr(GetFloatProp(AObject, APropInfo));
  581. 'TTime': AValue := TimeToStr(GetFloatProp(AObject, APropInfo));
  582. 'TDateTime': AValue := DateTimeToStr(GetFloatProp(AObject, APropInfo));
  583. 'Currency': AValue := CurrToStr(GetFloatProp(AObject, APropInfo));
  584. else
  585. AValue := FloatToStr(GetFloatProp(AObject, APropInfo));
  586. end;
  587. tkEnumeration: AValue := GetEnumProp(AObject, APropInfo);
  588. tkSet: AValue := GetSetProp(AObject, APropInfo, False);
  589. end;
  590. end;
  591. procedure BrookObjectToString(AObject: TObject; const AName: string;
  592. out AValue: string);
  593. begin
  594. BrookObjectTostring(AObject,
  595. GetPropInfo(PTypeInfo(AObject.ClassInfo), AName), AValue);
  596. end;
  597. procedure BrookSafeObjectToString(AObject: TObject; const AName: string;
  598. out AValue: string);
  599. begin
  600. if not Assigned(AObject) then
  601. raise EBrook.CreateFmt('BrookSafeObjectToString', SBrookNotNilError,
  602. ['AObject']);
  603. BrookObjectToString(AObject, AName, AValue);
  604. end;
  605. procedure BrookObjectToStrings(AObject: TObject; AStrings: TStrings);
  606. var
  607. S: Char;
  608. V: string;
  609. I, C: Integer;
  610. PI: PPropInfo;
  611. PL: PPropList = nil;
  612. begin
  613. C := GetPropList(PTypeInfo(AObject.ClassInfo), PL);
  614. if Assigned(PL) then
  615. try
  616. S := AStrings.NameValueSeparator;
  617. if S = NU then
  618. S := EQ;
  619. for I := 0 to Pred(C) do
  620. begin
  621. PI := PL^[I];
  622. BrookObjectToString(AObject, PI, V);
  623. AStrings.Add(PI^.Name + S + V);
  624. end;
  625. finally
  626. FreeMem(PL);
  627. end;
  628. end;
  629. procedure BrookObjectToStrings(AObject: TObject; AStrings: TStrings;
  630. const AIgnoredProps: array of string);
  631. var
  632. S: Char;
  633. V: string;
  634. I, C: Integer;
  635. PI: PPropInfo;
  636. PL: PPropList = nil;
  637. begin
  638. C := GetPropList(PTypeInfo(AObject.ClassInfo), PL);
  639. if Assigned(PL) then
  640. try
  641. S := AStrings.NameValueSeparator;
  642. if S = NU then
  643. S := EQ;
  644. for I := 0 to Pred(C) do
  645. begin
  646. PI := PL^[I];
  647. if BrookExists(PI^.Name, AIgnoredProps, True) then
  648. Continue;
  649. BrookObjectToString(AObject, PI, V);
  650. AStrings.Add(PI^.Name + S + V);
  651. end;
  652. finally
  653. FreeMem(PL);
  654. end;
  655. end;
  656. procedure BrookObjectToStrings(AObject: TObject; AStrings: TStrings;
  657. const AIgnoredProps: TStrings);
  658. var
  659. S: Char;
  660. V: string;
  661. I, C: Integer;
  662. PI: PPropInfo;
  663. PL: PPropList = nil;
  664. begin
  665. C := GetPropList(PTypeInfo(AObject.ClassInfo), PL);
  666. if Assigned(PL) then
  667. try
  668. S := AStrings.NameValueSeparator;
  669. if S = NU then
  670. S := EQ;
  671. for I := 0 to Pred(C) do
  672. begin
  673. PI := PL^[I];
  674. if AIgnoredProps.IndexOf(PI^.Name) > -1 then
  675. Continue;
  676. BrookObjectToString(AObject, PI, V);
  677. AStrings.Add(PI^.Name + S + V);
  678. end;
  679. finally
  680. FreeMem(PL);
  681. end;
  682. end;
  683. procedure BrookSafeObjectToStrings(AObject: TObject; AStrings: TStrings);
  684. begin
  685. if not Assigned(AObject) then
  686. raise EBrook.CreateFmt('BrookSafeObjectToStrings', SBrookNotNilError,
  687. ['AObject']);
  688. if not Assigned(AStrings) then
  689. raise EBrook.CreateFmt('BrookSafeObjectToStrings', SBrookNotNilError,
  690. ['AStrings']);
  691. BrookObjectToStrings(AObject, AStrings);
  692. end;
  693. procedure BrookSafeObjectToStrings(AObject: TObject; AStrings: TStrings;
  694. const AIgnoredProps: array of string);
  695. begin
  696. if not Assigned(AObject) then
  697. raise EBrook.CreateFmt('BrookSafeObjectToStrings', SBrookNotNilError,
  698. ['AObject']);
  699. if not Assigned(AStrings) then
  700. raise EBrook.CreateFmt('BrookSafeObjectToStrings', SBrookNotNilError,
  701. ['AStrings']);
  702. BrookObjectToStrings(AObject, AStrings, AIgnoredProps);
  703. end;
  704. procedure BrookSafeObjectToStrings(AObject: TObject; AStrings: TStrings;
  705. const AIgnoredProps: TStrings);
  706. begin
  707. if not Assigned(AObject) then
  708. raise EBrook.CreateFmt('BrookSafeObjectToStrings', SBrookNotNilError,
  709. ['AObject']);
  710. if not Assigned(AStrings) then
  711. raise EBrook.CreateFmt('BrookSafeObjectToStrings', SBrookNotNilError,
  712. ['AStrings']);
  713. if not Assigned(AIgnoredProps) then
  714. raise EBrook.CreateFmt('BrookSafeObjectToStrings', SBrookNotNilError,
  715. ['AIgnoredProps']);
  716. BrookObjectToStrings(AObject, AStrings, AIgnoredProps);
  717. end;
  718. procedure BrookCopyObject(APropList: PPropList; const APropCount: Integer;
  719. AFrom, ATo: TObject);
  720. var
  721. I: Integer;
  722. P, PI: PPropInfo;
  723. begin
  724. for I := 0 to Pred(APropCount) do
  725. begin
  726. PI := APropList^[I];
  727. P := GetPropInfo(PTypeInfo(ATo.ClassInfo), PI^.Name);
  728. if Assigned(P) then
  729. case PI^.PropType^.Kind of
  730. tkAString: SetStrProp(ATo, P, GetStrProp(AFrom, PI));
  731. tkInteger, tkBool, tkChar, tkEnumeration, tkSet, tkClass:
  732. SetOrdProp(ATo, P, GetOrdProp(AFrom, PI));
  733. tkInt64: SetInt64Prop(ATo, P, GetInt64Prop(AFrom, PI));
  734. tkFloat: SetFloatProp(ATo, P, GetFloatProp(AFrom, PI));
  735. tkMethod: SetMethodProp(ATo, P, GetMethodProp(AFrom, PI));
  736. end;
  737. end;
  738. end;
  739. procedure BrookCopyObject(APropList: PPropList; const APropCount: Integer;
  740. AFrom, ATo: TObject; const AIgnoredProps: array of string);
  741. var
  742. I: Integer;
  743. P, PI: PPropInfo;
  744. begin
  745. for I := 0 to Pred(APropCount) do
  746. begin
  747. PI := APropList^[I];
  748. if BrookExists(PI^.Name, AIgnoredProps, True) then
  749. Continue;
  750. P := GetPropInfo(PTypeInfo(ATo.ClassInfo), PI^.Name);
  751. if Assigned(P) then
  752. case PI^.PropType^.Kind of
  753. tkAString: SetStrProp(ATo, P, GetStrProp(AFrom, PI));
  754. tkInteger, tkBool, tkChar, tkEnumeration, tkSet, tkClass:
  755. SetOrdProp(ATo, P, GetOrdProp(AFrom, PI));
  756. tkInt64: SetInt64Prop(ATo, P, GetInt64Prop(AFrom, PI));
  757. tkFloat: SetFloatProp(ATo, P, GetFloatProp(AFrom, PI));
  758. tkMethod: SetMethodProp(ATo, P, GetMethodProp(AFrom, PI));
  759. end;
  760. end;
  761. end;
  762. procedure BrookCopyObject(APropList: PPropList; const APropCount: Integer;
  763. AFrom, ATo: TObject; const AIgnoredProps: TStrings);
  764. var
  765. I: Integer;
  766. P, PI: PPropInfo;
  767. begin
  768. for I := 0 to Pred(APropCount) do
  769. begin
  770. PI := APropList^[I];
  771. if AIgnoredProps.IndexOf(PI^.Name) > -1 then
  772. Continue;
  773. P := GetPropInfo(PTypeInfo(ATo.ClassInfo), PI^.Name);
  774. if Assigned(P) then
  775. case PI^.PropType^.Kind of
  776. tkAString: SetStrProp(ATo, P, GetStrProp(AFrom, PI));
  777. tkInteger, tkBool, tkChar, tkEnumeration, tkSet, tkClass:
  778. SetOrdProp(ATo, P, GetOrdProp(AFrom, PI));
  779. tkInt64: SetInt64Prop(ATo, P, GetInt64Prop(AFrom, PI));
  780. tkFloat: SetFloatProp(ATo, P, GetFloatProp(AFrom, PI));
  781. tkMethod: SetMethodProp(ATo, P, GetMethodProp(AFrom, PI));
  782. end;
  783. end;
  784. end;
  785. procedure BrookCopyObject(AFrom, ATo: TObject);
  786. var
  787. C: Integer;
  788. PL: PPropList = nil;
  789. begin
  790. C := GetPropList(AFrom, PL);
  791. if Assigned(PL) then
  792. try
  793. BrookCopyObject(PL, C, AFrom, ATo);
  794. finally
  795. FreeMem(PL);
  796. end;
  797. end;
  798. procedure BrookCopyObject(AFrom, ATo: TObject;
  799. const AIgnoredProps: array of string);
  800. var
  801. C: Integer;
  802. PL: PPropList = nil;
  803. begin
  804. C := GetPropList(AFrom, PL);
  805. if Assigned(PL) then
  806. try
  807. BrookCopyObject(PL, C, AFrom, ATo, AIgnoredProps);
  808. finally
  809. FreeMem(PL);
  810. end;
  811. end;
  812. procedure BrookCopyObject(AFrom, ATo: TObject; const AIgnoredProps: TStrings);
  813. var
  814. C: Integer;
  815. PL: PPropList = nil;
  816. begin
  817. C := GetPropList(AFrom, PL);
  818. if Assigned(PL) then
  819. try
  820. BrookCopyObject(PL, C, AFrom, ATo, AIgnoredProps);
  821. finally
  822. FreeMem(PL);
  823. end;
  824. end;
  825. procedure BrookSafeCopyObject(APropList: PPropList; const APropCount: Integer;
  826. AFrom, ATo: TObject);
  827. begin
  828. if not Assigned(APropList) then
  829. raise EBrook.CreateFmt('BrookSafeCopyObject', SBrookNotNilError,
  830. ['APropList']);
  831. if not Assigned(AFrom) then
  832. raise EBrook.CreateFmt('BrookSafeCopyObject', SBrookNotNilError,
  833. ['AFrom']);
  834. if not Assigned(ATo) then
  835. raise EBrook.CreateFmt('BrookSafeCopyObject', SBrookNotNilError,
  836. ['ATo']);
  837. BrookCopyObject(APropList, APropCount, AFrom, ATo);
  838. end;
  839. procedure BrookSafeCopyObject(APropList: PPropList; const APropCount: Integer;
  840. AFrom, ATo: TObject; const AIgnoredProps: array of string);
  841. begin
  842. if not Assigned(APropList) then
  843. raise EBrook.CreateFmt('BrookSafeCopyObject', SBrookNotNilError,
  844. ['APropList']);
  845. if not Assigned(AFrom) then
  846. raise EBrook.CreateFmt('BrookSafeCopyObject', SBrookNotNilError,
  847. ['AFrom']);
  848. if not Assigned(ATo) then
  849. raise EBrook.CreateFmt('BrookSafeCopyObject', SBrookNotNilError,
  850. ['ATo']);
  851. BrookCopyObject(APropList, APropCount, AFrom, ATo, AIgnoredProps);
  852. end;
  853. procedure BrookSafeCopyObject(APropList: PPropList; const APropCount: Integer;
  854. AFrom, ATo: TObject; const AIgnoredProps: TStrings);
  855. begin
  856. if not Assigned(APropList) then
  857. raise EBrook.CreateFmt('BrookSafeCopyObject', SBrookNotNilError,
  858. ['APropList']);
  859. if not Assigned(AFrom) then
  860. raise EBrook.CreateFmt('BrookSafeCopyObject', SBrookNotNilError,
  861. ['AFrom']);
  862. if not Assigned(ATo) then
  863. raise EBrook.CreateFmt('BrookSafeCopyObject', SBrookNotNilError,
  864. ['ATo']);
  865. if not Assigned(AIgnoredProps) then
  866. raise EBrook.CreateFmt('BrookSafeCopyObject', SBrookNotNilError,
  867. ['AIgnoredProps']);
  868. BrookCopyObject(APropList, APropCount, AFrom, ATo, AIgnoredProps);
  869. end;
  870. procedure BrookSafeCopyObject(AFrom, ATo: TObject);
  871. begin
  872. if not Assigned(AFrom) then
  873. raise EBrook.CreateFmt('BrookSafeCopyObject', SBrookNotNilError,
  874. ['AFrom']);
  875. if not Assigned(ATo) then
  876. raise EBrook.CreateFmt('BrookSafeCopyObject', SBrookNotNilError,
  877. ['ATo']);
  878. BrookCopyObject(AFrom, ATo);
  879. end;
  880. procedure BrookSafeCopyObject(AFrom, ATo: TObject;
  881. const AIgnoredProps: array of string);
  882. begin
  883. if not Assigned(AFrom) then
  884. raise EBrook.CreateFmt('BrookSafeCopyObject', SBrookNotNilError,
  885. ['AFrom']);
  886. if not Assigned(ATo) then
  887. raise EBrook.CreateFmt('BrookSafeCopyObject', SBrookNotNilError,
  888. ['ATo']);
  889. BrookCopyObject(AFrom, ATo, AIgnoredProps);
  890. end;
  891. procedure BrookSafeCopyObject(AFrom, ATo: TObject;
  892. const AIgnoredProps: TStrings);
  893. begin
  894. if not Assigned(AFrom) then
  895. raise EBrook.CreateFmt('BrookSafeCopyObject', SBrookNotNilError,
  896. ['AFrom']);
  897. if not Assigned(ATo) then
  898. raise EBrook.CreateFmt('BrookSafeCopyObject', SBrookNotNilError,
  899. ['ATo']);
  900. if not Assigned(AIgnoredProps) then
  901. raise EBrook.CreateFmt('BrookSafeCopyObject', SBrookNotNilError,
  902. ['AIgnoredProps']);
  903. BrookCopyObject(AFrom, ATo, AIgnoredProps);
  904. end;
  905. end.