}

Delphi.int.ru — Портал программистов

Вход Регистрация | Забыли пароль?

Просмотр кода

Идентификатор: 00338ce6 Описание: VarRecs.pas Код загружен: 3 июля 2011, 17:20 (mirt.steelwater)

  1. unit VarRecs;
  2. {******************************************************************************}
  3. {* Unit for Conversion of TVarRec Types *}
  4. {* Revolutionary Confederation of Anarcho Syndicalists *}
  5. {* Written by: black.rabbit 2010 *}
  6. {******************************************************************************}
  7. interface
  8.  
  9. {$I 'std.inc'}
  10.  
  11. uses
  12. Windows, SysUtils, DateUtils;
  13.  
  14. type
  15. array_of_const = array of TVarRec;
  16.  
  17. function toBoolean (const aValue: TVarRec) : Boolean; overload;
  18. function toDateTime (const aValue: TVarRec) : TDateTime; overload;
  19. function toDate (const aValue: TVarRec) : TDateTime; overload;
  20. function toPointer (const aValue: TVarRec) : Pointer; overload;
  21. function toObject (const aValue: TVarRec) : TObject; overload;
  22. function toClass (const aValue: TVarRec) : TClass; overload;
  23. function toInteger (const aValue: TVarRec) : Integer; overload;
  24. function toString (const aValue: TVarRec) : String; overload;
  25. function toExtended (const aValue: TVarRec) : Extended; overload;
  26. function toDouble (const aValue: TVarRec) : Double; overload;
  27. function toInt64 (const aValue: TVarRec) : Int64; overload;
  28. function toArrayOfConst (const aValue: TVarRec) : array_of_const; overload;
  29.  
  30. function _array_of_const (anArgs: array of const) : array_of_const;
  31. function _(anArgs: array of const) : array_of_const; overload;
  32.  
  33. function merge (anArgs1, anArgs2: array of const) : array_of_const; overload;
  34. function _(anArgs1, anArgs2: array of const) : array_of_const; overload;
  35.  
  36. const
  37. NULL = 'NULL';
  38.  
  39. function isEmpty (const anIndex: Integer; anArgs: array of const) : Boolean; overload;
  40. function notEmpty (const anIndex: Integer; anArgs: array of const) : Boolean; overload;
  41.  
  42. implementation
  43.  
  44. { Boolean }
  45. const
  46. BOOLEAN_STRING : array [FALSE..TRUE] of String = ('FALSE', 'TRUE');
  47. BOOLEAN_CHAR : array [FALSE..TRUE] of String = ('F', 'T');
  48. SHORT_BOOLEAN_CHAR : array [FALSE..TRUE] of String = ('0', '1');
  49. SHORT_BOOLEAN_INT : array [FALSE..TRUE] of Integer = (0, 1);
  50.  
  51. function StrToBoolean (const aValue : String) : Boolean;
  52. var
  53. Value : String;
  54. begin
  55. Value := UpperCase (aValue);
  56. Result := ( ( Value = BOOLEAN_STRING [TRUE] )
  57. or ( Value = BOOLEAN_CHAR [TRUE] )
  58. or ( Value = SHORT_BOOLEAN_CHAR [TRUE] ) );
  59. end;
  60.  
  61. function BooleanToStr (const aValue : Boolean) : String;
  62. begin
  63. Result := BOOLEAN_STRING [aValue];
  64. end;
  65.  
  66. function IntToBoolean (const aValue : Integer) : Boolean;
  67. begin
  68. Result := ( aValue = SHORT_BOOLEAN_INT [TRUE] );
  69. end;
  70.  
  71. function BooleanToInt (const aValue : Boolean) : Integer;
  72. begin
  73. Result := SHORT_BOOLEAN_INT [aValue];
  74. end;
  75.  
  76. { TVarRec }
  77. function toBoolean (const aValue: TVarRec) : Boolean;
  78. begin
  79. Result := FALSE;
  80. with aValue do
  81. try
  82. case VType of
  83. vtInteger: Result := IntToBoolean (VInteger);
  84. vtBoolean: Result := VBoolean;
  85. vtChar: Result := StrToBoolean ( VChar );
  86. vtExtended: Result := IntToBoolean ( Round (VExtended^) );
  87. vtString: Result := StrToBoolean (VString^);
  88. vtPointer: Result := StrToBoolean ( StrPas (VPChar) );
  89. vtPChar: Result := StrToBoolean ( StrPas (VPChar) );
  90. vtWideChar: Result := StrToBoolean ( Char (VWideChar) );
  91. vtPWideChar: Result := StrToBoolean ( WideCharToString (VPWideChar) );
  92. vtAnsiString: Result := StrToBoolean ( String (VAnsiString) );
  93. vtCurrency: Result := IntToBoolean ( Round (VExtended^) );
  94. vtVariant: Result := Boolean (VVariant^);
  95. vtWideString: Result := StrToBoolean ( WideCharToString (VWideString) );
  96. vtInt64: Result := IntToBoolean ( Integer (VInt64^) );
  97. end;
  98. except
  99. Result := FALSE;
  100. end;
  101. end;
  102.  
  103. function toDateTime (const aValue: TVarRec) : TDateTime;
  104. begin
  105. Result := 0.0;
  106. with aValue do
  107. try
  108. case VType of
  109. vtInt64: Result := UnixToDateTime (VInt64^);
  110. vtInteger: Result := UnixToDateTime (VInteger);
  111. vtExtended: Result := VExtended^;
  112. vtVariant: Result := Extended (VVariant^);
  113. vtString: Result := StrToDateTime (VString^);
  114. vtPointer: Result := StrToDateTime ( StrPas (VPChar) );
  115. vtPChar: Result := StrToDateTime ( StrPas (VPChar) );
  116. vtAnsiString: Result := StrToDateTime ( String (VAnsiString) );
  117. vtPWideChar: Result := StrToDateTime ( WideCharToString (VPWideChar) );
  118. vtWideString: Result := StrToDateTime ( WideCharToString (VWideString) );
  119. end;
  120. except
  121. Result := 0.0;
  122. end;
  123. end;
  124.  
  125. function toDate (const aValue: TVarRec) : TDateTime;
  126. begin
  127. Result := 0.0;
  128. with aValue do
  129. try
  130. case VType of
  131. vtInt64: Result := VInt64^;
  132. vtInteger: Result := VInteger;
  133. vtExtended: Result := Trunc (VExtended^);
  134. vtVariant: Result := Trunc ( Extended (VVariant^) );
  135. vtString: Result := StrToDate (VString^);
  136. vtPointer: Result := StrToDate ( StrPas (VPChar) );
  137. vtPChar: Result := StrToDate ( StrPas (VPChar) );
  138. vtAnsiString: Result := StrToDate ( String (VAnsiString) );
  139. vtPWideChar: Result := StrToDate ( WideCharToString (VPWideChar) );
  140. vtWideString: Result := StrToDate ( WideCharToString (VWideString) );
  141. end;
  142. except
  143. Result := 0.0;
  144. end;
  145. end;
  146.  
  147. function toPointer (const aValue: TVarRec) : Pointer;
  148. begin
  149. Result := NIL;
  150. with aValue do
  151. try
  152. case VType of
  153. vtPointer: Result := VPointer;
  154. end;
  155. except
  156. Result := NIL;
  157. end;
  158. end;
  159.  
  160. function toObject (const aValue: TVarRec) : TObject;
  161. begin
  162. Result := NIL;
  163. with aValue do
  164. try
  165. case VType of
  166. vtObject: Result := VObject;
  167. end;
  168. except
  169. Result := NIL;
  170. end;
  171. end;
  172.  
  173. function toClass (const aValue: TVarRec) : TClass;
  174. begin
  175. Result := NIL;
  176. with aValue do
  177. try
  178. case VType of
  179. vtClass: Result := VClass;
  180. vtObject: Result := VObject.ClassType;
  181. end;
  182. except
  183. Result := NIL;
  184. end;
  185. end;
  186.  
  187. function toInteger (const aValue: TVarRec) : Integer;
  188. begin
  189. Result := 0;
  190. with aValue do
  191. try
  192. case VType of
  193. vtVariant: Result := Integer (VVariant^);
  194. vtInteger: Result := VInteger;
  195. vtInt64: Result := Integer (VInt64^);
  196. vtPointer: Result := Longint (VPointer);
  197. vtObject: Result := Longint (VObject);
  198. vtClass: Result := Longint (VClass);
  199. vtInterface: Result := Longint (VInterface);
  200. vtBoolean: Result := BooleanToInt (VBoolean);
  201. vtString: Result := StrToInt (VString^);
  202. vtChar: Result := StrToInt ( VChar );
  203. vtPChar: Result := StrToInt ( StrPas (VPChar) );
  204. vtAnsiString: Result := StrToInt ( String (VAnsiString) );
  205. vtWideChar: Result := StrToInt ( Char (VWideChar) );
  206. vtPWideChar: Result := StrToInt ( WideCharToString (VPWideChar) );
  207. vtWideString: Result := StrToInt ( WideCharToString (VWideString) );
  208. end;
  209. except
  210. Result := 0;
  211. end;
  212. end;
  213.  
  214. function toString (const aValue: TVarRec) : String;
  215. begin
  216. Result := '';
  217. with aValue do
  218. try
  219. case VType of
  220. vtInteger: Result := IntToStr (VInteger);
  221. vtBoolean: Result := BooleanToStr (VBoolean);
  222. vtChar: Result := VChar;
  223. vtExtended: Result := FloatToStr (VExtended^);
  224. vtString: Result := VString^;
  225. vtPointer: Result := IntToStr ( Longint (VPointer) );
  226. vtPChar: Result := StrPas (VPChar);
  227. vtObject: Result := VObject.ClassName;
  228. vtClass: Result := VClass.ClassName;
  229. vtAnsiString: Result := String (VAnsiString);
  230. vtWideChar: Result := Char (VWideChar);
  231. vtPWideChar: Result := WideCharToString (VPWideChar);
  232. vtWideString: Result := WideCharToString (VWideString);
  233. vtCurrency: Result := FloatToStr (VCurrency^);
  234. vtInt64: Result := IntToStr (VInt64^);
  235. vtVariant: Result := VVariant^;
  236. end;
  237. except
  238. Result := '';
  239. end;
  240. end;
  241.  
  242. function toExtended (const aValue: TVarRec) : Extended;
  243. begin
  244. Result := 0.0;
  245. with aValue do
  246. try
  247. case VType of
  248. vtExtended: Result := VExtended^;
  249. vtCurrency: Result := VCurrency^;
  250. vtVariant: Result := Extended (VVariant^);
  251. vtInteger: Result := VInteger;
  252. vtInt64: Result := Integer (VInt64^);
  253. vtPointer: Result := Longint (VPointer);
  254. vtObject: Result := Longint (VObject);
  255. vtClass: Result := Longint (VClass);
  256. vtInterface: Result := Longint (VInterface);
  257. vtBoolean: Result := BooleanToInt (VBoolean);
  258. vtString: Result := StrToFloat (VString^);
  259. vtChar: Result := StrToFloat (VChar);
  260. vtPChar: Result := StrToFloat ( StrPas (VPChar) );
  261. vtAnsiString: Result := StrToFloat ( String (VAnsiString) );
  262. vtWideChar: Result := StrToFloat ( Char (VWideChar) );
  263. vtPWideChar: Result := StrToFloat ( WideCharToString (VPWideChar) );
  264. vtWideString: Result := StrToFloat ( WideCharToString (VWideString) );
  265. end;
  266. except
  267. Result := 0.0;
  268. end;
  269. end;
  270.  
  271. function toDouble (const aValue: TVarRec) : Double;
  272. begin
  273. Result := toExtended (aValue);
  274. end;
  275.  
  276. function toInt64 (const aValue: TVarRec) : Int64;
  277. begin
  278. Result := 0;
  279. with aValue do
  280. try
  281. case VType of
  282. vtInt64: Result := VInt64^;
  283. vtInteger: Result := VInteger;
  284. vtExtended: Move ( VExtended^, Result, SizeOf (Int64) );
  285. vtVariant: Result := Integer (VVariant^);
  286. vtPointer: Result := Longint (VPointer);
  287. vtObject: Result := Longint (VObject);
  288. vtClass: Result := Longint (VClass);
  289. vtInterface: Result := Longint (VInterface);
  290. vtBoolean: Result := BooleanToInt (VBoolean);
  291. vtString: Result := StrToInt64 (VString^);
  292. vtChar: Result := StrToInt64 (VChar);
  293. vtPChar: Result := StrToInt64 ( StrPas (VPChar) );
  294. vtAnsiString: Result := StrToInt64 ( String (VAnsiString) );
  295. vtWideChar: Result := StrToInt64 ( Char (VWideChar) );
  296. vtPWideChar: Result := StrToInt64 ( WideCharToString (VPWideChar) );
  297. vtWideString: Result := StrToInt64 ( WideCharToString (VWideString) );
  298. end;
  299. except
  300. Result := 0;
  301. end;
  302. end;
  303.  
  304. function toArrayOfConst (const aValue: TVarRec) : array_of_const;
  305. begin
  306. Result := _([]);
  307. with aValue do
  308. try
  309. case VType of
  310. vtPointer: Result := VPointer;
  311. end;
  312. except
  313. Result := _([]);
  314. end;
  315. end;
  316.  
  317. function _array_of_const (anArgs: array of const) : array_of_const;
  318. var
  319. I : WORD;
  320. Index : WORD;
  321. Length : WORD;
  322. begin
  323. Length := 0;
  324. if ( High (anArgs) >= 0 ) then
  325. Length := Length + High (anArgs) - Low (anArgs) +1;
  326. if ( Length > 0 ) then
  327. begin
  328. SetLength (Result,Length);
  329. Index := 0;
  330. for I := Low (anArgs) to High (anArgs) do
  331. begin
  332. Result [Index] := anArgs [I];
  333. Inc (Index);
  334. end;
  335. end;
  336. end;
  337.  
  338. function _(anArgs: array of const) : array_of_const;
  339. begin
  340. Result := _array_of_const (anArgs);
  341. end;
  342.  
  343. { merge array of const }
  344. function merge (anArgs1, anArgs2: array of const) : array_of_const;
  345. var
  346. I : WORD;
  347. Index : WORD;
  348. Length : WORD;
  349. begin
  350. Result := _([]);
  351. try
  352. Length := 0;
  353. if ( High (anArgs1) >= 0 ) then
  354. Length := Length + High (anArgs1) - Low (anArgs1) +1;
  355. if ( High (anArgs2) >= 0 ) then
  356. Length := Length + High (anArgs2) - Low (anArgs2) +1;
  357. if ( Length > 0 ) then
  358. begin
  359. SetLength (Result,Length);
  360. Index := 0;
  361. if ( High (anArgs1) >= 0 ) then
  362. for I := Low (anArgs1) to High (anArgs1) do
  363. begin
  364. Result [Index] := anArgs1 [I];
  365. Inc (Index);
  366. end;
  367. if ( High (anArgs2) >= 0 ) then
  368. for I := Low (anArgs2) to High (anArgs2) do
  369. begin
  370. Result [Index] := anArgs2 [I];
  371. Inc (Index);
  372. end;
  373. end;
  374. except
  375. Result := _([]);
  376. end;
  377. end;
  378.  
  379. function _(anArgs1, anArgs2: array of const) : array_of_const;
  380. begin
  381. Result := merge (anArgs1,anArgs2);
  382. end;
  383.  
  384. function isEmpty (const anIndex: Integer; anArgs: array of const) : Boolean;
  385. begin
  386. Result := ( ( High (anArgs) < anIndex ) or
  387. ( toString (anArgs [anIndex]) = NULL ) );
  388. end;
  389.  
  390. function notEmpty (const anIndex: Integer; anArgs: array of const) : Boolean;
  391. begin
  392. Result := ( ( High (anArgs) >= anIndex ) and
  393. ( toString (anArgs [anIndex]) <> NULL ) );
  394. end;
  395.  
  396.  
  397. end.

Ссылка на данный код:

На главную страницу сервиса обмена кодом »