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:

var
  start,stop,i,j,anz: Integer;
  S, str: String;
  fs: Tfilestream;
  b: array of Byte;
  arr: TBits;
  Zeit: array of Integer;

...
repeat
     start := Gettickcount;
     S := str;
     for i := 0 to 32767 do
      begin
       fs.Read(b[i], SizeOf(byte));
       S := S + BytetoBin(b[i]);
      end;
     for i := 0 to (length(S) div anz) - 1 do
      arr[BintoDec(PChar(COPY(S,i*anz+1,anz)))] := true;
     str := COPY(S,length(S) - (length(S) - (length(S) div anz)*anz)+1,length(S) - (length(S) div anz)*anz);
     stop := Gettickcount;
     Zeit[j] := stop-start;
     Inc(j);
until fs.Size = fs.Position;
...


function TForm1.ByteToBin(Value: Byte): String;
Var
    B: PByte;
Begin
    Value := Value And $FF;
    Result := StringOfChar('0', 8);
    B := @Byte(Result[8]);
    While Value <> 0 Do
    Begin
        Inc(B^, Value And 1);
        Value := Value Shr 1;
        Dec(B);
    End;
End;

function TForm1.BintoDec(Value: PChar): Integer;
begin  
  Result := 0;  
  while Value^ <> #0 do  
  begin  
    Result := Result shl 1;  
    Result := Result or Ord(Value^ = '1');  
    Inc(Value);  
  end;  
end;

for i := 0 to high(Zeit) do
   j := j + Zeit[i];
ListBox1.Items.Add(FloattoStr(j/high(Zeit)));                    

1:
2:
3:
4:
5:

for i := 0 to 32767 do  
      begin  
       fs.Read(b[i], SizeOf(byte));  
       S := S + BytetoBin(b[i]);  
      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:

fs.Read(b[1], 32768);
       S := S + BytetoBin(b,32768);


function TForm1.ByteToBin(Value: String; range: integer): String;
Var
    B: PByte;
    i: Integer;
    st: String;
    c: ^byte;
Begin
  Result := '';
  c := @Byte(Value[1]);
  for i := 1 to range do
   begin
    st := StringOfChar('0', 8);
    B := @Byte(st[8]);
    While c^ <> 0 Do
      Begin
        Inc(B^, c^ And 1);
        c^ := c^ Shr 1;
        Dec(B);
      End;
    Result := Result + st;
    c := pointer(cardinal(c)+1);
   end;
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:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  Tnibble = array[0..15] of String[7];
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure ByteToBin(const Value: String; range: integer;var outStr: String);
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}

procedure TForm1.ByteToBin(const Value: String; range: integer;var outStr: String);
const
   nibble : Tnibble  =
            ('0000','0001','0010','0011',
             '0100','0101','0110','0111',
             '1000','1001','1010','1011',
             '1100','1101','1110','1111');

Var
  t0,t1: cardinal;
  i: Integer;
  PosOut,c : ^byte;
Begin
  self.Memo1.Lines.Add('Jetzt geht''''s los ');
  t0 := Gettickcount;
  setLength(outStr,8*range);
  Posout := Addr(outStr[1]);
  c := Addr(Value[1]);
  for i := 1 to range do
    begin
    move(nibble[c^ shr 4][1],PosOut^,4);
    inc(PosOut,4);
    move(nibble[c^ AND 15][1],PosOut^,4);
    inc(PosOut,4);
    inc(c);
   end;
  t1 := Gettickcount;
  self.Memo1.Lines.Add('Fertig ');
  self.Memo1.Lines.Add(Format(' %7.4f Sekunden',[(t1-t0)/1000]));
End;


procedure TForm1.Button1Click(Sender: TObject);
var
  i           : integer;
  strTest,
  strErgebnis : String;
begin
  memo1.WordWrap := false;
  setlength(strTest,2820000);
  strTest:= StringOfChar(chr(64+16+4+1),length(strTest));//'U'=01010101
//  self.Memo1.Lines.Add(strTest);
  self.Memo1.Lines.Add(Format(' Anzahl Zeichen Eingabe %6d',[length(strTest)]));

  self.ByteToBin(strTest,length(strTest),strErgebnis);

  self.Memo1.Lines.Add(Format(' Anzahl Zeichen Ergebnis %6d',[length(strErgebnis)]));
//  self.Memo1.Lines.Add(strErgebnis);
end;

end.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:

for i := 0 to (length(S) div anz) - 1 do
      arr[BintoDec(PChar(COPY(S,i*anz+1,anz)))] := true;


function TForm1.BintoDec(Value: PChar): Integer;
begin
  Result := 0;
  while Value^ <> #0 do
  begin
    Result := Result shl 1;
    Result := Result or Ord(Value^ = '1');
    Inc(Value);
  end;
end;                    

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

tChar   = ^Char;//Bei pChar hat er immer das Zeichen und nicht die Adresse uebergeben
...
anz := 32;

for i := 0 to (length(StrErgebnis) div anz) - 1 do
   j:=BintoDec(Addr(StrErgebnis[i*anz+1]),anz);

function TForm1.BintoDec(Value : tChar;Anz: cardinal): Integer;
begin
  Result := 0;
  Anz := cardinal(Value)+Anz;
  while cardinal(Value) < Anz do
    begin
    Result := Result shl 1;
    Result := Result or Ord(Value^ = '1');
    Inc(Value);
    end;
end;