variant.inc 29 KB

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