variant.inc 31 KB

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