brookutils.pas 32 KB

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