variant.inc 30 KB

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