jmmath.pas

Delphi实现的RSA算法源码

(*
   Funktionen, auf die Jaochim Mohr in seinen Programmen
   nicht mehr verzichten m鯿hte.
   (c) Joachim Mohr, Rottenburg am Neckar

   Die Unit darf frei in nichtkommerziellen Programmen verwendet
   werden, wenn der CopyRight-Vermerk nicht entfernt wird.
   Kritik, Anregungen, Verbesserungsvorschl鋑e bitte an

   [e-mail]
*)

unit jmMath;

interface

const
  g_eps = 1E-15;

function TermToReal(s: string; x: extended): extended; overload;
function TermToReal(s: string): extended; overload;
function TermToRealTolerant(const s: string): extended;
function ReellZuBruch(const q: extended): string;
function ReellZuGemZahl(const q: extended): string;
function AlsWurzeloderPi(x: extended): string;
function loeseLGS2(a1, b1, c1, a2, b2, c2: extended;
  var x1, x2: extended): boolean; //=true bei eindeutiger L鰏ung
function loeseLGS3(a1, b1, c1, d1, a2, b2, c2, d2, a3, b3, c3, d3: extended;
  var x1, x2, x3: extended; var mathError: string): boolean; //=true bei Erfolg
//------- Hifsfunktionen -------------
function gaussKl(x: extended): extended; //=Gaus'sche Klammerfunktion
function log10tol(z: extended): extended; //Toleranter 10-er Logarithmus
function min(a, b: Extended): Extended; overload;
function max(a, b: Extended): Extended; overload;
function min(a, b: Integer): Integer; overload;
function max(a, b: Integer): Integer; overload;
function ArcTan2(Y, X: Extended): Extended;
function ArcCos(X: Extended): Extended;
function ArcSin(X: Extended): Extended;
function ggtReal(a, b: Extended): Extended;
function Primzahl_(x: extended): Integer; //= die x.te Primzahl
function IstInteger(const x: extended; eps_Genauigkeit: extended): boolean;
  //z.B. x=2,000..0001 x=1,999..9
function HochReal(x, y: Extended): Extended;
function bruch_(r: extended; MaxNennerStellen, stellen: integer;
  LeerWennKeinBruch,
  AuchUnecht: boolean): string;

implementation

uses jmhilf, controls, dialogs, sysutils;

var
  AnzahlDerPrimzahlenBisher: integer;
  Primzahlen: array of integer;

//Allgemeine Funktionen

procedure raiseEMathErrorcreate(s: string);
begin
  raise EMathError.create('Fehler:' + s);
end;

function ohneLeerzeichenf(const s: string): string;
var
  n: integer;
begin
  result := s;
  repeat
    n := pos(' ', result);
    if n > 0 then
      result := copy(result, 1, n - 1) + copyab(result, n + 1)
  until n = 0;
end;

//----------- im Parser vorkommende Funktionen -----------------

function hoch(const x: extended; n: integer): extended; //x^n  n El Z
begin
  if n < 0 then
    result := 1 / hoch(x, -n)
  else {//x^n=1/x^(-n) f黵 n<0} if n = 0 then
      result := 1
    else
      result := x * hoch(x, n - 1) //rekursiv
end;

function ArcTan2(Y, X: Extended): Extended;
asm
        FLD     Y
        FLD     X
        FPATAN
        FWAIT
end;

function ArcCos(X: Extended): Extended;
begin
  Result := ArcTan2(Sqrt(1 - X * X), X);
end;

function ArcSin(X: Extended): Extended;
begin
  Result := ArcTan2(X, Sqrt(1 - X * X))
end;

procedure findenaechstePrimzahl; //Hilsfunktion zu Primzahl_(x)
var
  groesstePZ: integer;
  function hatKeineTeiler: boolean; //Versuch, ob groesstePrimzahl wirklich PZ ist, d.h.
              //nicht durch bisherige PZ geteilt werden kann
              //Pr黤ung:primzahl[j] Teiler von GroesstePrimzahl?  bis
              //        primzahl[j]>Wurzel(groesstePrimzahl) <beide hoch zwei ... s.u.

  var
    j: integer;
  begin
    result := true; //falls bis zur Wurzel alle Primzahlen durchprobiert
    for j := 1 to AnzahlDerPrimzahlenBisher do
    begin //ist 3,5,7 ... Teiler
      if groesstePZ < primzahlen[j] * primzahlen[j] then exit;
      if groesstePZ = (GroesstePZ div primzahlen[j]) * primzahlen[j] then
      begin result := false;
        exit
      end; //Teiler gefunden
    end;
  end;
begin
  groesstePZ := primzahlen[AnzahlDerPrimzahlenBisher]; //Gr鲞te bisher gefundene PZ
  repeat
    inc(groesstePZ, 2); //Eine noch groesserPZ wird gesucht, evl. PZ-Zwilling
  until hatkeineTeiler;
  inc(AnzahlDerPrimzahlenBisher); //Jetzt gibt's eine PZ mehr
  if length(primzahlen) <= AnzahlDerPrimzahlenBisher + 1 then
    setlength(primzahlen, AnzahlDerPrimzahlenBisher + 500); //dyn Array
  primzahlen[AnzahlDerPrimzahlenBisher] := groesstePZ; //Neue gr鲞te PZ
end;

function Primzahl_(x: extended): integer; //= die x.te Primzahl
begin
  if x < 1 then
    result := 1
  else
  begin
    while round(x) - 1 > AnzahlDerPrimzahlenBisher do
      findenaechstePrimzahl;
    result := primzahlen[round(x) - 1]
  end;
end;

function asn(x: extended): extended; //arcsin
begin
  result := 0;
  if abs(x - 1) < 1E-15 then
    result := pi / 2
  else {//asn(1)=Pi/2} if abs(x + 1) < 1E-15 then
      result := -Pi / 2
    else {//asn(-1)=-Pi/2} if x * x < 1 then
        result := arcsin(x) //siehe unit tttmath
      else
        raiseEMathErrorcreate('asn' + FloatToStr(x))
end;

function acs(x: extended): extended; //Arccos
begin
  result := 0;
  if abs(x - 1) < 1E-15 then
    result := 0
  else if abs(x + 1) < 1E-15 then
    result := Pi
  else if x * x < 1 then
    result := arcCos(x) //siehe unit tttmath
  else
    raiseEMathErrorcreate('asn' + floatToStr(x))
end;

function tan(x: extended): extended;
begin
  result := 0;
  if cos(x) <> 0 then
    tan := sin(x) / cos(x)
  else
    raiseEMathErrorcreate('tan' + FloatToStr(x))
end;

function wurzel(x: extended): extended;
begin
  result := 0;
  if x >= 0 {//nicht negativ bis auf Rundungsfehler} then
    result := sqrt(x)
  else if x >= -1E-15 then
    result := 0
  else
    raiseEMathErrorcreate('sqr' + floatToStr(x))
end;

//----------------- Es folgt ein Parser ---------------------

function TermToReal(s: string; x: extended): extended; overload; //rekursiv!
                                  // s beliebiger Term ohne wissensch Not
                                  // d.h. 1E-17 nicht erlaubt
var
  u, v, p, q: string;
  function e(c: char): boolean; //falls m鰃lich wird s zerlegt in s=u+c+v
            //z.B. s=(5+4)*(3+2) Bei c='+' wird u=(5+4) und v=(3+2). Dann e=true
            //    Bei c='*' wird wegen der Klammern e=false
  var
    i, k: integer;
  begin k := 0; // k z鋒lt die Klammern
    i := length(s) + 1;
    repeat dec(i);
      if s[i] = ')' then inc(k);
      if s[i] = '(' then
        k := pred(k)
    until (i = 1) or ((k = 0) and (s[i] = c));
    if i = 1 then
    begin
      if k <> 0 then
        raiseEMathErrorcreate(s + '|' + floatToStr(k) + ' Klammern zu viel!');
      result := false
    end
    else
    begin
      result := true;
      u := copy(s, 1, i - 1);
      v := copyab(s, i + 1)
    end
  end;
begin
  result := 0;
  s := OhneLeerzeichenf(s);
  u := copy(s, 1, 3);
  v := copyab(s, 4);
  p := copy(s, 1, 2);
  q := copyab(s, 3);
  if s = '' then
  begin result := 0;
    exit
  end;
  if s[1] = '-' then s := '0' + s; //zB. s='-7/3x+14' -> s='0-7/3x+14'
  try {*****}
 {Punkt- vor Strichrechnung und vor Potenzen}
    if e('+') then
      result := TermToReal(u, x) + TermToReal(v, x)
    else if e('-') then
      result := TermToReal(u, x) - TermToReal(v, x)
    else if e('*') then
      result := TermToReal(u, x) * TermToReal(v, x)
    else if e('