variant.inc 30 KB

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