DBR Delphi-Ecke

// Es wird mit einfachen Mitteln eine Verschlüsselung von Dateien erreicht.
// Der Schlüssel (das Passwort) sollte nicht im Programm selbst stehen, sondern
// als Parameter an die EXE übergeben oder mittels einer Abfrage eingetippt
// werden. Je länger der Schlüssel, desto sicherer ist das Ergebnis.
// Siehe dazu auch Strings verschlüsseln
// und Große Dateien verschlüsseln

// Getestet mit D4 unter Win98 (Für AnsiStrings)

// Variante 1 (einfache XOR-Methode):
// Beim ersten Durchlauf wird verschlüsselt, beim zweiten Durchlauf
// wird mit der gleichen Prozedur entschlüsselt.

const schluessel: string = 'ab#123@x-*oY2'; // oder sonstwas 
 
procedure verschlFile(datei, schl: string); 
var b: byte; 
  x: longint; 
  i, lg: integer; 
  m, f: TMemoryStream; 
begin 
  screen.cursor := crHourglass; 
  i := 1; 
  lg := length(schl); 
  m := Tmemorystream.create; 
  f := Tmemorystream.create; 
  try 
    f.loadfromfile(datei); 
    for x := 0 to f.size - 1 do begin 
      f.readbuffer(b, 1); 
      b := b xor ord(schl[i]); 
      m.writebuffer(b, 1); 
      inc(i); 
      if i > lg then i := 1; 
    end; 
    f.free; 
    m.savetofile(datei); 
  finally 
    try 
      f.free; 
    except end; 
    m.free; 
    screen.cursor := crdefault; 
  end; 
end; 
 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  verschlFile('c:\meineDatei.txt', schluessel); 
end;

//---------------------------------------------------------------------

// 2. Variante
// Die unter 1. beschriebene Methode hat den Nachteil, dass
// bei großen Dateien auch viel Arbeitsspeicher verbraucht wird.
// Das könnte unter Umständen zum Abbruch führen, da der Speicher
// einfach nicht mehr ausreicht. Deshalb hier noch eine (etwas langsamere)
// Methode, die mit einem kleinen Zwischenspeicher auskommt. Zusätzlich
// zeigen die auskommentierten Teile, wie man während des Verschlüsselns
// eine Fortschrittsanzeige einblenden lassen kann.

function verschl(Datei, schl: string {;gd:TGauge}): boolean; 
const bufgr = word(1024); 
var quelle, ziel: file; 
  anzahl, geschrieben, x, i, lg: integer; 
  temp: string; 
  flag: boolean; 
  buf: array[0..bufgr - 1] of byte; 
begin 
  flag := true; 
  i := 1; 
  lg := length(schl); 
  setlength(temp, max_path); 
  setlength(temp, GetTempPath(max_path, pchar(temp))); 
  temp := temp + '~TmpVerschl.~~~'; 
  assignfile(quelle, Datei); 
  assignfile(ziel, temp); 
{$I-} 
  reset(quelle, 1); 
  if ioresult = 0 then begin 
    rewrite(ziel, 1); 
    if ioresult = 0 then begin 
      //gd.maxvalue:=filesize(quelle); 
      repeat 
        BlockRead(quelle, Buf, bufgr, anzahl); 
        if ioresult <> 0 then begin flag := false; 
          break; 
        end; 
        for x := 0 to anzahl - 1 do begin 
          buf[x] := buf[x] xor ord(schl[i]); 
          inc(i); 
          if i > lg then i := 1; 
        end; 
        BlockWrite(ziel, Buf, anzahl, geschrieben); 
        if ioresult <> 0 then begin flag := false; 
          break; 
        end; 
        //gd.progress:=gd.progress + geschrieben; 
      until (anzahl = 0) or (geschrieben <> anzahl); 
      closefile(ziel); 
    end else flag := false; 
    closefile(quelle); 
  end else flag := false; 
{$I+} 
  if flag then begin 
    try 
      deletefile(Datei); 
      movefile(pchar(temp), pchar(datei)); 
    except flag := false; 
    end; 
  end; 
  result := flag; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  //gauge1.visible:=false; 
end; 
 
procedure TForm1.Button2Click(Sender: TObject); 
var schluessel, dateiname: string; 
begin 
  dateiname := 'c:\test.txt'; 
  schluessel := '#@a3-ä*A7'; 
  //gauge1.progress:=0; 
  //gauge1.visible:=true; 
  if not verschl(dateiname, schluessel {,gauge1}) 
    then showmessage('Fehler ' + inttostr(getlasterror)); 
  //gauge1.visible:=false; 
end;

//---------------------------------------------------------------------

// 3. Variante - Sicherheitsschlüssel
// Bei dieser Methode benötigt man zum Verschlüsseln einen Schlüssel,
// zum Entschlüsseln jedoch zwei. Der erste Schlüssel muss dem Verschlüsseler
// und dem Entschlüsseler gleichermaßen bekannt sein. Dieser Standardschlüssel
// könnte theoretisch veröffentlicht werden, da er ohne den zweiten Schlüssel
// nur zum Verschlüsseln taugt. Bei der Verschlüsselung wird der zweite
// Schlüssel automatisch erzeugt, wobei der Zufallsgenerator eine Rolle spielt.
// Da der Generator auch nur eine Berechnung darstellt, wird dessen Ergebnis
// entsprechen dem Wert von relevant mit Daten aus der Datei kombiniert.
// Deshalb darf relevant auch nicht größer sein als ein Drittel der Dateigröße.

function 
  verschl(unverschlsslt, verschlsslt, privatschl, standardschl: string): 
    boolean; 
const 
  relevant = 10; 
  bufgr = word(2048); 
var quelle, ziel: file; 
  anzahl, geschrieben, x, i, ii, lg, grsse: integer; 
  flag: boolean; 
  buf: array[0..bufgr - 1] of char; 
  prvt: string; 
  st: TFileStream; 
  function privatErzeugen(schluessel: string): string; 
  var 
    y, p, n: Integer; 
  begin 
    result := ''; 
    p := 0; 
    for y := 1 to length(schluessel) do begin 
      inc(p); 
      if p > length(schluessel) then p := 1; 
      n := random(100) + 1 + ord(schluessel[p]); 
      result := result + formatfloat('000', n); 
    end; 
  end; 
begin 
  if fileexists(privatschl) then deletefile(privatschl); 
  if unverschlsslt <> verschlsslt then begin 
    setlength(prvt, relevant); 
    flag := true; 
    lg := length(standardschl); 
    assignfile(quelle, unverschlsslt); 
    assignfile(ziel, verschlsslt); 
{$I-} 
    reset(quelle, 1); 
    if ioresult = 0 then begin 
      grsse := filesize(quelle); 
      if grsse >= relevant * 3 then begin 
        BlockRead(quelle, prvt[1], relevant, anzahl); 
        if (ioresult = 0) and (anzahl = relevant) then begin 
          prvt := privatErzeugen(prvt); 
          seek(quelle, 0); 
          rewrite(ziel, 1); 
          if ioresult = 0 then begin 
            repeat 
              BlockRead(quelle, Buf, bufgr, anzahl); 
              if ioresult <> 0 then begin flag := false; 
                break; 
              end; 
              i := 1; 
              ii := relevant * 3; 
              for x := 0 to anzahl - 1 do begin 
                buf[x] := chr(byte(buf[x]) xor ord(standardschl[i]) xor 
                  ord(prvt[ii])); 
                inc(i); 
                if i > lg then i := 1; 
                inc(ii); 
                if ii > relevant * 3 then ii := 1; 
              end; 
              BlockWrite(ziel, Buf, anzahl, geschrieben); 
              if ioresult <> 0 then begin flag := false; 
                break; 
              end; 
            until (anzahl = 0) or (geschrieben <> anzahl); 
            closefile(ziel); 
          end else flag := false; 
          closefile(quelle); 
        end else flag := false; 
      end else flag := false; 
    end else flag := false; 
{$I+} 
  end else flag := false; 
  result := flag; 
  if result then begin 
    st := TFilestream.create(privatschl, fmcreate); 
    st.writebuffer(prvt[1], relevant * 3); 
    st.free; 
  end; 
end; 
 
// Beispielaufruf zum Verschlüsseln 
procedure TForm1.Button3Click(Sender: TObject); 
const 
  zuverschluesseln = 'c:\test.txt'; 
  verschluesselt = 'c:\test.dbr'; 
  schluesselspeicher = 'c:\privatschl.txt'; 
  standardschluessel = '0+?ß#-ä*Qe$%.<'; 
begin 
  if not verschl(zuverschluesseln, verschluesselt, 
    schluesselspeicher, standardschluessel) 
    then showmessage('FEHLER'); 
end; 
 
// Und so wird dann entschlüsselt 
 
function 
  entschl(verschlsslt, unverschlsslt, standard, privat: string): boolean; 
const bufgr = word(2048); 
var quelle, ziel: file; 
  anzahl, geschrieben, x, i, ii, lg, lg2: integer; 
  flag: boolean; 
  buf: array[0..bufgr - 1] of char; 
begin 
  flag := true; 
  lg := length(standard); 
  lg2 := length(privat); 
  assignfile(quelle, verschlsslt); 
  assignfile(ziel, unverschlsslt); 
{$I-} 
  reset(quelle, 1); 
  if ioresult = 0 then begin 
    rewrite(ziel, 1); 
    if ioresult = 0 then begin 
      repeat 
        BlockRead(quelle, Buf, bufgr, anzahl); 
        if ioresult <> 0 then begin flag := false; 
          break; 
        end; 
        i := 1; 
        ii := lg2; 
        for x := 0 to anzahl - 1 do begin 
          buf[x] := chr(byte(buf[x]) xor ord(standard[i]) xor 
            ord(privat[ii])); 
          inc(i); 
          if i > lg then i := 1; 
          inc(ii); 
          if ii > lg2 then ii := 1; 
        end; 
        BlockWrite(ziel, Buf, anzahl, geschrieben); 
        if ioresult <> 0 then begin flag := false; 
          break; 
        end; 
      until (anzahl = 0) or (geschrieben <> anzahl); 
      closefile(ziel); 
    end else flag := false; 
    closefile(quelle); 
  end else flag := false; 
{$I+} 
  result := flag; 
end; 
 
// Beispielaufruf zur Entschlüsselung. 
// Es wird davon ausgegangen, dass der private Schlüssel 
// in der Datei "c:\privatschl.txt" steht und dass der 
// Standardschlüssel der gleiche ist, wie beim Verschlüsseln. 
procedure TForm1.Button4Click(Sender: TObject); 
const 
  verschluesselt = 'c:\test.dbr'; 
  zuentschluesseln = 'c:\test.txt'; 
  schluesselspeicher = 'c:\privatschl.txt'; 
  standardschluessel = '0+?ß#-ä*Qe$%.<'; 
var 
  privatschluessel: string; 
  st: TFilestream; 
begin 
  st := TFilestream.create(schluesselspeicher, fmopenread); 
  setlength(privatschluessel, st.size); 
  st.readbuffer(privatschluessel[1], st.size); 
  st.free; 
  if not 
    entschl(verschluesselt, zuentschluesseln, standardschluessel, 
      privatschluessel) 
    then showmessage('FEHLER'); 
end;

//---------------------------------------------------------------------

// 4. Variante
// Diese Methode verwendet eine Tabelle zum Verschlüsseln. Allerdings
// wird diese Tabelle dynamisch erzeugt und muss deshalb weder dem
// Verschlüsseler noch dem Entschlüsseler bekannt zu sein. Ein Passwort
// wird deshalb auch nicht gebraucht. Die verschlüsselte Datei ist eine
// sogenannte 7-Bit-Textdatei und doppelt so groß wie das Original.
// Die Fortschrittsanzeige wird durch "TGauge" realisiert, da "TProgressBar"
// die Sache etwas verlangsamt.

var 
  ba: array[0..255] of word; 
 
procedure maketable(seed: longint); 
var 
  w: word; 
  x, y: integer; 
  b: array[0..1] of byte; 
  function zuweisen: boolean; 
  var 
    i: integer; 
  begin 
    result := false; 
    for i := 0 to 255 do begin 
      if ba[i] = w then exit else 
        if ba[i] = 0 then begin 
          ba[i] := w; 
          result := true; 
          exit; 
        end; 
    end; 
  end; 
begin 
  randseed := seed; 
  zeromemory(@ba, sizeof(ba)); 
  for x := 0 to 255 do begin 
    repeat; 
      for y := 0 to 1 do 
        b[y] := random(26) + 65; 
      w := b[0] or (b[1] shl 8); 
    until zuweisen; 
  end; 
end; 
 
function encrypt(von, nach: TFilename; g: TGauge): boolean; 
var 
  p: PByte; 
  x: integer; 
  w, m: word; 
  quelle, ziel: TMemoryStream; 
begin 
  result := false; 
  quelle := TMemoryStream.create; 
  ziel := TMemoryStream.create; 
  try 
    quelle.loadfromfile(von); 
    p := quelle.memory; 
    g.maxvalue := pred(quelle.size); 
    maketable(g.maxvalue); 
    randomize; 
    for x := 0 to g.maxvalue do begin 
      w := ba[ord(p^)]; 
      if (w = m) then 
        case random(3) of 
          0: w := (hi(w) shl 8) or (lo(w) - 32); 
          1: w := lo(w) or ((hi(w) + 36) shl 8); 
        else w := lo(w) or ((hi(w) - 32) shl 8); 
        end; 
      m := w; 
      ziel.writebuffer(w, 2); 
      g.progress := x; 
      inc(p); 
      application.processmessages; 
    end; 
    ziel.savetofile(nach); 
    result := true; 
  except 
  end; 
  ziel.free; 
  quelle.free; 
  g.progress := 0; 
end; 
 
function decrypt(von, nach: TFilename; g: TGauge): boolean; 
var 
  quelle, ziel: TMemoryStream; 
  p: PByte; 
  x: integer; 
  b, c: byte; 
  function lesen: byte; 
  begin 
    result := p^; 
    if result < 65 then inc(result, 32) else 
      if result > 90 then dec(result, 36); 
    inc(p); 
  end; 
  function finden(w: word): byte; 
  var 
    i: integer; 
  begin 
    for i := 0 to 255 do 
      if ba[i] = w then begin 
        result := i; 
        break; 
      end; 
  end; 
begin 
  result := false; 
  quelle := TMemoryStream.create; 
  ziel := TMemoryStream.create; 
  try 
    quelle.loadfromfile(von); 
    p := quelle.memory; 
    g.maxvalue := pred(quelle.size div 2); 
    maketable(g.maxvalue); 
    for x := 0 to g.maxvalue do begin 
      b := lesen; 
      c := lesen; 
      b := finden(b or (c shl 8)); 
      ziel.writebuffer(b, 1); 
      g.progress := x; 
      application.processmessages; 
    end; 
    ziel.savetofile(nach); 
    result := true; 
  except 
  end; 
  ziel.free; 
  quelle.free; 
  g.progress := 0; 
end; 
 
 
 
// Verschlüsseln 
 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  TButton(sender).enabled := false; 
  if not 
    encrypt('c:\clapton.bmp', 'c:\verschlüsselt.txt', Gauge1) 
    then showmessage('FEHLER') 
  else showmessage('OK'); 
  TButton(sender).enabled := true; 
end; 
 
 
// entschlüsseln 
 
procedure TForm1.Button8Click(Sender: TObject); 
begin 
  TButton(sender).enabled := false; 
  if not 
    decrypt('c:\verschlüsselt.txt', 'c:\entschlüsselt.bmp', Gauge1) 
    then showmessage('FEHLER') 
  else showmessage('OK'); 
  TButton(sender).enabled := true; 
end;

//---------------------------------------------------------------------

// 5. Variante - Erweiterung von Variante 4
// So interessant es ist eine Verschlüsselung zu haben, die weder eine feste
// Tabelle noch ein Passwort benötigt, so gefährlich ist es auch. Denn wenn
// jemand "Delphi" besitzt und diese Site hier kennt, kann er die
// Verschlüsselung knacken. Deshalb habe ich den Code etwas verändert. Die
// Verschlüsselung erfolgt zwar immer noch über eine dynamische Tabelle, diese
// wird aber anhand eines Passwortes erzeugt. Die verschlüsselte Datei ist
// ebenfalls eine 7-Bit-Textdatei, aber nur noch 1/3 größer als das Original.
// Allerdings wird bei Dateien mit einer Größe von mehr als 10 MB die
// Verschlüsselungszeit nervig lang. Da aber der Code eigentlich zur
// Verschlüsselung von reinem Text gedacht ist, sollte diese Größe wohl nicht
// erreicht werden.

var 
  passwort: string = 'DBR 4. Dezember 2005'; // beispielsweise 
 
  ba: array[0..63] of char; 
 
procedure maketable(const schlssl: string); 
var 
  x, b: byte; 
  function seed: string; 
  var 
    i, z, erg: integer; 
  begin 
    erg := 0; 
    result := ''; 
    for z := 2 to 10 do begin 
      for i := 1 to length(schlssl) do 
        erg := (erg * 2 + ord(schlssl[i]) * (z - ord(odd(i)) * pred(z))) mod 97; 
      result := result + inttostr(erg mod 9); 
    end; 
  end; 
  function zuweisen: boolean; 
  var 
    i: integer; 
  begin 
    result := false; 
    for i := 0 to 63 do begin 
      if ba[i] = chr(b) then exit else 
        if ba[i] = #0 then begin 
          ba[i] := chr(b); 
          result := true; 
          exit; 
        end; 
    end; 
  end; 
begin 
  randseed := strtoint(seed); 
  zeromemory(@ba, sizeof(ba)); 
  for x := 0 to 63 do 
    repeat; 
      b := random(95) + 32; 
    until zuweisen; 
end; 
 
function encrypt(von, nach: TFilename; g: TGauge): boolean; 
var 
  p: PChar; 
  r: string; 
  x, gr: integer; 
  quelle, ziel: TMemoryStream; 
begin 
  result := false; 
  if passwort = '' then exit; 
  quelle := TMemoryStream.create; 
  ziel := TMemoryStream.create; 
  try 
    ziel.loadfromfile(von); 
    gr := ziel.size; 
    ziel.seek(0, 0); 
    quelle.writebuffer(gr, 4); 
    quelle.copyfrom(ziel, gr); 
  except 
    ziel.free; 
    quelle.free; 
    exit; 
  end; 
  ziel.size := 0; 
  try 
    maketable(passwort); 
    r := #0#0; 
    quelle.seek(0, sofromend); 
    quelle.writebuffer(r[1], 2); 
    g.maxvalue := pred(quelle.size); 
    p := quelle.memory; 
    randomize; 
    x := 0; 
    while x < quelle.size do begin 
      r := ba[ord((p + x)^) shr 2] + ba[(ord((p + x)^) and 3) shl 4 
        or ord((p + 1 + x)^) shr 4] 
        + ba[(ord((p + 1 + x)^) and 15) shl 2 or ord((p + 2 + x)^) shr 6] 
        + ba[ord((p + 2 + x)^) and 63]; 
      ziel.writebuffer(r[1], 4); 
      g.progress := x; 
      inc(x, 3); 
      application.processmessages; 
    end; 
    ziel.savetofile(nach); 
    result := true; 
  except 
  end; 
  ziel.free; 
  quelle.free; 
  g.progress := 0; 
end; 
 
function decrypt(von, nach: TFilename; g: TGauge): boolean; 
var 
  p: PChar; 
  b: byte; 
  a: array of byte; 
  x, i, gr: integer; 
  quelle, ziel: TMemoryStream; 
begin 
  result := false; 
  if passwort = '' then exit; 
  quelle := TMemoryStream.create; 
  try 
    quelle.loadfromfile(von); 
    p := quelle.memory; 
    i := quelle.size; 
    g.maxvalue := i * 2; 
    maketable(passwort); 
    setlength(a, i); 
    for x := 0 to pred(i) do begin 
      a[x] := pred(pos((p + x)^, ba)); 
      g.progress := x; 
      application.processmessages; 
    end; 
  except; 
    g.progress := 0; 
    quelle.free; 
    a := nil; 
    exit; 
  end; 
  quelle.size := 0; 
  ziel := TMemoryStream.create; 
  try 
    x := 0; 
    while x < i do begin 
      b := (a[x] shl 2) or (a[x + 1] shr 4); 
      quelle.writebuffer(b, 1); 
      b := (a[x + 1] shl 4) or (a[x + 2] shr 2); 
      quelle.writebuffer(b, 1); 
      b := ((a[x + 2] and 3) shl 6) or (a[x + 3] and 63); 
      quelle.writebuffer(b, 1); 
      inc(x, 4); 
      g.progress := x + i; 
      application.processmessages; 
    end; 
    quelle.seek(0, 0); 
    quelle.readbuffer(gr, 4); 
    ziel.copyfrom(quelle, gr); 
    ziel.savetofile(nach); 
    result := true; 
  except 
  end; 
  a := nil; 
  ziel.free; 
  quelle.free; 
  g.progress := 0; 
end; 
 
 
// Beispielaufrufe 
 
// Verschlüsseln 
 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  TButton(sender).enabled := false; 
  if not 
    encrypt('c:\test.bmp', 'c:\verschlüsselt.txt', Gauge1) 
    then showmessage('FEHLER') 
  else showmessage('OK'); 
  TButton(sender).enabled := true; 
end; 
 
 
// entschlüsseln 
 
procedure TForm1.Button8Click(Sender: TObject); 
begin 
  TButton(sender).enabled := false; 
  if not 
    decrypt('c:\verschlüsselt.txt', 'c:\entschlüsselt.bmp', Gauge1) 
    then showmessage('FEHLER') 
  else showmessage('OK'); 
  TButton(sender).enabled := true; 
end;