variant.inc 30 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2001 by the Free Pascal development team
  4. This include file contains the implementation for variants
  5. support in FPC as far as it is part of the system unit
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. var
  13. variantmanager : tvariantmanager;
  14. { ---------------------------------------------------------------------
  15. Compiler helper routines.
  16. ---------------------------------------------------------------------}
  17. procedure fpc_variant_init(var v : tvardata);[Public,Alias:'FPC_VARIANT_INIT'];compilerproc;
  18. begin
  19. { calling the variant manager here is a problem because the static/global variants
  20. are initialized while the variant manager isn't assigned }
  21. fillchar(v,sizeof(variant),0);
  22. end;
  23. procedure fpc_variant_clear(var v : tvardata);[Public,Alias:'FPC_VARIANT_CLEAR'];compilerproc;
  24. begin
  25. if assigned(VarClearProc) then
  26. VarClearProc(v);
  27. end;
  28. { declare aliases for local use }
  29. procedure variant_init(var v: tvardata); external name 'FPC_VARIANT_INIT';
  30. procedure variant_clear(var v: tvardata); external name 'FPC_VARIANT_CLEAR';
  31. procedure variant_addref(var v : tvardata);[Public,Alias:'FPC_VARIANT_ADDREF'];
  32. begin
  33. if assigned(VarAddRefProc) then
  34. VarAddRefProc(v);
  35. end;
  36. { using pointers as argument here makes life for the compiler easier }
  37. procedure fpc_variant_copy(d,s : pointer);[Public,Alias:'FPC_VARIANT_COPY']; compilerproc;
  38. begin
  39. if assigned(VarCopyProc) then
  40. VarCopyProc(tvardata(d^),tvardata(s^));
  41. end;
  42. { using pointers as argument here makes life for the compiler easier, overwrites target without finalizing }
  43. procedure fpc_variant_copy_overwrite(source, dest : pointer);[Public,Alias:'FPC_VARIANT_COPY_OVERWRITE']; compilerproc;
  44. begin
  45. tvardata(dest^).VType := varEmpty;
  46. if assigned(VarCopyProc) then
  47. VarCopyProc(tvardata(dest^),tvardata(source^));
  48. end;
  49. Procedure fpc_write_text_variant(Len : Longint;var f : Text;const v : variant); iocheck; [Public,Alias:'FPC_WRITE_TEXT_VARIANT']; compilerproc;
  50. begin
  51. if (InOutRes<>0) then
  52. exit;
  53. case TextRec(f).mode of
  54. { fmAppend gets changed to fmOutPut in do_open (JM) }
  55. fmOutput:
  56. if len=-1 then
  57. variantmanager.write0variant(f,v)
  58. else
  59. variantmanager.writevariant(f,v,len);
  60. fmInput:
  61. InOutRes:=105
  62. else InOutRes:=103;
  63. end;
  64. end;
  65. procedure fpc_vararray_get(var d : variant;const s : variant;indices : plongint;len : sizeint);compilerproc;
  66. begin
  67. d:=variantmanager.vararrayget(s,len,indices);
  68. end;
  69. procedure fpc_vararray_put(var d : variant;const s : variant;indices : plongint;len : sizeint);compilerproc;
  70. begin
  71. variantmanager.vararrayput(d,s,len,indices);
  72. end;
  73. function fpc_variant_to_dynarray(const v : variant;typeinfo : pointer) : pointer;compilerproc;
  74. begin
  75. result:=nil;
  76. variantmanager.vartodynarray(result,v,typeinfo);
  77. end;
  78. function fpc_dynarray_to_variant(dynarr : pointer;typeinfo : pointer) : variant;compilerproc;
  79. begin
  80. variantmanager.varfromdynarray(result,dynarr,typeinfo);
  81. end;
  82. function fpc_variant_to_interface(const v : variant) : iinterface;compilerproc;
  83. begin
  84. variantmanager.vartointf(result,v);
  85. end;
  86. function fpc_interface_to_variant(const i : iinterface) : variant;compilerproc;
  87. begin
  88. variantmanager.varfromintf(result,i);
  89. end;
  90. function fpc_variant_to_idispatch(const v : variant) : idispatch;compilerproc;
  91. begin
  92. variantmanager.vartodisp(result,v);
  93. end;
  94. function fpc_idispatch_to_variant(const i : idispatch) : variant;compilerproc;
  95. begin
  96. variantmanager.varfromdisp(result,i);
  97. end;
  98. procedure fpc_dispinvoke_variant(dest : pvardata;const source : tvardata;
  99. calldesc : pcalldesc;params : pointer); compilerproc;
  100. begin
  101. variantmanager.dispinvoke(dest,source,calldesc,params);
  102. end;
  103. { ---------------------------------------------------------------------
  104. Overloaded operators.
  105. ---------------------------------------------------------------------}
  106. { Integer }
  107. operator :=(const source : byte) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  108. begin
  109. Variantmanager.varfromInt(Dest,Source,1);
  110. end;
  111. operator :=(const source : shortint) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  112. begin
  113. Variantmanager.varfromInt(Dest,Source,-1);
  114. end;
  115. operator :=(const source : word) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  116. begin
  117. Variantmanager.varfromInt(Dest,Source,2);
  118. end;
  119. operator :=(const source : smallint) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  120. begin
  121. Variantmanager.varfromInt(Dest,Source,-2);
  122. end;
  123. operator :=(const source : dword) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  124. begin
  125. Variantmanager.varfromInt(Dest,Source,4);
  126. end;
  127. operator :=(const source : longint) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  128. begin
  129. Variantmanager.varfromInt(Dest,Source,-4);
  130. end;
  131. operator :=(const source : qword) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  132. begin
  133. Variantmanager.varfromWord64(Dest,Source);
  134. end;
  135. operator :=(const source : int64) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  136. begin
  137. Variantmanager.varfromInt64(Dest,Source);
  138. end;
  139. { Boolean }
  140. operator :=(const source : boolean) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  141. begin
  142. Variantmanager.varfromBool(Dest,Source);
  143. end;
  144. operator :=(const source : wordbool) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  145. begin
  146. Variantmanager.varfromBool(Dest,Boolean(Source));
  147. end;
  148. operator :=(const source : longbool) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  149. begin
  150. Variantmanager.varfromBool(Dest,Boolean(Source));
  151. end;
  152. { Chars }
  153. operator :=(const source : char) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  154. begin
  155. VariantManager.VarFromPStr(Dest,Source);
  156. end;
  157. operator :=(const source : widechar) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  158. begin
  159. Variantmanager.varfromInt(Dest,word(Source),2);
  160. end;
  161. { Strings }
  162. operator :=(const source : shortstring) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  163. begin
  164. VariantManager.VarFromPStr(Dest,Source);
  165. end;
  166. operator :=(const source : ansistring) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  167. begin
  168. VariantManager.VarFromLStr(Dest,Source);
  169. end;
  170. operator :=(const source : widestring) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  171. begin
  172. VariantManager.VarFromWStr(Dest,Source);
  173. end;
  174. operator :=(const source : UTF8String) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  175. begin
  176. VariantManager.VarFromWStr(Dest,UTF8Decode(Source));
  177. end;
  178. operator :=(const source : UCS4String) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  179. begin
  180. VariantManager.VarFromWStr(Dest,UCS4StringToWideString(Source));
  181. end;
  182. {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
  183. operator :=(const source : UnicodeString) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  184. begin
  185. VariantManager.VarFromWStr(Dest,Source);
  186. end;
  187. {$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
  188. { Floats }
  189. {$ifdef SUPPORT_SINGLE}
  190. operator :=(const source : single) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  191. begin
  192. VariantManager.VarFromReal(Dest,Source);
  193. end;
  194. {$endif SUPPORT_SINGLE}
  195. {$ifdef SUPPORT_DOUBLE}
  196. operator :=(const source : double) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  197. begin
  198. VariantManager.VarFromReal(Dest,Source);
  199. end;
  200. {$endif SUPPORT_DOUBLE}
  201. {$ifdef SUPPORT_EXTENDED}
  202. operator :=(const source : extended) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  203. begin
  204. VariantManager.VarFromReal(Dest,Source);
  205. end;
  206. {$endif SUPPORT_EXTENDED}
  207. {$ifdef SUPPORT_COMP}
  208. Operator :=(const source : comp) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  209. begin
  210. VariantManager.VarFromReal(Dest,Source);
  211. end;
  212. {$endif SUPPORT_COMP}
  213. {$ifndef VER2_0}
  214. {$ifndef FPUNONE}
  215. Operator :=(const source : real) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  216. begin
  217. VariantManager.VarFromReal(Dest,Source);
  218. end;
  219. {$endif}
  220. {$endif VER2_0}
  221. { Misc. }
  222. operator :=(const source : currency) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  223. begin
  224. VariantManager.VarFromCurr(Dest,Source);
  225. end;
  226. {$ifndef FPUNONE}
  227. operator :=(const source : tdatetime) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  228. begin
  229. VariantManager.VarFromTDateTime(Dest,Source);
  230. end;
  231. {$endif}
  232. operator :=(const source : terror) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  233. begin
  234. Variantmanager.varfromInt(Dest,Source,-sizeof(terror));
  235. end;
  236. {**********************************************************************
  237. from Variant assignments
  238. **********************************************************************}
  239. { Integer }
  240. operator :=(const source : variant) dest : byte;{$ifdef SYSTEMINLINE}inline;{$endif}
  241. begin
  242. dest:=variantmanager.vartoint(source);
  243. end;
  244. operator :=(const source : variant) dest : shortint;{$ifdef SYSTEMINLINE}inline;{$endif}
  245. begin
  246. dest:=variantmanager.vartoint(source);
  247. end;
  248. operator :=(const source : variant) dest : word;{$ifdef SYSTEMINLINE}inline;{$endif}
  249. begin
  250. dest:=variantmanager.vartoint(source);
  251. end;
  252. operator :=(const source : variant) dest : smallint;{$ifdef SYSTEMINLINE}inline;{$endif}
  253. begin
  254. dest:=variantmanager.vartoint(source);
  255. end;
  256. operator :=(const source : variant) dest : dword;{$ifdef SYSTEMINLINE}inline;{$endif}
  257. begin
  258. dest:=variantmanager.vartoint(source);
  259. end;
  260. operator :=(const source : variant) dest : longint;{$ifdef SYSTEMINLINE}inline;{$endif}
  261. begin
  262. dest:=variantmanager.vartoint(source);
  263. end;
  264. operator :=(const source : variant) dest : qword;{$ifdef SYSTEMINLINE}inline;{$endif}
  265. begin
  266. dest:=variantmanager.vartoword64(source);
  267. end;
  268. operator :=(const source : variant) dest : int64;{$ifdef SYSTEMINLINE}inline;{$endif}
  269. begin
  270. dest:=variantmanager.vartoint64(source);
  271. end;
  272. { Boolean }
  273. operator :=(const source : variant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
  274. begin
  275. dest:=variantmanager.vartobool(source);
  276. end;
  277. operator :=(const source : variant) dest : wordbool;{$ifdef SYSTEMINLINE}inline;{$endif}
  278. begin
  279. dest:=variantmanager.vartobool(source);
  280. end;
  281. operator :=(const source : variant) dest : longbool;{$ifdef SYSTEMINLINE}inline;{$endif}
  282. begin
  283. dest:=variantmanager.vartobool(source);
  284. end;
  285. { Chars }
  286. operator :=(const source : variant) dest : char;{$ifdef SYSTEMINLINE}inline;{$endif}
  287. Var
  288. S : String;
  289. begin
  290. VariantManager.VarToPStr(S,Source);
  291. If Length(S)>0 then
  292. Dest:=S[1];
  293. end;
  294. operator :=(const source : variant) dest : widechar;{$ifdef SYSTEMINLINE}inline;{$endif}
  295. begin
  296. dest:=widechar(variantmanager.vartoint(source));
  297. end;
  298. { Strings }
  299. operator :=(const source : variant) dest : shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
  300. begin
  301. VariantManager.VarToPStr(Dest,Source);
  302. end;
  303. operator :=(const source : variant) dest : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
  304. begin
  305. VariantManager.vartolstr(dest,source);
  306. end;
  307. operator :=(const source : variant) dest : widestring;{$ifdef SYSTEMINLINE}inline;{$endif}
  308. begin
  309. variantmanager.vartowstr(dest,source);
  310. end;
  311. operator :=(const source : variant) dest : UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
  312. var
  313. temp : Widestring;
  314. begin
  315. VariantManager.VarToWStr(temp,Source);
  316. dest:=UTF8Encode(temp);
  317. end;
  318. {$ifdef dummy}
  319. operator :=(const source : variant) dest : UCS4String;{$ifdef SYSTEMINLINE}inline;{$endif}
  320. var
  321. temp : Widestring;
  322. begin
  323. VariantManager.VarToWStr(temp,Source);
  324. dest:=WideStringToUCS4String(temp);
  325. end;
  326. {$endif dummy}
  327. {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
  328. operator :=(const source : variant) dest : UnicodeString;{$ifdef SYSTEMINLINE}inline;{$endif}
  329. var
  330. res : WideString;
  331. begin
  332. variantmanager.vartowstr(res,source);
  333. dest:=res;
  334. end;
  335. {$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
  336. { Floats }
  337. {$ifdef SUPPORT_SINGLE}
  338. operator :=(const source : variant) dest : single;{$ifdef SYSTEMINLINE}inline;{$endif}
  339. begin
  340. dest:=variantmanager.vartoreal(source);
  341. end;
  342. {$endif SUPPORT_SINGLE}
  343. {$ifdef SUPPORT_DOUBLE}
  344. operator :=(const source : variant) dest : double;{$ifdef SYSTEMINLINE}inline;{$endif}
  345. begin
  346. dest:=variantmanager.vartoreal(source);
  347. end;
  348. {$endif SUPPORT_DOUBLE}
  349. {$ifdef SUPPORT_EXTENDED}
  350. operator :=(const source : variant) dest : extended;{$ifdef SYSTEMINLINE}inline;{$endif}
  351. begin
  352. dest:=variantmanager.vartoreal(source);
  353. end;
  354. {$endif SUPPORT_EXTENDED}
  355. {$ifdef SUPPORT_COMP}
  356. operator :=(const source : variant) dest : comp;{$ifdef SYSTEMINLINE}inline;{$endif}
  357. begin
  358. dest:=comp(variantmanager.vartoreal(source));
  359. end;
  360. {$endif SUPPORT_COMP}
  361. {$ifndef VER2_0}
  362. {$ifndef FPUNONE}
  363. operator :=(const source : variant) dest : real;{$ifdef SYSTEMINLINE}inline;{$endif}
  364. begin
  365. dest:=variantmanager.vartoreal(source);
  366. end;
  367. {$endif}
  368. {$endif VER2_0}
  369. { Misc. }
  370. operator :=(const source : variant) dest : currency;{$ifdef SYSTEMINLINE}inline;{$endif}
  371. begin
  372. dest:=variantmanager.vartocurr(source);
  373. end;
  374. {$ifndef FPUNONE}
  375. operator :=(const source : variant) dest : tdatetime;{$ifdef SYSTEMINLINE}inline;{$endif}
  376. begin
  377. dest:=variantmanager.vartotdatetime(source);
  378. end;
  379. {$endif}
  380. {$ifndef FPC_HASINTERNALOLEVARIANT2VARIANTCAST}
  381. operator :=(const source : olevariant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  382. begin
  383. tvardata(result):=tvardata(source);
  384. end;
  385. {$endif FPC_HASINTERNALOLEVARIANT2VARIANTCAST}
  386. operator :=(const source : variant) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  387. begin
  388. variantmanager.olevarfromvar(dest,source);
  389. end;
  390. operator :=(const source : variant) dest : terror;{$ifdef SYSTEMINLINE}inline;{$endif}
  391. begin
  392. dest:=variantmanager.vartoint(source);
  393. end;
  394. {**********************************************************************
  395. Operators
  396. **********************************************************************}
  397. operator or(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  398. begin
  399. dest:=op1;
  400. variantmanager.varop(dest,op2,opor);
  401. end;
  402. operator and(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  403. begin
  404. dest:=op1;
  405. variantmanager.varop(dest,op2,opand);
  406. end;
  407. operator xor(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  408. begin
  409. dest:=op1;
  410. variantmanager.varop(dest,op2,opxor);
  411. end;
  412. operator not(const op : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  413. begin
  414. dest:=op;
  415. variantmanager.varnot(dest);
  416. end;
  417. operator shl(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  418. begin
  419. dest:=op1;
  420. variantmanager.varop(dest,op2,opshiftleft);
  421. end;
  422. operator shr(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  423. begin
  424. dest:=op1;
  425. variantmanager.varop(dest,op2,opshiftright);
  426. end;
  427. operator +(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  428. begin
  429. dest:=op1;
  430. variantmanager.varop(dest,op2,opadd);
  431. end;
  432. operator -(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  433. begin
  434. dest:=op1;
  435. variantmanager.varop(dest,op2,opsubtract);
  436. end;
  437. operator *(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  438. begin
  439. dest:=op1;
  440. variantmanager.varop(dest,op2,opmultiply);
  441. end;
  442. operator /(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  443. begin
  444. dest:=op1;
  445. variantmanager.varop(dest,op2,opdivide);
  446. end;
  447. operator **(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  448. begin
  449. dest:=op1;
  450. variantmanager.varop(dest,op2,oppower);
  451. end;
  452. operator div(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  453. begin
  454. dest:=op1;
  455. variantmanager.varop(dest,op2,opintdivide);
  456. end;
  457. operator mod(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  458. begin
  459. dest:=op1;
  460. variantmanager.varop(dest,op2,opmodulus);
  461. end;
  462. operator -(const op : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  463. begin
  464. dest:=op;
  465. variantmanager.varneg(dest);
  466. end;
  467. operator =(const op1,op2 : variant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
  468. begin
  469. dest:=variantmanager.cmpop(op1,op2,opcmpeq);
  470. end;
  471. operator <(const op1,op2 : variant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
  472. begin
  473. dest:=variantmanager.cmpop(op1,op2,opcmplt);
  474. end;
  475. operator >(const op1,op2 : variant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
  476. begin
  477. dest:=variantmanager.cmpop(op1,op2,opcmpgt);
  478. end;
  479. operator >=(const op1,op2 : variant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
  480. begin
  481. dest:=variantmanager.cmpop(op1,op2,opcmpge);
  482. end;
  483. operator <=(const op1,op2 : variant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
  484. begin
  485. dest:=variantmanager.cmpop(op1,op2,opcmple);
  486. end;
  487. procedure VarArrayRedim(var A: Variant; HighBound: SizeInt);
  488. begin
  489. variantmanager.vararrayredim(a,highbound);
  490. end;
  491. procedure VarArrayPut(var A: Variant; const Value: Variant; const Indices: array of Longint);
  492. begin
  493. if Length(Indices)>0 then
  494. variantmanager.vararrayput(A, Value, Length(Indices), @Indices[0])
  495. else
  496. variantmanager.vararrayput(A, Value, 0, nil);
  497. end;
  498. function VarArrayGet(const A: Variant; const Indices: array of Longint): Variant;
  499. begin
  500. if Length(Indices)>0 then
  501. Result:=variantmanager.vararrayget(A, Length(Indices), @Indices[0])
  502. else
  503. Result:=variantmanager.vararrayget(A, 0, nil);
  504. end;
  505. procedure VarCast(var dest : variant;const source : variant;vartype : longint);
  506. begin
  507. variantmanager.varcast(dest,source,vartype);
  508. end;
  509. {**********************************************************************
  510. from OLEVariant assignments
  511. **********************************************************************}
  512. { Integer }
  513. operator :=(const source : olevariant) dest : byte;{$ifdef SYSTEMINLINE}inline;{$endif}
  514. begin
  515. { cast away olevar to var conversion and avoid
  516. endless recursion }
  517. dest:=variantmanager.vartoint(variant(tvardata(source)));
  518. end;
  519. operator :=(const source : olevariant) dest : shortint;{$ifdef SYSTEMINLINE}inline;{$endif}
  520. begin
  521. dest:=variantmanager.vartoint(variant(tvardata(source)));
  522. end;
  523. operator :=(const source : olevariant) dest : word;{$ifdef SYSTEMINLINE}inline;{$endif}
  524. begin
  525. dest:=variantmanager.vartoint(variant(tvardata(source)));
  526. end;
  527. operator :=(const source : olevariant) dest : smallint;{$ifdef SYSTEMINLINE}inline;{$endif}
  528. begin
  529. dest:=variantmanager.vartoint(variant(tvardata(source)));
  530. end;
  531. operator :=(const source : olevariant) dest : dword;{$ifdef SYSTEMINLINE}inline;{$endif}
  532. begin
  533. dest:=variantmanager.vartoint(variant(tvardata(source)));
  534. end;
  535. operator :=(const source : olevariant) dest : longint;{$ifdef SYSTEMINLINE}inline;{$endif}
  536. begin
  537. dest:=variantmanager.vartoint(variant(tvardata(source)));
  538. end;
  539. operator :=(const source : olevariant) dest : qword;{$ifdef SYSTEMINLINE}inline;{$endif}
  540. begin
  541. dest:=variantmanager.vartoint64(variant(tvardata(source)));
  542. end;
  543. operator :=(const source : olevariant) dest : int64;{$ifdef SYSTEMINLINE}inline;{$endif}
  544. begin
  545. dest:=variantmanager.vartoword64(variant(tvardata(source)));
  546. end;
  547. { Boolean }
  548. operator :=(const source : olevariant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
  549. begin
  550. dest:=variantmanager.vartobool(variant(tvardata(source)));
  551. end;
  552. operator :=(const source : olevariant) dest : wordbool;{$ifdef SYSTEMINLINE}inline;{$endif}
  553. begin
  554. dest:=variantmanager.vartobool(variant(tvardata(source)));
  555. end;
  556. operator :=(const source : olevariant) dest : longbool;{$ifdef SYSTEMINLINE}inline;{$endif}
  557. begin
  558. dest:=variantmanager.vartobool(variant(tvardata(source)));
  559. end;
  560. { Chars }
  561. operator :=(const source : olevariant) dest : char;{$ifdef SYSTEMINLINE}inline;{$endif}
  562. var
  563. S : String;
  564. begin
  565. VariantManager.VarToPStr(S,Source);
  566. If Length(S)>0 then
  567. Dest:=S[1]
  568. else
  569. Dest:=#0;
  570. end;
  571. operator :=(const source : olevariant) dest : widechar;{$ifdef SYSTEMINLINE}inline;{$endif}
  572. Var
  573. WS : WideString;
  574. begin
  575. VariantManager.VarToWStr(WS,Source);
  576. If Length(WS)>0 then
  577. Dest:=WS[1]
  578. else
  579. Dest:=#0;
  580. end;
  581. { Strings }
  582. operator :=(const source : olevariant) dest : shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
  583. begin
  584. variantmanager.vartopstr(dest,variant(tvardata(source)));
  585. end;
  586. operator :=(const source : olevariant) dest : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
  587. begin
  588. variantmanager.vartolstr(dest,variant(tvardata(source)));
  589. end;
  590. operator :=(const source : olevariant) dest : widestring;{$ifdef SYSTEMINLINE}inline;{$endif}
  591. begin
  592. variantmanager.vartowstr(dest,variant(tvardata(source)));
  593. end;
  594. {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
  595. operator :=(const source : olevariant) dest : UnicodeString;{$ifdef SYSTEMINLINE}inline;{$endif}
  596. var
  597. res : WideString;
  598. begin
  599. variantmanager.vartowstr(res,variant(tvardata(source)));
  600. dest:=res;
  601. end;
  602. {$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
  603. { Floats }
  604. {$ifdef SUPPORT_SINGLE}
  605. operator :=(const source : olevariant) dest : single;{$ifdef SYSTEMINLINE}inline;{$endif}
  606. begin
  607. dest:=variantmanager.vartoreal(variant(tvardata(source)));
  608. end;
  609. {$endif SUPPORT_SINGLE}
  610. {$ifdef SUPPORT_DOUBLE}
  611. operator :=(const source : olevariant) dest : double;{$ifdef SYSTEMINLINE}inline;{$endif}
  612. begin
  613. dest:=variantmanager.vartoreal(variant(tvardata(source)));
  614. end;
  615. {$endif SUPPORT_DOUBLE}
  616. {$ifdef SUPPORT_EXTENDED}
  617. operator :=(const source : olevariant) dest : extended;{$ifdef SYSTEMINLINE}inline;{$endif}
  618. begin
  619. dest:=variantmanager.vartoreal(variant(tvardata(source)));
  620. end;
  621. {$endif SUPPORT_EXTENDED}
  622. {$ifdef SUPPORT_COMP}
  623. operator :=(const source : olevariant) dest : comp;{$ifdef SYSTEMINLINE}inline;{$endif}
  624. begin
  625. {$ifdef FPUNONE}
  626. dest:=comp(variantmanager.vartoint64(variant(tvardata(source))));
  627. {$else}
  628. dest:=comp(variantmanager.vartoreal(variant(tvardata(source))));
  629. {$endif}
  630. end;
  631. {$endif SUPPORT_COMP}
  632. {$ifndef FPUNONE}
  633. {$ifndef VER2_0}
  634. operator :=(const source : olevariant) dest : real;{$ifdef SYSTEMINLINE}inline;{$endif}
  635. begin
  636. dest:=variantmanager.vartoreal(variant(tvardata(source)));
  637. end;
  638. {$endif VER2_0}
  639. {$endif}
  640. { Misc. }
  641. operator :=(const source : olevariant) dest : currency;{$ifdef SYSTEMINLINE}inline;{$endif}
  642. begin
  643. dest:=variantmanager.vartocurr(variant(tvardata(source)));
  644. end;
  645. {$ifndef FPUNONE}
  646. operator :=(const source : olevariant) dest : tdatetime;{$ifdef SYSTEMINLINE}inline;{$endif}
  647. begin
  648. dest:=variantmanager.vartotdatetime(variant(tvardata(source)));
  649. end;
  650. {$endif}
  651. operator :=(const source : olevariant) dest : terror;{$ifdef SYSTEMINLINE}inline;{$endif}
  652. begin
  653. dest:=variantmanager.vartoint(variant(tvardata(source)));
  654. end;
  655. {**********************************************************************
  656. to OLEVariant assignments
  657. **********************************************************************}
  658. operator :=(const source : byte) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  659. begin
  660. variantmanager.olevarfromint(dest,source,1);
  661. end;
  662. operator :=(const source : shortint) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  663. begin
  664. variantmanager.olevarfromint(dest,source,-1);
  665. end;
  666. operator :=(const source : word) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  667. begin
  668. variantmanager.olevarfromint(dest,source,2);
  669. end;
  670. operator :=(const source : smallint) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  671. begin
  672. variantmanager.olevarfromint(dest,source,-2);
  673. end;
  674. operator :=(const source : dword) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  675. begin
  676. variantmanager.olevarfromint(dest,source,4);
  677. end;
  678. operator :=(const source : longint) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  679. begin
  680. variantmanager.olevarfromint(dest,source,-4);
  681. end;
  682. operator :=(const source : qword) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  683. begin
  684. variantmanager.olevarfromint(dest,source,8);
  685. end;
  686. operator :=(const source : int64) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  687. begin
  688. variantmanager.olevarfromint(dest,source,-8);
  689. end;
  690. { Boolean }
  691. operator :=(const source : boolean) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  692. begin
  693. variantmanager.varfromBool(variant(tvardata(dest)),Source);
  694. end;
  695. operator :=(const source : wordbool) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  696. begin
  697. variantmanager.varfromBool(variant(tvardata(Dest)),Source);
  698. end;
  699. operator :=(const source : longbool) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  700. begin
  701. variantmanager.varfromBool(variant(tvardata(Dest)),Source);
  702. end;
  703. { Chars }
  704. operator :=(const source : char) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  705. begin
  706. variantmanager.olevarfrompstr(dest,source);
  707. end;
  708. operator :=(const source : widechar) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  709. begin
  710. variantmanager.varfromwstr(variant(tvardata(dest)),source);
  711. end;
  712. { Strings }
  713. operator :=(const source : shortstring) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  714. begin
  715. variantmanager.olevarfrompstr(dest,source);
  716. end;
  717. operator :=(const source : ansistring) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  718. begin
  719. variantmanager.olevarfromlstr(dest,source);
  720. end;
  721. operator :=(const source : widestring) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  722. begin
  723. variantmanager.varfromwstr(variant(tvardata(dest)),source);
  724. end;
  725. {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
  726. operator :=(const source : UnicodeString) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  727. begin
  728. variantmanager.varfromwstr(variant(tvardata(dest)),source);
  729. end;
  730. {$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
  731. { Floats }
  732. {$ifdef SUPPORT_SINGLE}
  733. operator :=(const source : single) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  734. begin
  735. variantmanager.varfromreal(variant(tvardata(dest)),source);
  736. end;
  737. {$endif SUPPORT_SINGLE}
  738. {$ifdef SUPPORT_DOUBLE}
  739. operator :=(const source : double) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  740. begin
  741. variantmanager.varfromreal(variant(tvardata(dest)),source);
  742. end;
  743. {$endif SUPPORT_DOUBLE}
  744. {$ifdef SUPPORT_EXTENDED}
  745. operator :=(const source : extended) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  746. begin
  747. variantmanager.varfromreal(variant(tvardata(dest)),source);
  748. end;
  749. {$endif SUPPORT_EXTENDED}
  750. {$ifdef SUPPORT_COMP}
  751. operator :=(const source : comp) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  752. begin
  753. variantmanager.varfromreal(variant(tvardata(dest)),source);
  754. end;
  755. {$endif SUPPORT_COMP}
  756. {$ifndef VER2_0}
  757. {$ifndef FPUNONE}
  758. operator :=(const source : real) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  759. begin
  760. variantmanager.varfromreal(variant(tvardata(dest)),source);
  761. end;
  762. {$endif}
  763. {$endif VER2_0}
  764. { Misc. }
  765. operator :=(const source : currency) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  766. begin
  767. variantmanager.varfromcurr(variant(tvardata(dest)),source);
  768. end;
  769. {$ifndef FPUNONE}
  770. operator :=(const source : tdatetime) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  771. begin
  772. variantmanager.varfromtdatetime(variant(tvardata(dest)),source);
  773. end;
  774. {$endif}
  775. operator :=(const source : terror) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  776. begin
  777. variantmanager.olevarfromint(dest,source,-sizeof(terror));
  778. end;
  779. function Unassigned: Variant; // Unassigned standard constant
  780. begin
  781. VarClearProc(TVarData(Result));
  782. TVarData(Result).VType := varempty;
  783. end;
  784. function Null: Variant; // Null standard constant
  785. begin
  786. VarClearProc(TVarData(Result));
  787. TVarData(Result).VType := varnull;
  788. end;
  789. {**********************************************************************
  790. Variant manager functions
  791. **********************************************************************}
  792. procedure GetVariantManager(var VarMgr: TVariantManager);
  793. begin
  794. VarMgr:=VariantManager;
  795. end;
  796. procedure SetVariantManager(const VarMgr: TVariantManager);
  797. begin
  798. VariantManager:=VarMgr;
  799. end;
  800. procedure initvariantmanager;
  801. begin
  802. end;
  803. Function Pos (c : Char; Const v : Variant) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  804. begin
  805. Result:=Pos(c,ShortString(v));
  806. end;
  807. Function Pos (s : ShortString; Const v : Variant) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  808. begin
  809. Result:=Pos(s,ShortString(v));
  810. end;
  811. Function Pos (a : AnsiString; Const v : Variant) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  812. begin
  813. Result:=Pos(a,AnsiString(v));
  814. end;
  815. Function Pos (w : WideString; Const v : Variant) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  816. begin
  817. Result:=Pos(w,WideString(v));
  818. end;
  819. {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
  820. Function Pos (w : UnicodeString; Const v : Variant) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  821. begin
  822. Result:=Pos(w,UnicodeString(v));
  823. end;
  824. {$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
  825. Function Pos (v : Variant; Const c : Char) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  826. begin
  827. Result:=Pos(ShortString(v),c);
  828. end;
  829. Function Pos (v : Variant; Const s : ShortString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  830. begin
  831. Result:=Pos(ShortString(v),s);
  832. end;
  833. Function Pos (v : Variant; Const a : AnsiString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  834. begin
  835. Result:=Pos(AnsiString(v),a);
  836. end;
  837. Function Pos (v : Variant; Const w : WideString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  838. begin
  839. Result:=Pos(WideString(v),w);
  840. end;
  841. {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
  842. Function Pos (v : Variant; Const w : UnicodeString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  843. begin
  844. Result:=Pos(UnicodeString(v),w);
  845. end;
  846. {$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
  847. Function Pos (v1 : Variant; Const v2 : Variant) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  848. begin
  849. Result:=Pos(WideString(v1),WideString(v2));
  850. end;