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

function prim(i: integer): boolean;
var i2:integer;
begin
i2 := i mod 2;
if i2 > 0 then
begin
result := true;
end;
end;					

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

  while ((Teiler <= Wurzel) AND (Result)) do
  begin
    if Zahl mod StrToInt(PrimS.Strings[Teiler]) = 0 then
    begin
      Result := False;
      Break;
    end;
    inc(Teiler, 2);
  end;					

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

function isPrim(Zahl: Cardinal): Boolean;
var Teiler, MaxTeiler: Cardinal;
begin
  if zahl<2 then begin
    Result:=False;
    Exit;
  end;

  Result:=True;
  if Zahl=2 then Exit;

  MaxTeiler:=Trunc(Sqrt(Zahl));

  for Teiler:=2 to MaxTeiler do
    if Zahl mod Teiler = 0 then begin
      Result:=False;
      Break;
    end;
end;					

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

for Teiler := 2 to MaxTeiler do begin
  if Zahl mod Teiler = 0 then begin
    Result := False;
    Break;
  end;
  Inc(Teiler);
end;					

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

  while ((Teiler <= Wurzel) AND (Result)) do
  begin
    if Trunc(Zahl / StrToInt(PrimS.Strings[Teiler])) = 0 then
    begin
      Result := False;
      Break;
    end;
    inc(Teiler, 1);
  end;					

1:
2:
3:
4:
5:

if X = Step then
        begin
          Application.ProcessMessages;
          inc(Step, 10000);
        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:
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:

Program PrimProj;

{$APPTYPE CONSOLE}

Uses
    SysUtils,
    Classes,
    Forms;

Function MkLang(Zahl, Ziffern: Integer): String;
Var
    Str: String;
    X: Integer;
Begin
    For X := 1 To Ziffern Do
        Str := Str + '0';
    Result := Copy(Str + IntToStr(Zahl), Length(IntToStr(Zahl)) + 1, Ziffern);
End;

Type
  TArrayInt64 = Array[0..0] Of Int64;
  PArrayInt64 = ^TArrayInt64;
Var
  FS: TFileStream;
  Primzahlen: PArrayInt64;
  CurrNum, CurrPrimIdx, MaxPrim, MaxTest: Int64;
  IsPrim, DoTest: Boolean;
  TmpSqrt: Extended;
  Tmp: String;
  STime, ETime: TDateTime;
  PrimCount, PrimMemSize: Integer;

  MS, SS, MM, HH, DD: WORD;
Begin
  MaxPrim := 0;
  While MaxPrim = 0 Do
  Try
    WriteLn('Bis zu welcher Zahl wollen Sie die Primzahlen ermitteln???');
    ReadLn(MaxPrim);
  Except
    MaxPrim := 0;
    Continue;
  End;
  STime := Now;
  GetMem(Primzahlen, 65536);
  PrimMemSize := 65536;
  CurrNum := 2;
  Primzahlen[0] := CurrNum;
  PrimCount := 0;
  Inc(CurrNum);
  Try
    Try
      While CurrNum <= MaxPrim Do
      Begin
        TmpSqrt := CurrNum;
        TmpSqrt := Sqrt(TmpSqrt); //Maximaler Testfaktor
        MaxTest := Round(TmpSqrt);

        IsPrim := true; //Primzahl = ja
        CurrPrimIdx := 0; //Aktuelle Position
        DoTest := CurrPrimIdx <= PrimCount; //Im Bereich???

        If DoTest Then //Wenn ja, ...
        Begin
          IsPrim := (TmpSqrt <> Trunc(TmpSqrt));
          DoTest := IsPrim And (Primzahlen[CurrPrimIdx] <= MaxTest);
        End;

        While DoTest Do
        Begin
          IsPrim := CurrNum Mod Primzahlen[CurrPrimIdx] <> 0;
          Inc(CurrPrimIdx); //Nächste Primzahl testen...
          DoTest := IsPrim And (CurrPrimIdx <= PrimCount); //Noch im Bereich???
          If DoTest Then //Wenn ja, ...
          Begin
            DoTest := Primzahlen[CurrPrimIdx] <= MaxTest;
          End;
        End;

        If IsPrim Then
        Begin
          If PrimCount shl 3 + 8 >= PrimMemSize Then
          Begin
            PrimMemSize := PrimMemSize Shl 1;
            ReallocMem(Primzahlen, PrimMemSize);
          End;
          Inc(PrimCount);
          Primzahlen[PrimCount] := CurrNum;
          If PrimCount And $FFF = 0 Then
            Write(IntToStr(CurrNum) + #9);
        End;
        Inc(CurrNum, 2);
      End;
      ETime := Now;
      WriteLn(#13#10);
      Write('Ermitteln der Primzahlen fertig');
      If STime <> ETime Then
      Begin
        WriteLn(': ' + IntToStr(Round((MaxPrim - 1) / ((ETime - STime)
          * 86400))) + ' geprüfte Zahlen pro Sekunde'#13#10);
        DecodeTime(STime, HH, MM, SS, MS);
        DecodeTime(ETime, DD, MM, SS, HH);
        DD := Trunc(ETime - STime);
        WriteLn('Startzeit: ' + DateTimeToStr(STime) + '.' + MkLang(MS,
          3));
        WriteLn('Endzeit:   ' + DateTimeToStr(ETime) + '.' + MkLang(HH,
          3));
        DecodeTime(ETime - STime, HH, MM, SS, MS);
        WriteLn('----------------------------------');
        WriteLn('Benötigt:  ' + Format('%10d %s.%s.%s.%s', [DD,
          MkLang(HH, 2), MkLang(MM, 2), MkLang(SS, 2), MkLang(MS,
            3)]));
      End
      Else
        WriteLn;
    Except
      On E: Exception Do
      Begin
        WriteLn('Fehler ' + E.ClassName + ': ' + E.Message);
      End;
    End;
  Finally
    WriteLn(#13#10,
      'Bitte warten!!!'#13#10'Die gesammelten Daten der Primzahlen werden gespeichert!!!');
    Try
      FS := TFileStream.Create(ChangeFileExt(Application.ExeName,
        '.prm'),
        fmCreate Or fmShareDenyWrite);
      Try
        FS.Size := 0;
        FS.Write(Primzahlen[0], (PrimCount + 1) * SizeOf(Int64));
        WriteLn('Es wurden ' + IntToStr(FS.Size Div SizeOf(Int64)) +
          ' Primzahlen gespeichert ...');
      Finally
                FS.Free;
            End;
        Except
            On E: Exception Do
                WriteLn('Fehler ' + E.ClassName + ': ' + E.Message);
        End;
        FreeMem(Primzahlen);
        Read(Tmp);
    End;
End.