1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:

function IsPrimzahl(Zahl: Int64): Boolean;
begin
  Result := False;
  Teiler := 2;
  while Teiler <= Trunc(Sqrt(1.0 * Zahl)) do begin
        if Zahl mod Teiler = 0 then Exit
        else Inc(Teiler);
  end;
  Result := True;
end;

function PrimFaktorZerlegung (Zahl: Int64): String;
begin
  Teiler := 2;
  Result := '';
  while Zahl > 1 do begin
    if (Teiler > 2) and (Teiler mod 2 = 0) then Inc(Teiler);
    if IsPrimzahl(Zahl) = True then Teiler := Zahl;
    while (Zahl > 1) and (Zahl mod Teiler = 0) do begin
      Result := Result + IntToStr(Teiler) + ' * ';
      Zahl := Zahl div Teiler;
    end;
    Inc(Teiler);
  end;
  SetLength(Result, Length(Result) - 3);
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:

procedure TForm1.B_BerechneClick(Sender: TObject);
begin
  Z_Begin := GetTickCount;                                                      
  Prim := 'Die Zahl setzt sich aus folgenden Primfaktoren zusammen: ';

  try Zahl := StrToInt64(E_Ausgabe.Text);
  except
    on EConvertError do begin
       Messagebox(Handle, 'Eingabefehler - Zahl zu groß/klein oder ungültige Zeichen!', 'Fehler', MB_OK or 16);
       E_Ausgabe.SetFocus;
       Exit;
    end;
  end;

  if Zahl < 2 then begin
     Messagebox(Handle, 'Eingabefehler - Zahl muss größer als eins sein.', 'Fehler', MB_OK or 16);
     Exit;
  end;

  if IsPrimzahl(Zahl) = False then Prim := Prim + PrimFaktorZerlegung(Zahl);

  Z_Ende := GetTickCount;                                                       

  Memo1.Lines.Add(Prim);
  Memo1.Lines.Add('Diese Berechnung dauerte ' + FloatToStr(Z_Ende - Z_Begin) + 'ms!'); 
  Memo1.Lines.Add('');

  E_Ausgabe.SetFocus;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:

function IsPrimzahl(Zahl: Int64): Boolean;
begin
  Result := False;
  Teiler := 3;
  if Zahl mod 2 = 0 then Exit;
  while Teiler <= Trunc(Sqrt(1.0 * Zahl)) do begin
        if Zahl mod Teiler = 0 then begin
           Teiler := 3;
           Exit;
        end
        else Inc(Teiler, 2);
  end;
  Result := True;
  Teiler := 3;
end;

function PrimFaktorZerlegung (Zahl: Int64): String;
begin
  Teiler := 3;
  Result := '';
  repeat
    if Zahl mod 2 = 0 then begin
       Result := Result + IntToStr(2) + ' * ';
       Zahl := Zahl div 2;
       if IsPrimzahl(Zahl) = True then Teiler := Zahl;
    end;
  until Zahl mod 2 > 0;

  while Zahl > 1 do begin

    while (Zahl > 1) and (Zahl mod Teiler = 0) do begin
      Result := Result + IntToStr(Teiler) + ' * ';
      Zahl := Zahl div Teiler;
      if IsPrimzahl(Zahl) = True then Teiler := Zahl;
    end;
    Inc(Teiler, 2);
  end;
  SetLength(Result, Length(Result) - 3);
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:

function PrimFaktorZerlegung (Zahl: Int64): String;  
begin  
  Teiler := 3;  
  Result := '';  
  repeat  
    if Zahl mod 2 = 0 then begin  
       Result := Result + IntToStr(2) + ' * ';  
       Zahl := Zahl div 2;  
       if IsPrimzahl(Zahl) = True then Teiler := Zahl;  
    end;  
  until Zahl mod 2 > 0;  

 
  while (Teiler<Zahl)AND(Zahl > 1) do begin  

 
     while (Teiler<Zahl) AND (Zahl mod Teiler = 0)do begin  
      Result := Result + IntToStr(Teiler) + ' * ';  
      Zahl := Zahl div Teiler;  
      // unnötig if IsPrimzahl(Zahl) = True then Teiler := Zahl;  
    end;  
    Inc(Teiler, 2);  
  end; 
 if not(zahl=1) then begin
//Primfaktoren.add(zahl);
end;
  SetLength(Result, Length(Result) - 3);  
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:

function PrimFaktorZerlegung (Zahl: Int64): String;  
begin  
  Teiler := 3;  
  Result := '';  
  repeat  
    if Zahl mod 2 = 0 then begin  
       Result := Result + IntToStr(2) + ' * ';  
       Zahl := Zahl div 2;  
       if IsPrimzahl(Zahl) = True then Teiler := Zahl;  
    end;  
  until Zahl mod 2 > 0;  

 if zahl >1 then begin
  while (Teiler<=Zahl) do begin  

 
     while (Teiler<=Zahl) AND (Zahl mod Teiler = 0)do begin  
      Result := Result + IntToStr(Teiler) + ' * ';  
      Zahl := Zahl div Teiler;  
      // unnötig if IsPrimzahl(Zahl) = True then Teiler := Zahl;  
    end;  
    Inc(Teiler, 2);  
  end; 
end;
   SetLength(Result, Length(Result) - 3);  
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:

function PrimFaktorZerlegung (Zahl: Int64): String;    
begin    
  Teiler := 3;    
  Result := '';    
  repeat    
    if Zahl mod 2 = 0 then begin    
       Result := Result + IntToStr(2) + ' * ';    
       Zahl := Zahl div 2;    
       if IsPrimzahl(Zahl) = True then Teiler := Zahl;    
    end;    
  until Zahl mod 2 > 0;    

 
 if zahl >1 then begin  
  while (Teiler<=trunc(SQRT(Zahl))) do begin    

 
   
     while (Teiler<=trunc(SQRT(Zahl)) AND (Zahl mod Teiler = 0)do begin    
      Result := Result + IntToStr(Teiler) + ' * ';    
      Zahl := Zahl div Teiler;    
      // unnötig if IsPrimzahl(Zahl) = True then Teiler := Zahl;    
    end;    
    Inc(Teiler, 2);    
  end;   
end;  
//dann jetzt aber doch 
if not(zahl=1) then begin
//zahl ist Primzahl also noch in den String dazuschreiben
end;
   SetLength(Result, Length(Result) - 3);    
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:

function PrimFaktorZerlegung (Zahl: Int64): String;    
var
    Root: Integer;
begin    
    Result := '';    

    While Zahl and 1 = 0 do
    Begin
       Result := Result + IntToStr(2) + ' * ';    
       Zahl := Zahl shr 1;    
    end;    

    if zahl >= 2 then 
    Begin
        Root := Trunc(SQRT(Zahl));
        Teiler := 3;

        while Teiler <= Root do 
        begin    
            while Zahl mod Teiler = 0 do 
            begin    
                Result := Result + IntToStr(Teiler) + ' * ';
                Zahl := Zahl div Teiler;
            end;
            Root := Trunc(SQRT(Zahl));
            Inc(Teiler, 2);    
        end;
    end;

    //dann jetzt aber doch 
    if zahl <> 1 then
    begin
        Raise Exception.Create('Kann nicht sein!!!');
    end;
    Delete(Result, Length(Result) - 2, 3);    
end;                    

1:
2:
3:
4:
5:

While Zahl and 1 = 0 do
    Begin
       Result := Result + IntToStr(2) + ' * ';    
       Zahl := Zahl shr 1;    
    end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:

function PrimFaktorZerlegung (Zahl: Int64): String;    
var
    Root: DWORD;
    Teiler : Int64;
begin    
    Result := '';    

    While Zahl and 1 = 0 do
    Begin
       Result := Result + IntToStr(2) + ' * ';    
       Zahl := Zahl shr 1;    
    end;    

    if zahl >= 2 then 
    Begin
        Teiler := 3;

        Root := Trunc(SQRT(1.0 * Zahl));
        
        while Zahl mod Teiler = 0 do 
        begin    
            Result := Result + IntToStr(Teiler) + ' * ';
            Zahl := Zahl div Teiler;
        end;
        Root := Trunc(SQRT(1.0 * Zahl));
        Inc(Teiler, 2);    

        while Teiler <= Root do 
        begin    
            while Zahl mod Teiler = 0 do 
            begin    
                Result := Result + IntToStr(Teiler) + ' * ';
                Zahl := Zahl div Teiler;
            end;
            Root := Trunc(SQRT(1.0 * Zahl));
            Inc(Teiler, 2);    

            while Zahl mod Teiler = 0 do 
            begin    
                Result := Result + IntToStr(Teiler) + ' * ';
                Zahl := Zahl div Teiler;
            end;
            Root := Trunc(SQRT(1.0 * Zahl));
            Inc(Teiler, 4);    
        end;
    end;

    //dann jetzt aber doch 
    if zahl <> 1 then
        Result := Result + IntToStr(Zahl) + ' * ';

    Delete(Result, Length(Result) - 2, 3);    
end;                    

1:
2:
3:
4:
5:
6:

                       1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 
             2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9
          1 +1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1
mod 2     1   +2| +2  +2  +2  +2  +2  +2  +2  +2  +2  +2  +2  +2  +2  +2  +2            : Anzahl 1(2-1)
mod 3     1       +4  +2|     +4  +2      +4  +2      +4  +2      +4  +2      +4        : Anzahl 2(2-1)*(3-1)
mod 5     1           +6  +2  +4  +2      +4  +2      +4          +6  +2|           +6  : Anzahl 8(2-1)*(3-1)*(5-1)                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:

const
  BIS           = 5;
  MAXIMUM       =100000000;
  Prim          :array [0..9] of byte = (2,3,5,7,11,13,17,19,23,29);
  {MAXANZAHL     =  2*3*5*7*11*13*17*19;*PRIM}
  MAXANZAHL     :array [0..8] of Longint =(2,6,30,210,2310,30030,
                                         510510,9699690,223092870);
  {WIFEMAXLAENGE =  1*2*4*6*10*12*16*18;*PRIM-1}
  WIFEMAXLAENGE :array [0..8] of longint =(1,2,8,48,480,5760,
                                         92160,1658880,36495360);
 {Anzahl der wirklichen PrimZahlen im Wiederholungsfeld}
  PRIMANZAHL    :array[0..8] of longint  =(1,3,12,48,345,3250,
                                         42333, 646029,12283531);
{ Die maximale Differenz die im Wiederholungsfeld  vorkommt}
  MAXMULLAENGE  = 22; {array [0..9] of byte= (2,4,6,10,14,22,26,34,40,50); 40,50 geraten}
                   {Auf  Mod 32 = 0 bringen}
  MAXSUCHE      = (((MAXIMUM div 231)*48-1)shr 5+1)shl 5; {MAXIMUM*WFEMAXLAENGE[BIS]/MAXANZAHl[BIS]}
                  {div2, div3,*4div15,*24div105,*48div231,*3072div17017...}
type
  toffset       = record
                     Sum,
                     Offs :longint;
                  end;
  tMulFeld    = array [2..MAXMULLAENGE] of tOffset;
  tZahlenFeld = array [0..{MAXANZAHL[BIS]-1}30030] of LongWOrd  ;
  tDiffFeld   = array [0..{WIFEMAXLAENGE[BIS]}5760-1] of byte;

  (* Zahlen feld als Bit array *)
  tSuchFeld   = array [0..MAXSUCHE shr 5+1] of set of 0..31;
var 
  ...
Begin
   WiFeLaenge := 1;
   MaxZahl := 2;
   DiffFeld[0] := 2;
   {Das Rad aufbauen}

for loop := 1 to bis do
   begin

   Diff := DiffFeld[0];
   Suchprim := Diff+1;

{   PrimFeld[Anzahl] := Suchprim;}
   inc(Anzahl);
   Write('>',MaxZahl:10,SuchPrim:10,'<');

   MaxZahl := MaxZahl*SuchPrim;
   WiFeLng_1 := WiFeLaenge-1;

  {Hintereinander Schreiben des neuen WiederholungsFeldes}
  {Dabei wird das WiederholungsFeld insgesamt SuchPrim div 2}
  {hintereinander geschrieben }
   offset := WiFeLAenge;
   for  i := 1 to Suchprim shr 1 do
   Begin
      move(DiffFeld[0],DiffFeld[Offset],WiFeLaenge*SizeOf(DiffFeld[0]));
      inc(offset,WiFeLaenge);
   end;{For i}

   {Vielfache heraustrennen}

   {Berechnen der Vielfachen}

   Summe := 1;
   j := WiFeLaenge shr 1;
   {Aber mindestens einer, der ist aber immer 1*Suchprim}
   If j <> 0 then dec(j);
   {Die Berechnung der Vielfachen}
   {Diese werden in dem DiffFeld von ober nach unten abgespeichert,}
   {da dieser Platz momentan nicht genutzt wird}
   For i := 0 to j do
   begin
      Zahlen[i] := Summe*SuchPrim;
      inc(Summe,DiffFeld[i]);
   end;
   Zahlen[j+1] := 0;

   {Die Vielfachen jetzt finden}
   Summe := 1;
   MulPos := 0;
   I := 0;
   J := 0;
  {Diff wird als Platzhalter der Vielfachen von Suchprim benutzt}
   Diff := Suchprim;
   {Bis zu welcher Summe gesucht werden muss}
   k := MaxZahl shr 1;
   while Summe < k do
   Begin
      inc(Summe,DiffFeld[i]);
      DiffFeld[j]:= DiffFeld[i];
      If Summe=Diff then
      Begin
         {Den naechsten Vielfachen hervorkramen}
         inc(MulPos);
         Diff := Zahlen[MulPos];
         {Den Vielfachen jetzt heraustrennen}
         inc(i);
         {Die neue Differenz eintrageen}
         inc(DiffFeld[j],DiffFeld[i]);
         {Die Summe korrigeren}
         inc(Summe,DiffFeld[i])
      end; {If}
      inc(i);
      inc(j);
   end; {WHILE}
   {Die neue Wiederholungsfeldlaenge}
   WiFelaenge := WiFeLaenge*(Suchprim-1);
   {Spiegeln}
   k :=  WiFelaenge shr 1-1;
   WiFeLng_1 := WiFeLaenge-2;
   For i := 0 to k do
      DiffFeld[WiFeLng_1-i] := DiffFeld[i];
   {Das letzte Feld ist immer 2}
   DiffFeld[WiFeLaenge-1] := 2;
end; {For Loop}                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:

TestZahl := EingabeZahl;
n=1;
Index := 0;
Grenze := trunc(Sqrt(TestZahl));
repeat
n := n+ diffFeld[Index];
IF TestZahl Mod n = 0 then
  begin
  Exp := 1;
  TestZahl := TestZahl div n; 
  while TestZahl mod n = 0 do
    begin
    inc(Exp);
    TestZahl := TestZahl div n; 
    end;
  write('*',n);
  If exp >1 then
    write('^',Exp);
  end;
inc(index);
If Index >=WIFEMAXLAENGE[BIS] then
   Index :=0;
until n > Grenze;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:

function PrimFaktorZerlegung (Zahl: Int64): String;    
var
    Root: Integer;
    Teiler : Int64;
begin    
    Result := '';    

    While Zahl and 1 = 0 do
    Begin
       Result := Result + '2 * ';    
       Zahl := Zahl shr 1;    
    end;    

    if zahl >= 2 then 
    Begin
        while Zahl mod 3 = 0 do 
        begin    
            Result := Result + '3 * ';
            Zahl := Zahl div 3;
        end;

        Root := Trunc(SQRT(1.0 * Zahl));
        Teiler := 5;

        while Teiler <= Root do 
        begin    
            while Zahl mod Teiler = 0 do 
            begin    
                Result := Result + IntToStr(Teiler) + ' * ';
                Zahl := Zahl div Teiler;
                Root := Trunc(SQRT(1.0 * Zahl));
            end;
            Inc(Teiler, 2);    

            while Zahl mod Teiler = 0 do 
            begin    
                Result := Result + IntToStr(Teiler) + ' * ';
                Zahl := Zahl div Teiler;
                Root := Trunc(SQRT(1.0 * Zahl));
            end;
            Inc(Teiler, 4);    
        end;
    end;

    //dann jetzt aber doch 
    if zahl <> 1 then
        Result := Result + IntToStr(Zahl) + ' * ';

    Delete(Result, Length(Result) - 2, 3);    
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:

var
  time : TdateTime;
  Test1,Test2,Test3: int64;
begin
  t := time;
  Test1 := cardinal(65537)*Cardinal(65531);
  Test1 := Test1*65517*32019;
  Test3 := 0;
 
  repeat
    inc(Test3);
    Test2 := Test1 mod Test3;
  until Test3 >= 10000000;
  t := time-t;
 
  writeln(Test3);
  writeln(Test2);
  writeln(Test1);
  writeln(FOrmatDateTime('hh:mm:ss.zzz ',t));
  writeln(Format('%e',[Test3/(t*86400)]));
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:

function PrimFaktorZerlegung (Zahl: Int64): String;
var
  Teiler,
  Root: Cardinal;
  Index : integer;
  begin
  Result := '';
  While Zahl and 1 = 0 do
    Begin
    Result := Result + IntToStr(2) + ' * ';
    Zahl := Zahl shr 1;
    end;
  {
   For Index := 0 to BIS do
     While Zahl Mod and Prim[Index] = 0 do
       Begin
       Result := Result + IntToStr(Prim[Index]) + ' * '; 
       Zahl := Zahl DIV Prim[index];
       end;
   }
  if zahl >= 2 then
    Begin
    Root := Trunc(SQRT(Zahl));
    Teiler := 1;
    Index := 0;
    repeat
      inc(Teiler,2);
      //inc(Teiler,DiffFeld[index]);
      IF Zahl mod Teiler = 0 then
        begin
        repeat
          Zahl := Zahl div Teiler;
          Result := Result + IntToStr(Teiler) + ' * ';
        until Zahl mod Teiler <> 0; 
        Root := Trunc(SQRT(Zahl));//Nur dann wenn sich wirklich was aendert
        end;
//      inc(index);
//      If index > High(DiffFeld) then  
//         index := 0;
    until Teiler > Root;
    end;
    //dann jetzt aber doch
    if zahl <> 1 then
      begin
      Result := Result + IntToStr(Zahl) + ' * ';;
      end;
    Delete(Result, Length(Result) - 2, 3);
end;                    

1:
2:

9223372036854775806  = 2 * 3 * 715827883 * 2147483647
00:01:22.796                    

1:
2:

9223372036854775806  = 2 * 3 * 715827883 * 2147483647
00:00:46.031 Sekunden                    

1:
2:
3:
4:
5:
6:
7:

Zu faktorisierende Zahl: 9223372036854775806
2
3
715827883
2147483647
Faktorisierung abgeschlossen!
Benötigte Zeit: 85,599047 s                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:

Program WheelCalc;

{$APPTYPE CONSOLE}

Uses
    Windows,
    SysUtils,
    Classes,

    //Omorphia Specific
    ODbgInterface, ODbgMapfile, OIncTypes;

Var
    Factorize: Int64;

Const
    PrimeCount = 8;
    //    Primes: Array[0..PrimeCount - 1] of Integer = (2,3,5,7,11,13,17,19,23,29,31);

Var
    Wheel: Array Of Integer;
    WheelLen: Integer;
    WheelPeriod: Int64;

    X, X2: Integer;
    Y, Z: Int64;
    CurrPrime: Integer;

    WheelPtrSrc, WheelPtrDest: Integer;

//Omorphia Specific:
Procedure HandleError(Level: Integer; Place: TODbgMapLocation; Desc: String; Var ErrorObj: Exception; Var Handled: Boolean);
Var
    SL: TStringList;
Begin
    WriteLn('Exception Level ', Level, ' occured at the following location:');
    WriteLn('  ', PlaceToLocationStr(Place));
    WriteLn('The Stacktrace is as follows:');
    SL := GetStackTrace(10);
    While SL.Count > 0 Do
    Begin
        WriteLn('- ', SL[0]);
        SL.Delete(0);
    End;
End;

Var
    T1, T2, T3: Int64;

Begin
    AddErrorHandler(HandleError); //Omorphia Specific

    Write('Zu faktorisierende Zahl: ');
    ReadLn(Factorize);

    If Factorize < 0 Then
    Begin
        WriteLn('-1');
        Factorize := -Factorize;
    End;
    If Factorize < 2 Then
    Begin
        If Factorize = 0 Then
            Write('0');
        Exit;
    End;

    QueryPerformanceCounter(T1);
    
    X2 := 0;
    While Factorize And 1 = 0 Do
    Begin
        Factorize := Factorize Shr 1;
        Inc(X2);
    End;
    If X2 <> 0 Then
    Begin
        If X2 = 1 Then
            WriteLn('2')
        Else
            WriteLn('2 ^ ', X2);
    End;
    If Factorize = 1 Then
        Break;

    //Initialize the wheel
    WheelLen := 1;
    SetLength(Wheel, WheelLen);
    Wheel[0] := 2;
    WheelPeriod := 2;

    //Build up the wheel
    For X := 0 To PrimeCount - 1 Do
    Begin
        //Get the current prime for extension
        //CurrPrime := Primes[X];
        //Alternatively you could also write
        CurrPrime := 1 + Wheel[0];

        X2 := 0;
        While Factorize Mod CurrPrime = 0 Do
        Begin
            Factorize := Factorize Div CurrPrime;
            Inc(X2);
        End;
        If X2 <> 0 Then
        Begin
            If X2 = 1 Then
                WriteLn(CurrPrime)
            Else
                WriteLn(CurrPrime, ' ^ ', X2);
        End;
        If Factorize = 1 Then
            Break;

        WheelPeriod := WheelPeriod * CurrPrime;

        //Extend the whell to include as many field as required at first.
        SetLength(Wheel, WheelLen * CurrPrime);
        For X2 := 1 To CurrPrime - 1 Do
            Move(Wheel[0], Wheel[WheelLen * X2], WheelLen * SizeOf(Wheel[0]));

        //Start from the very beginning ;-)
        WheelPtrSrc := 0;
        WheelPtrDest := 0;
        Y := 1;

        //Until we finished checking all numbers of the current wheel
        While WheelPtrSrc < WheelLen * CurrPrime Do
        Begin
            Z := 0;
            Repeat
                Y := Y + Wheel[WheelPtrSrc];
                Z := Z + Wheel[WheelPtrSrc];
                Inc(WheelPtrSrc);
            Until (Y Mod CurrPrime <> 0) Or (WheelPtrSrc >= WheelLen * CurrPrime);
            Wheel[WheelPtrDest] := Z;
            Inc(WheelPtrDest);
        End;

        WheelLen := WheelPtrDest;
        SetLength(Wheel, WheelLen);
    End;

    WheelPtrSrc := 1;
    Y := 1 + Wheel[0] + Wheel[1];
    Z := Trunc(Sqrt(1.0 * Factorize));
    While Y < Z Do
    Begin
        X2 := 0;
        While Factorize Mod Y = 0 Do
        Begin
            Factorize := Factorize Div Y;
            Inc(X2);
        End;
        If X2 <> 0 Then
        Begin
            If X2 = 1 Then
                WriteLn(Y)
            Else
                WriteLn(Y, ' ^ ', X2);

            Z := Trunc(Sqrt(1.0 * Factorize));
        End;
        If Factorize = 1 Then
            Break;

        Inc(WheelPtrSrc);
        If WheelPtrSrc >= WheelLen Then
            WheelPtrSrc := 0;
        Y := Y + Wheel[WheelPtrSrc];
    End;

    If Factorize <> 1 Then
        WriteLn(Factorize);

    QueryPerformanceCounter(T2);
    QueryPerformanceFrequency(T3);

    WriteLn('Faktorisierung abgeschlossen!');
    WriteLn(Format('Benötigte Zeit: %.6f s', [(T2 - T1) / T3]));
    ReadLn;
End.                    

1:
2:
3:
4:
5:
6:
7:

Zu faktorisierende Zahl: 9223372036854775805
5
23
53301701
1504703107
Faktorisierung abgeschlossen!
Benötigte Zeit: 10,967501 s                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:

function Int64divModCar(Teiler : Cardinal;var Dividend,Quotient:Int64):Cardinal;assembler;
//berechnet Int64 divmod Cardinal
//Gibt Rest zurueck
//EAX= Teiler ; EDX =Adresse von Zahl1; ECX=Adresse von Zahl2
asm
  Push EBX
  MOV  EBX,EAX
  MOV  EAX,[EDX+4]
  Push EDI
  MOV  EDI,EDX
  XOR  EDX,EDX
  TEST EAX,EAX
  MOV  [ECX+4],EDX
  JE   @einstellig
  DIV  EBX
  MOV  [ECX+4],EAX
@einstellig:
  MOV  EAX,[EDI]
  POP  EDI
  DIV  EBX
  POP  EBX
  MOV  [ECX],EAX
  MOV  EAX,EDX;
end;

//und angewandt in der Primfaktorzerlegung:
  
  if Int64divModCar(Teiler,TestZahl,Quotient) = 0 then
//    If Zahl mod Teiler = 0 then
      begin
      repeat
        Result := Result + IntToStr(Teiler) + ' * ';
        Zahl := Quotient;
      until INt64divModCar(Teiler,TestZahl,Quotient) <> 0;
      Root := Trunc(SQRT(Zahl));
      end;

//zum testen:
procedure TForm1.Button2Click(Sender: TObject);
var
  i,k : cardinal;
  Dividend,
  Quotient : int64;
  T : tDateTime;
begin
  Dividend := 1001*65535;
  Dividend := Dividend *65537;
  i := 1;
  t := time;
  repeat
    k := INt64divModCar(i,Dividend,Quotient);
    inc(i);
  until i > 100000000;
  t := time-t;
  memo1.Lines.Add(FormatdateTime('hh:mm:ss.zzz',t));
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:

function p_primfaktor(a: int64): TPrimfaktor;
var
  Teiler: Int64;
begin
  if a < 0 then
  begin
    SetLength(result, 1);
    result[0] := -1;
    a := -a;
  end;
  while (a and 1) = 0 do
  begin
     setlength(result, length(result) + 1);
     Result[high(Result)] := 2;
     a := a shr 1;
  end;
  if a >= 2 then
  begin
    Teiler := 3;
    while a mod Teiler = 0 do
    begin  
      setlength(result, length(result) + 1);  
      Result[high(Result)] := Teiler;
      a := a div Teiler;
    end;
    Inc(Teiler, 2);
    while Teiler <= Trunc(SQRT(1.0 * a)) do
    begin
      while a mod Teiler = 0 do
      begin  
        setlength(result, length(result) + 1);  
        Result[high(Result)] := Teiler;
        a := a div Teiler;
      end;
      Inc(Teiler, 2);
      while a mod Teiler = 0 do
      begin  
        setlength(result, length(result) + 1);  
        Result[high(Result)] := Teiler;
        a := a div Teiler;  
      end;
      Inc(Teiler, 4);
    end;
  end;  
  if a <> 1 then
  begin
    setlength(result, length(result) + 1);
    Result[high(Result)] := a;
  end;
end;