jmhilf.pas

Delphi实现的RSA算法源码

unit jmhilf;

interface

function char_(const s: string; const k: integer): char; //Tolerantes s[k]
function char_last(const s: string): char; //Das letzte Zeichen
function copyab(const s: string; const i: integer): string; //Rest von s ab i. em Zeichen
function pos_n(const a: string; b: string; n: integer): integer; //a in b an n-ter Stelle
procedure kup(var s: string); overload;
procedure kup(var s: string; anzahl: integer); overload;
function ohneLeerzeichenf(const s: string): string;
procedure ErsetzteAdurchBInS(const a, b: string; var s: string);
function spacesf(n: integer): string; //n Leerzeichen
function glSpf(s: string): boolean; //Ist s='' oder ' ' oder '  ' ... kurz: s gleich Spaces?
function wort_n(const s: string; const n: integer): string;
function ii(s: string): integer; //Alle vorkommenden Zahlen werden gelesen
function rr(s: string): Extended; //Tolerantes StrToFlaot
function rr_(s: string; n: integer): extended; //Die n.te reelle Zahl in s
  //Trennung Leerzeichen oder "|"
function rr_Kl(s: string; i: integer): extended; //Klammer wird eliminiert
function IntMitSpaces(n: string): string;
function ssd_(x: extended; geltZiffern: integer): string; //FloatToStr gerundet
function ssd(x: extended; geltZiffern: integer): string; //z.B. "12345.123456" -> "12 345,123 456"

implementation

uses windows, //F黵 DWord
  sysutils, //F黵 Decimalseparator
     //Unitinput,
  jmmath; //F黵 ii(s), rr(s)

function char_(const s: string; const k: integer): char;
begin if (k <= 0) or (k > length(s)) then
    result := ' '
  else
    result := s[k]
end;

function char_last(const s: string): char;
begin result := char_(s, length(s))
end;

function copyab(const s: string; const i: integer): string; //Rest von s ab i. em Zeichen
begin result := copy(s, i, length(s) - i + 1)
end;

function pos_n(const a: string; b: string; n: integer): integer;
var
  k: integer;
begin
  if n < 1 then
  begin result := 0;
    exit
  end; //Sollte nicht vorkommen
  if n = 1 then
    result := pos(a, b)
  else
  begin
    k := pos(a, b);
    if k = 0 then
      result := 0
    else
    begin
      b := copyab(b, k + 1);
      result := pos_n(a, b, n - 1); //rekursiv
      if result > 0 then result := k + result;
    end;
  end;
end;

procedure kup(var s: string); overload;
begin s := copy(s, 1, length(s) - 1)
end;

procedure kup(var s: string; anzahl: integer); overload;
begin
  kup(s);
  if Anzahl > 1 then kup(s, Anzahl - 1); //rekursiv
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;

procedure ohneAnfangstext(var s: string); //und ohne zwei Leerzeichen bis auf z.B.
                                         // '-      4 695' siehe ttted Addtiere
var
  i: integer;
begin
  i := 1;
  while (i <= length(s)) and not (s[i] in ['+', '-', '0'..'9']) do
    inc(i);
  s := copyab(s, i);
  while (length(s) > 1) and (s[1] in ['+', '-']) and (s[2] = ' ') do
    s := s[1] + copyab(s, 3); //z.b. s='-      4 695' -> s='-4 695';
    //Ein Space erlaubt, mehr nicht
  if pos('  ', s) > 0 then s := copy(s, 1, pos('  ', s) - 1);
  s := ohneLeerzeichenf(s);
end;

procedure OhneEndText(var s: string); //und ohne zwei Vorzeichen //lokal
var
  i: integer;
begin
  i := 2;
  while (i <= length(s)) and (s[i] in [DecimalSeparator, '0'..'9', 'E']) do
    inc(i);
  s := copy(s, 1, i - 1);
    //Keine zwei Vorzeichen
  if pos('+', s) > 1 then s := copy(s, 1, pos('+', s) - 1);
  if pos('-', s) > 1 then s := copy(s, 1, pos('-', s) - 1);
  if s = '' then
    s := '0'
end;

procedure keineZweiPunkteIn(var s: string); //lokal
var
  q: string;
  n, m: integer;
begin
  n := pos(Decimalseparator, s);
  if n > 0 then
  begin q := copyab(s, n + 1);
    m := pos(Decimalseparator, q);
    if m > 0 then
      s := copy(s, 1, n + m - 1)
  end;
end;

procedure KommaZuPunkt(var s: string); //lokal
var
  Punkt, Komma: char;
begin
  punkt := DecimalSeparator;
  if Punkt = '.' then
    Komma := ','
  else
    Komma := '.';
  if pos(komma, s) > 0 then
    s[pos(komma, s)] := punkt
end;

procedure ErsetzteAdurchBInS(const a, b: string; var s: string);
var
  rest: string; //a='' erlaubt ?
  k: integer;
begin
  k := pos(a, s);
  if k > 0 then
  begin
    rest := copyab(s, k + length(a));
    ErsetzteAdurchBInS(a, b, rest); //rekursiv
    s := copy(s, 1, k - 1) + b + rest;
  end;
end;

function spacesf(n: integer): string; //n beliebig !
const
  s = '                                                                                ';
           //80 spaces
begin
  result := copy(s, 1, n);
  while length(result) < n do
    result := result + copy(s, 1, n - length(result));
end;

function glSpf(s: string): boolean;
begin
  result := (s = spacesf(length(s)));
end;

function wort_n(const s: string; const n: integer): string;
var
  p: integer; //z.B. 'aaa bbb     ccc'; mindestens ein ' ' dazwischen
begin
  p := pos(' ', s);
  if p = 0 then
  begin
    if n > 1 then
      result := ''
    else
      result := trim(s);
  end
  else
  begin //p>0
    if n = 1 then
      result := trim(copy(s, 1, p - 1))
    else
      result := wort_n(trim(copyab(s, p + 1)), n - 1);
  end;
end;

function ii(s: string): integer; //Tolerantes StrToInt
var
  r: extended;
begin //z.B. 4.51->5
  r := rr(s);
  result := round(abs(r));
  if r < 0 then result := -result;
end;

function rr(s: string): Extended; //Tolerantes StrToFlaot
begin // z.B. s=' - 12 450.4968' oder s='a=-12,4' aber auch
        //      s='Es ergibt E= + 12.9', s='.... DANACH ERGIBT SICH E= - 12.3E-25'
  ohneAnfangstext(s);
  kommaZuPunkt(s);
  keinezweiPunkteIn(s);
    // jetzt z.B s='-12450.4968...'
  ohneEndText(s);
    //Flie遦ommazahl
  if pos('E', s) > 1 then
    if s[pos('E', s) - 1] in ['1'..'9'] then
    begin
      result := rr(copy(s, 1, pos('E', s) - 1)) * //rekursiv
        hochReal(10, ii(copyab(s, pos('E', s) + 1)));
      exit;
    end;
  if (length(s) = 1) and (s[1] in ['+', '-']) then
    result := 0
  else
    result := strToFloat(s)
end;

function rr_(s: string; n: integer): extended; //Trennung Leerzeichen oder "|" oder Sonderzeichen (TTWein)
var
  i1, i2, i: integer;
begin
  while (s > '') and not (s[1] in
    ['(', ')', '0'..'9', '.', ',', '+', '-']) do
    s := copyab(s, 2);
  i1 := pos('|', s); //siehe LGS und "zeichne" z.B. A(4|5|-2)
  i2 := pos(' ', s);
  i := maxint; //magic
  if i1 > 0 then i := i1;
  if (i2 > 0) and (i2 < i) then i := i2;
  if i = maxint then
  begin
    if n > 1 then
      result := 0
    else
      result := TermToRealTolerant(s);
  end
  else
  begin
    if n > 1 then
      result := rr_(copyab(s, i + 1), n - 1) //rekursiv
    else
      result := TermToRealTolerant(copy(s, 1, i - 1));
  end;
end;

function rr_Kl(s: string; i: integer): extended;
var
  k: integer;
begin
  for k := 2 to length(s) do
  begin
    if s[k] = '(' then
    begin s[k - 1] := ' ';
      s[k] := ' '
    end;
    if s[k] = ')' then
      s[k] := ' '
  end;
  result := rr_(s, i)
end;

function ssd_(x: extended; geltZiffern: integer): string;
const
  a = '##################'; //18
begin
  try
    if isTinteger(x, 1E-18) then
      result := IntToStr(round(abs(x)))
    else
    begin
      if trim(FormatFloat('.' + copy(a, 1, geltZiffern), frac(abs(x)))) = '1' then
        result := trim(IntToStr(trunc(abs(x) + 1)))
      else
        result := trim(IntToStr(trunc(abs(x)))) +
          trim(FormatFloat('.' + copy(a, 1, geltZiffern), frac(abs(x))));
    end;
    if char_(result, 1) = Decimalseparator then result := '0' + result;
    if x < 0 then result := '-' + result;
  except result := FloatToStr(x)
  end;
  if pos('E', result) > 0 then result := FloatToStr(x);
end;

function IntMitSpaces(n: string): string;
var
  k, len: integer;
begin
  result := '';
  len := length(n);
  if len = 0 then exit;
  for k := 1 to len - 1 do
  begin
    result := result + n[k];
    if ((len - k) mod 3) = 0 then result := result + ' ';
  end;
  result := result + n[len];
end;

function ssd(x: extended; geltZiffern: integer): string;
const
  a = '### ### ### ### ### ### ##'; //>=18
begin
  try
    if isTinteger(x, 1E-18) then
      result := IntMitSpaces(IntToStr(round(abs(x))))
    else
    begin
      if trim(FormatFloat('.' + copy(a, 1, geltZiffern), frac(abs(x)))) = '1' then
        result := trim(IntToStr(trunc(abs(x) + 1)))
      else
        result := trim(FormatFloat(a, trunc(abs(x)))) +
          trim(FormatFloat('.' + copy(a, 1, geltZiffern + geltZiffern div 3), frac(abs(x))));
    end;
    if char_(result, 1) = Decimalseparator then result := '0' + result;
    if x < 0 then result := '-' + result;
  except result := FloatToStr(x)
  end;
  if pos('E', result) > 0 then result := FloatToStr(x);
end;

end.