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