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:

procedure TForm1.Button1Click(Sender: TObject);
var f:file of tbits;
    laenge,stelle,z:integer;
    b2:tbits;
    s1,s2:tfilestream;
begin
stelle:=0;
if od.Execute and sd.Execute then
  begin
    try
      s1:=Tfilestream.Create(sd.FileName,fmcreate);    //copy file! 1 zu 1!!
      s2:=Tfilestream.Create(od.FileName,fmOpenRead);   //und machmit kopierten file weiter!!*G*
      s1.CopyFrom(s2,s2.Size);
    finally
      s1.Free;
      s2.Free;
    end;

    assignfile(f,sd.FileName); //start reading,writing!
    reset(f);
    laenge:=filesize(f);        //Dateigröße,brauchich eigentlich nicht
    b2:=tbits.Create;
      read(f,b2);               //einfach mal zum testen lesen und gleich wieder drüber-
      write(f,b2);              //schreiben
      closefile(f);
      {for laenge:=0 to b2.Size-1 do          //sollte ne kontrolle werden
        begin                            // obs funktioniert hat
          if b2.Bits[laenge]=true then listbox1.Items.add('1')
          else listbox1.Items.add('0');
        end;}
      b2.Free;
      showmessage('Fertig! Habe '+inttostr(laenge*8)+' Bits geschrieben!');//ob des 
  end;                                                                      //stimmt?
end;					

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

procedure Tform1.CopyFile( source, destination:string);
var DataFile:TMemoryStream;
begin
  DataFile:=TMemoryStream.Create;
  DataFile.LoadFromFile(source);
  DataFile.SaveToFile(destination);
  DataFile.Free;
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:

var DataFile:TMemoryStream;
    data:TfileStream;
    bytes:array of byte;
begin
if od.Execute and sd.Execute then
  begin
    try
      DataFile:=TMemoryStream.Create;
      DataFile.LoadFromFile(od.filename);

      data:=Tfilestream.Create(sd.FileName,fmcreate);
      data.CopyFrom(datafile,datafile.Size);

      setlength(bytes,300);
      data.Seek(0,soFromBeginning  );
      data.read(bytes,255);
      showmessage(inttostr(data.Position));
      data.Seek(0,soFromBeginning  );
      data.Write(bytes,253);
    finally
      data.free;
      DataFile.Free;
    end;
  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:

procedure tform1.reading(s:Tstream;var b:array of byte;count:integer);
begin
  s.readbuffer(b,count);
end;

procedure tform1.writing(s:Tstream;b:array of byte;count:integer);
begin
  s.WriteBuffer(b,count);
end;

procedure TForm1.Button11Click(Sender: TObject);
var bytes:array of byte;
    s:Tstream;
begin
if od.Execute then
  begin
    try
      s:=TFileStream.Create(od.FileName,fmopenreadwrite);
      showmessage(inttostr(s.Size));
      setlength(bytes,350);
      s.Seek(0,soFromBeginning  );
      reading(s,bytes,349);
      s.Seek(0,soFromBeginning  );
      writing(s,bytes,349);
    finally
      s.free;
    end;
  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:

procedure TForm1.Button7Click(Sender: TObject);
var s:Tstream;
    key,buffer:array of byte;
    lauf,size,x,grose:integer;
begin
if Passwortedit.Text='' then      //eingabefeld überprüfen!!
  begin
    showmessage('Passwort wählen!');
    exit;
  end;
if od.Execute then
  begin
  try
  S:= TFileStream.Create(od.FileName, fmopenreadwrite); //file öffnen
  //algo rhytmus!
  setlength(key,sizeof(passwortedit.Text));  //strtobyte konvertieren
  strtobyte(passwortedit.Text,key);
  size:=sizeof(key);       
  //crypt!
  setlength(buffer,s.size);
  s.seek(0,sofrombeginning);
  grose:=s.size;
    reading(s,buffer,s.size);      //lesen
    s.Seek(0,sofrombeginning);
    x:=0;
    for lauf:=0 to s.size do       //erster durchgang!!crypten mit xor
      begin
        buffer[lauf]:=key[x] xor buffer[lauf];  //sizeof(buffer)=size
        if x=sizeof(key) then x:=0
        else x:=x+1;
      end;
    x:=sizeof(key);
    for lauf:=0 to s.size do       //zweiter Durchgang!crypten mit xor
      begin
        buffer[lauf]:=key[x] xor buffer[lauf];  //sizeof(buffer)=size
        if x=0 then x:=sizeof(key)
        else x:=x-1;
      end;
    writing(s,buffer,s.size);      //schreiben
  s.seek(0,sofrombeginning);
  showmessage('Fertig! Es wurden '+inttostr(grose)+' Bytes gecryptet und geschrieben!');
  finally
    s.free;
  end;
  end;
end;					

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

---------------------------
Anwendungsfehler
---------------------------
Exception EAccessViolation in Modul Project1.exe bei 6547F000.

Zugriffsverletzung bei Adresse 65480000. Lesen von Adresse 65480000.
---------------------------
OK   
---------------------------					

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

procedure tform1.strtobyte(instring:string;var outbytes:array of byte);
var i:integer;
    c:array of char;
begin
setlength(c,length(instring));
  for i:=1 to length(instring) do
    begin
      c[i-1]:=instring[i];
    end;
  for i := 0 to length(c) do
    outbytes[i] := ord(c[i]);
end;					

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

Procedure StrToByteS(const Str:String;var NameArr :Array of byte);
var I,J :Integer;
Begin
  FillChar(NameArr,high(NameArr)+1,0);
  if length(Str) >high(NameArr) then J :=high(NameArr)
  else J :=length(Str);
  For I:=1 to J do NameArr[I-1]:=byte(Str[I]);
End;

Function ByteToStr (NameArr :Array of byte):String;
var I:Integer;
    S:String;
Begin
 Setlength(S,High(NameArr)+1);
 For I:=Low(NameArr) to High(NameArr) do S[I+1]:=Char(NameArr[I]);
 Result :=Pchar(S);
End;