/newStructBase/units/phprpc/BigInt.pas

https://github.com/qriver/Delphi2010 · Pascal · 760 lines · 654 code · 60 blank · 46 comment · 88 complexity · d6d8b2a469ea5e40a47f1e9ddb782e30 MD5 · raw file

  1. {
  2. /**********************************************************\
  3. | |
  4. | The implementation of PHPRPC Protocol 3.0 |
  5. | |
  6. | BigInt.pas |
  7. | |
  8. | Release 3.0.2 |
  9. | Copyright by Team-PHPRPC |
  10. | |
  11. | WebSite: http://www.phprpc.org/ |
  12. | http://www.phprpc.net/ |
  13. | http://www.phprpc.com/ |
  14. | http://sourceforge.net/projects/php-rpc/ |
  15. | |
  16. | Authors: Ma Bingyao <andot@ujn.edu.cn> |
  17. | |
  18. | This file may be distributed and/or modified under the |
  19. | terms of the GNU General Public License (GPL) version |
  20. | 2.0 as published by the Free Software Foundation and |
  21. | appearing in the included file LICENSE. |
  22. | |
  23. \**********************************************************/
  24. /* BigInteger Variant Type
  25. *
  26. * Copyright: Ma Bingyao <andot@ujn.edu.cn>
  27. * Version: 3.0.2
  28. * LastModified: Oct 30, 2009
  29. * This library is free. You can redistribute it and/or modify it under GPL.
  30. */
  31. }
  32. unit BigInt;
  33. {$I PHPRPC.inc}
  34. interface
  35. uses Types;
  36. type
  37. TRadix = 2..36;
  38. { BigInteger variant creation utils }
  39. function VarBi: TVarType;
  40. function Zero: Variant;
  41. function One: Variant;
  42. procedure BigInteger(var V: Variant; const I: Int64); overload;
  43. function BigInteger(const I: Int64): Variant; overload;
  44. procedure BigInteger(var V: Variant; const S: string); overload;
  45. function BigInteger(const S: string): Variant; overload;
  46. function PowMod(var X, Y, Z: Variant): Variant; overload;
  47. function Rand(BitNumber: Integer; SetHighBit: Boolean): Variant;
  48. function BigIntToBinStr(const V: Variant): AnsiString;
  49. function BinStrToBigInt(const S: AnsiString): Variant;
  50. function BigIntToString(const V: Variant; Radix: TRadix = 10): AnsiString;
  51. implementation
  52. uses Variants, SysUtils, StrUtils, Math;
  53. type
  54. PLongWordArray = ^TLongWordArray;
  55. TLongWordArray = array [0..$7FFFFFF] of LongWord;
  56. TBiVarData = packed record
  57. VType: TVarType;
  58. Reserved1, Reserved2, Reserved3: Word;
  59. VData: PLongWordArray;
  60. VLength: LongInt;
  61. end;
  62. TBiVariantType = class(TCustomVariantType)
  63. public
  64. procedure Clear(var V: TVarData); override;
  65. function IsClear(const V: TVarData): Boolean; override;
  66. procedure Copy(var Dest: TVarData; const Source: TVarData;
  67. const Indirect: Boolean); override;
  68. procedure Cast(var Dest: TVarData; const Source: TVarData); override;
  69. procedure CastTo(var Dest: TVarData; const Source: TVarData;
  70. const AVarType: TVarType); override;
  71. procedure BinaryOp(var Left: TVarData; const Right: TVarData;
  72. const Op: TVarOp); override;
  73. procedure Compare(const Left, Right: TVarData;
  74. var Relationship: TVarCompareResult); override;
  75. end;
  76. var
  77. BiVariantType: TBiVariantType = nil;
  78. const
  79. CharacterSet: AnsiString = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  80. function ZeroFill(const S: string; N: Integer): string;
  81. var
  82. L: Integer;
  83. begin
  84. L := N - Length(S);
  85. if L > 0 then Result := StringOfChar('0', L) + S else Result := S;
  86. end;
  87. procedure SetLength(var V: TBiVarData; Count: Integer);
  88. begin
  89. ReallocMem(V.VData, SizeOf(LongWord) * Count);
  90. if Count > V.VLength then
  91. FillChar(V.VData[V.VLength], SizeOf(LongWord) * (Count - V.VLength), 0);
  92. V.VLength := Count;
  93. end;
  94. procedure FixLength(var V: TBiVarData);
  95. begin
  96. while (V.VLength > 1) and (V.VData[V.VLength - 1] = 0) do Dec(V.VLength);
  97. end;
  98. procedure Add(var A: TBiVarData; B: Word); overload;
  99. var
  100. I: Integer;
  101. begin
  102. FixLength(A);
  103. Inc(A.VData[0], B);
  104. if A.VData[0] > $FFFF then begin
  105. I := 0;
  106. if (A.VLength = 1) or (A.VData[A.VLength - 1] = $FFFF) then
  107. SetLength(A, A.VLength + 1);
  108. repeat
  109. A.VData[I] := A.VData[I] and $FFFF;
  110. Inc(I);
  111. Inc(A.VData[I]);
  112. until A.VData[I] <= $FFFF;
  113. FixLength(A);
  114. end;
  115. end;
  116. procedure Add(var A, B: TBiVarData); overload;
  117. var
  118. AL, BL, I, L, N: Integer;
  119. begin
  120. FixLength(A);
  121. FixLength(B);
  122. AL := A.VLength;
  123. BL := B.VLength;
  124. L := Max(AL, BL) + 1;
  125. SetLength(A, L);
  126. for I := 0 to Min(AL, BL) - 1 do Inc(A.VData[I], B.VData[I]);
  127. if AL < BL then
  128. for I := AL to BL - 1 do A.VData[I] := B.VData[I];
  129. I := 0;
  130. N := 0;
  131. while (I < L - 1) do begin
  132. if (A.VData[I] > $FFFF) then begin
  133. A.VData[I] := A.VData[I] and $FFFF;
  134. N := I + 1;
  135. Inc(A.VData[N]);
  136. end;
  137. Inc(I);
  138. end;
  139. if N = L - 1 then A.VLength := L else A.VLength := L - 1;
  140. end;
  141. procedure Mul(var A: TBiVarData; B: Word); overload;
  142. var
  143. Temp: LongWord;
  144. I: Integer;
  145. begin
  146. FixLength(A);
  147. if B = 0 then begin
  148. SetLength(A, 1);
  149. A.VData[0] := 0;
  150. Exit;
  151. end;
  152. if B = 1 then Exit;
  153. SetLength(A, A.VLength + 1);
  154. Temp := A.VData[0];
  155. A.VData[0] := 0;
  156. for I := 0 to A.VLength - 2 do begin
  157. Inc(A.VData[I], Temp * B);
  158. Temp := A.VData[I + 1];
  159. A.VData[I + 1] := A.VData[I] shr 16;
  160. A.VData[I] := A.VData[I] and $FFFF;
  161. end;
  162. FixLength(A);
  163. end;
  164. procedure Mul(var A, B: TBiVarData); overload;
  165. var
  166. R: PLongWordArray;
  167. L, I, J, K: Integer;
  168. begin
  169. FixLength(A);
  170. FixLength(B);
  171. if B.VLength = 1 then begin
  172. Mul(A, B.VData[0]);
  173. Exit;
  174. end;
  175. L := A.VLength + B.VLength;
  176. GetMem(R, SizeOf(LongWord) * L);
  177. FillChar(R^, SizeOf(LongWord) * L, 0);
  178. for I := 0 to A.VLength - 1 do for J := 0 to B.VLength - 1 do begin
  179. K := I + J;
  180. Inc(R[K], A.VData[I] * B.VData[J]);
  181. Inc(R[K + 1], R[K] shr 16);
  182. R[K] := R[K] and $FFFF;
  183. end;
  184. FreeMem(A.VData);
  185. A.VData := R;
  186. A.VLength := L;
  187. FixLength(A);
  188. end;
  189. function IntDivMod(var A: TBiVarData; B: Word): Word; overload;
  190. var
  191. R: LongWord;
  192. I: Integer;
  193. begin
  194. FixLength(A);
  195. if B = 0 then Error(reDivByZero);
  196. if B = 1 then begin
  197. Result := 0;
  198. Exit;
  199. end;
  200. R := 0;
  201. I := A.VLength;
  202. Dec(I);
  203. while I >= 0 do begin
  204. R := R shl 16;
  205. R := R or A.VData[I];
  206. A.VData[I] := R div B;
  207. R := R mod B;
  208. Dec(I);
  209. end;
  210. FixLength(A);
  211. Result := R;
  212. end;
  213. procedure LeftShift(var A: TBiVarData; B: Word);
  214. var
  215. W, X, C: Word;
  216. I, L: Integer;
  217. R: PLongWordArray;
  218. begin
  219. FixLength(A);
  220. // add one empty element for IntDivMod !
  221. if B = 0 then begin
  222. SetLength(A, A.VLength + 1);
  223. FixLength(A);
  224. Exit;
  225. end;
  226. W := B shr 4;
  227. B := B and 15;
  228. GetMem(R, SizeOf(LongWord) * (A.VLength + W + 1));
  229. FillChar(R^, SizeOf(LongWord) * (A.VLength + W + 1), 0);
  230. L := A.VLength;
  231. if B = 0 then
  232. Move(A.VData[0], R[W], SizeOf(LongWord) * L)
  233. else begin
  234. I := 0;
  235. C := 0;
  236. while I < L do begin
  237. X := A.VData[I];
  238. R[I + W] := Word(X shl B) or C;
  239. C := X shr (16 - B);
  240. Inc(I);
  241. end;
  242. R[I + W] := C;
  243. end;
  244. FreeMem(A.VData);
  245. A.VData := R;
  246. Inc(A.VLength, W + 1);
  247. FixLength(A);
  248. end;
  249. procedure RightShift(var A: TBiVarData; B: Word);
  250. var
  251. W, X, C: Word;
  252. L: Integer;
  253. R: PLongWordArray;
  254. begin
  255. FixLength(A);
  256. if B = 0 then Exit;
  257. W := B shr 4;
  258. B := B and 15;
  259. if W >= A.VLength then begin
  260. W := A.VLength - 1;
  261. B := 0;
  262. end;
  263. L := A.VLength - W;
  264. GetMem(R, SizeOf(LongWord) * L);
  265. FillChar(R^, SizeOf(LongWord) * L, 0);
  266. if B = 0 then
  267. Move(A.VData[W], R[0], SizeOf(LongWord) * L)
  268. else begin
  269. C := 0;
  270. Dec(L);
  271. while (L >= 0) do begin
  272. X := A.VData[L + W];
  273. R[L] := Word(X shr B) or C;
  274. C := X shl (16 - B);
  275. Dec(L);
  276. end;
  277. end;
  278. FreeMem(A.VData);
  279. A.VData := R;
  280. Dec(A.VLength, W);
  281. FixLength(A);
  282. end;
  283. function Compare(var A, B: TBiVarData): TVarCompareResult;
  284. var
  285. I: Integer;
  286. begin
  287. FixLength(A);
  288. FixLength(B);
  289. if A.VLength < B.VLength then Result := crLessThan
  290. else if A.VLength > B.VLength then Result := crGreaterThan
  291. else begin
  292. Result := crEqual;
  293. for I := A.VLength - 1 to 0 do begin
  294. if A.VData[I] < B.VData[I] then Result := crLessThan
  295. else if A.VData[I] > B.VData[I] then Result := crGreaterThan;
  296. end;
  297. end;
  298. end;
  299. procedure IntDivMod(var A, B: TBiVarData; out Q: TBiVarData); overload;
  300. var
  301. DP, NP, RP, RL, DL, I, P: Integer;
  302. T, S, Mask, Val: Word;
  303. Sum, B1, B2, D, QH, RH, MC: LongWord;
  304. begin
  305. if Compare(A, B) = crLessThan then begin
  306. Q.VType := A.VType;
  307. SetLength(Q, 1);
  308. Q.VData[0] := 0;
  309. Exit;
  310. end;
  311. if B.VLength = 1 then begin
  312. if Q.VType = VarBi then
  313. FreeMem(Q.VData)
  314. else
  315. Q.VType := VarBi;
  316. Q.VData := A.VData;
  317. Q.VLength := A.VLength;
  318. A.VData := nil;
  319. SetLength(A, 1);
  320. A.VData[0] := IntDivMod(Q, B.VData[0]);
  321. Exit;
  322. end;
  323. RL := A.VLength + 1;
  324. DL := B.VLength + 1;
  325. Mask := $8000;
  326. Val := B.VData[B.VLength - 1];
  327. S := 0;
  328. RP := A.VLength - B.VLength;
  329. while (Mask <> 0) and ((Val and Mask) = 0) do begin
  330. Inc(S);
  331. Mask := Mask shr 1;
  332. end;
  333. if Q.VType <> VarBi then begin
  334. Q.VType := VarBi;
  335. Q.VData := nil;
  336. Q.VLength := 0;
  337. end;
  338. SetLength(Q, A.VLength - B.VLength + 1);
  339. LeftShift(A, S);
  340. LeftShift(B, S);
  341. I := RL - B.VLength;
  342. P := RL - 1;
  343. B1 := B.VData[B.VLength - 1];
  344. B2 := B.VData[B.VLength - 2];
  345. while I > 0 do begin
  346. // maybe you will find P is out of range (P >= A.VLength),
  347. // but A has more elements than A.VLength (because of LeftShift) ,
  348. // so here is no mistake. it also appears in the following code.
  349. D := (A.VData[P] shl 16) + A.VData[P - 1];
  350. QH := D div B1;
  351. RH := D mod B1;
  352. repeat
  353. if (QH = $10000) or ((QH * B2) > ((RH shl 16) + A.VData[P - 2])) then begin
  354. Dec(QH);
  355. Inc(RH, B1);
  356. if (RH < $10000) then Continue;
  357. end;
  358. Break;
  359. until False;
  360. //
  361. // At this point, QH is either exact, or one too large
  362. // (more likely to be exact) so, we attempt to multiply the
  363. // divisor by QH, if we get a borrow, we just subtract
  364. // one from QH and add the divisor back.
  365. //
  366. DP := 0;
  367. NP := P - DL + 1;
  368. MC := 0;
  369. QH := QH and $FFFF;
  370. repeat
  371. Inc(MC, B.VData[DP] * QH);
  372. T := A.VData[NP];
  373. Dec(A.VData[NP], MC and $FFFF);
  374. A.VData[NP] := A.VData[NP] and $FFFF;
  375. MC := MC shr 16;
  376. if A.VData[NP] > T then Inc(MC);
  377. Inc(DP);
  378. Inc(NP);
  379. until DP >= DL;
  380. NP := P - DL + 1;
  381. DP := 0;
  382. // Overestimate
  383. if MC <> 0 then begin
  384. Dec(QH);
  385. Sum := 0;
  386. repeat
  387. Inc(Sum, A.VData[NP] + B.VData[DP]);
  388. A.VData[NP] := Sum and $FFFF;
  389. Sum := Sum shr 16;
  390. Inc(DP);
  391. Inc(NP);
  392. until DP >= DL;
  393. end;
  394. Q.VData[RP] := QH and $FFFF;
  395. Dec(RP);
  396. Dec(P);
  397. Dec(I);
  398. end;
  399. FixLength(Q);
  400. FixLength(A);
  401. if S <> 0 then RightShift(A, S);
  402. end;
  403. function BigIntToString(const V: Variant; Radix: TRadix): AnsiString;
  404. var
  405. T: Variant;
  406. R: Word;
  407. begin
  408. if V = Zero then
  409. Result := '0'
  410. else if V = One then
  411. Result := '1'
  412. else begin
  413. Result := '';
  414. T := V;
  415. while T <> Zero do begin
  416. R := IntDivMod(TBiVarData(T), Radix);
  417. Result := CharacterSet[R + 1] + Result;
  418. end;
  419. end;
  420. end;
  421. function VarBi: TVarType;
  422. begin
  423. Result := BiVariantType.VarType;
  424. end;
  425. function Zero: Variant;
  426. begin
  427. VarClear(Result);
  428. with TBiVarData(Result) do begin
  429. VType := VarBi;
  430. VData := nil;
  431. VLength := 0;
  432. SetLength(TBiVarData(Result), 1);
  433. end;
  434. end;
  435. function One: Variant;
  436. begin
  437. VarClear(Result);
  438. with TBiVarData(Result) do begin
  439. VType := VarBi;
  440. VData := nil;
  441. VLength := 0;
  442. SetLength(TBiVarData(Result), 1);
  443. VData[0] := 1;
  444. end;
  445. end;
  446. procedure BigInteger(var V: Variant; const I: Int64); overload;
  447. begin
  448. VarClear(V);
  449. with TBiVarData(V) do begin
  450. VType := VarBi;
  451. VData := nil;
  452. VLength := 0;
  453. if I > $FFFFFFFF then begin
  454. SetLength(TBiVarData(V), 4);
  455. VData[0] := I and $FFFF;
  456. VData[1] := (I shr 16) and $FFFF;
  457. VData[2] := (I shr 32) and $FFFF;
  458. VData[3] := (I shr 48) and $FFFF;
  459. if VData[3] = 0 then VLength := 3 else VLength := 4;
  460. end
  461. else if I > $FFFF then begin
  462. SetLength(TBiVarData(V), 2);
  463. VData[0] := I and $FFFF;
  464. VData[1] := (I shr 16) and $FFFF;
  465. VLength := 2;
  466. end
  467. else begin
  468. SetLength(TBiVarData(V), 1);
  469. VData[0] := I;
  470. VLength := 1;
  471. end;
  472. end;
  473. end;
  474. function BigInteger(const I: Int64): Variant; overload;
  475. begin
  476. BigInteger(Result, I);
  477. end;
  478. procedure BigInteger(var V: Variant; const S: string); overload;
  479. var
  480. I, SLen, ALen: Integer;
  481. Temp: string;
  482. begin
  483. BigInteger(V, 0);
  484. SLen := Length(S);
  485. Inc(SLen, 4 - (SLen mod 4));
  486. Temp := ZeroFill(S, SLen);
  487. ALen := SLen shr 2;
  488. for I := 0 to ALen - 1 do begin
  489. Mul(TBiVarData(V), 10000);
  490. Add(TBiVarData(V), StrToInt(MidStr(Temp, I shl 2 + 1, 4)));
  491. end;
  492. end;
  493. function BigInteger(const S: string): Variant; overload;
  494. begin
  495. BigInteger(Result, S);
  496. end;
  497. function PowMod(var X, Y, Z: Variant): Variant; overload;
  498. var
  499. A, B, C: Variant;
  500. N, I, J: Integer;
  501. Temp: LongWord;
  502. begin
  503. if VarType(X) = VarBi then A := X else VarCast(A, X, VarBi);
  504. if VarType(Y) = VarBi then B := Y else VarCast(B, Y, VarBi);
  505. if VarType(Z) = VarBi then C := Z else VarCast(C, Z, VarBi);
  506. with TBiVarData(B) do begin
  507. N := VLength;
  508. Result := One;
  509. for I := 0 to N - 2 do begin
  510. Temp := VData[I];
  511. for J := 0 to 15 do begin
  512. if (Temp and 1) <> 0 then Result := (Result * A) mod C;
  513. Temp := Temp shr 1;
  514. A := (A * A) mod C;
  515. end;
  516. end;
  517. Temp := VData[N - 1];
  518. while (Temp <> 0) do begin
  519. if (Temp and 1) <> 0 then Result := (Result * A) mod C;
  520. Temp := Temp shr 1;
  521. A := (A * A) mod C;
  522. end;
  523. end;
  524. end;
  525. function Rand(BitNumber: Integer; SetHighBit: Boolean): Variant;
  526. const
  527. LowBitMasks: array [0..15] of Word = ($0001, $0002, $0004, $0008,
  528. $0010, $0020, $0040, $0080,
  529. $0100, $0200, $0400, $0800,
  530. $1000, $2000, $4000, $8000);
  531. var
  532. I, R, Q: Integer;
  533. begin
  534. VarClear(Result);
  535. R := BitNumber mod 16;
  536. Q := BitNumber shr 4;
  537. with TBiVarData(Result) do begin
  538. VType := VarBi;
  539. VData := nil;
  540. VLength := 0;
  541. SetLength(TBiVarData(Result), Q + 1);
  542. for I := 0 to Q - 1 do VData[I] := Random($10000);
  543. if R <> 0 then begin
  544. VData[Q] := Random(LowBitMasks[R]);
  545. if SetHighBit then VData[Q] := VData[Q] or LowBitMasks[R - 1];
  546. end
  547. else begin
  548. VData[Q] := 0;
  549. if SetHighBit then VData[Q - 1] := VData[Q - 1] or $8000;
  550. end;
  551. end;
  552. FixLength(TBiVarData(Result));
  553. end;
  554. function BigIntToBinStr(const V: Variant): AnsiString;
  555. var
  556. N, I: Integer;
  557. begin
  558. with TBiVarData(V) do begin
  559. N := VLength;
  560. System.SetLength(Result, N * 2);
  561. for I := 0 to N - 1 do begin
  562. Result[(N - I) * 2] := AnsiChar(VData[I] and $FF);
  563. Result[(N - I) * 2 - 1] := AnsiChar((VData[I] shr 8) and $FF);
  564. end;
  565. end;
  566. end;
  567. function BinStrToBigInt(const S: AnsiString): Variant;
  568. var
  569. I, N: Integer;
  570. begin
  571. N := Length(S);
  572. if N = 0 then begin
  573. Result := Zero;
  574. Exit;
  575. end;
  576. VarClear(Result);
  577. with TBiVarData(Result) do begin
  578. VType := VarBi;
  579. VData := nil;
  580. VLength := 0;
  581. SetLength(TBiVarData(Result), (N + 1) shr 1);
  582. I := N;
  583. while I > 1 do begin
  584. VData[VLength - ((I + 1) shr 1)] := (Ord(S[I - 1]) shl 8) or Ord(S[I]);
  585. Dec(I, 2);
  586. end;
  587. if Odd(N) then VData[VLength - 1] := Ord(S[1]);
  588. end;
  589. end;
  590. { TBiVariantType }
  591. procedure TBiVariantType.BinaryOp(var Left: TVarData;
  592. const Right: TVarData; const Op: TVarOp);
  593. var
  594. TL, TR: TVarData;
  595. begin
  596. VarDataInit(TL);
  597. VarDataInit(TR);
  598. try
  599. VarDataCopy(TL, Left);
  600. VarDataCopy(TR, Right);
  601. case Op of
  602. opAdd:
  603. Add(TBiVarData(Left), TBiVarData(TR));
  604. opMultiply:
  605. Mul(TBiVarData(Left), TBiVarData(TR));
  606. opDivide, opIntDivide:
  607. IntDivMod(TBiVarData(TVarData(TL)), TBiVarData(TVarData(TR)), TBiVarData(Left));
  608. opModulus:
  609. IntDivMod(TBiVarData(Left), TBiVarData(TVarData(TR)), TBiVarData(TVarData(TL)));
  610. opShiftLeft:
  611. LeftShift(TBiVarData(Left), TBiVarData(TR).VData[0]);
  612. opShiftRight:
  613. RightShift(TBiVarData(Left), TBiVarData(TR).VData[0]);
  614. else
  615. RaiseInvalidOp;
  616. end;
  617. finally
  618. VarDataClear(TL);
  619. VarDataClear(TR);
  620. end;
  621. end;
  622. procedure TBiVariantType.Cast(var Dest: TVarData;
  623. const Source: TVarData);
  624. var
  625. LTemp: TVarData;
  626. begin
  627. if VarDataIsStr(Source) then begin
  628. BigInteger(Variant(Dest), VarToStr(Variant(Source)));
  629. end
  630. else begin
  631. VarDataInit(LTemp);
  632. try
  633. VarDataCastTo(LTemp, Source, varInt64);
  634. BigInteger(Variant(Dest), LTemp.VInt64);
  635. finally
  636. VarDataClear(LTemp);
  637. end;
  638. end;
  639. end;
  640. procedure TBiVariantType.CastTo(var Dest: TVarData;
  641. const Source: TVarData; const AVarType: TVarType);
  642. var
  643. S: AnsiString;
  644. begin
  645. if Source.VType = VarType then begin
  646. S := BigIntToString(Variant(Source));
  647. case AVarType of
  648. varOleStr:
  649. VarDataFromOleStr(Dest, WideString(StringToOleStr(S)));
  650. varString{$IFDEF DELPHI2009_UP}, varUString{$ENDIF}:
  651. VarDataFromStr(Dest, string(S));
  652. else
  653. RaiseCastError;
  654. end
  655. end
  656. else
  657. RaiseCastError;
  658. end;
  659. procedure TBiVariantType.Clear(var V: TVarData);
  660. begin
  661. V.VType := varEmpty;
  662. FreeMem(TBiVarData(V).VData);
  663. TBiVarData(V).VData := nil;
  664. TBiVarData(V).VLength := 0;
  665. end;
  666. procedure TBiVariantType.Compare(const Left, Right: TVarData;
  667. var Relationship: TVarCompareResult);
  668. var
  669. L, R: TBiVarData;
  670. begin
  671. if (Left.VType = VarType) and (Right.VType = VarType) then begin
  672. L := TBiVarData(Left);
  673. R := TBiVarData(Right);
  674. Relationship := BigInt.Compare(L, R);
  675. end
  676. else RaiseInvalidOp;
  677. end;
  678. procedure TBiVariantType.Copy(var Dest: TVarData;
  679. const Source: TVarData; const Indirect: Boolean);
  680. begin
  681. if Indirect and VarDataIsByRef(Source) then
  682. VarDataCopyNoInd(Dest, Source)
  683. else
  684. VarDataClear(Dest);
  685. Dest.VType := VarType;
  686. TBiVarData(Dest).VLength := TBiVarData(Source).VLength;
  687. GetMem(TBiVarData(Dest).VData, SizeOf(LongWord) * TBiVarData(Dest).VLength);
  688. Move(TBiVarData(Source).VData^, TBiVarData(Dest).VData^, SizeOf(LongWord) * TBiVarData(Dest).VLength);
  689. end;
  690. function TBiVariantType.IsClear(const V: TVarData): Boolean;
  691. begin
  692. Result := (TBiVarData(V).VData = nil) and (TBiVarData(V).VLength = 0);
  693. end;
  694. initialization
  695. Randomize;
  696. BiVariantType := TBiVariantType.Create;
  697. finalization
  698. FreeAndNil(BiVariantType);
  699. end.