2
0

variant.inc 30 KB

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