Unicoe/UnicodeHEX String & File Crypter

Unit CoderDeCoder.pas

unit CoderDeCoder;
{$X+}
{$WARNINGS OFF}

interface

type
  TVerSchluesselArt = (sUniCode, sHexCode, sNormalStr);
  Str002 = string[2];
const
  CRandSeed: Int64 = 258974566;
  SKey: Int64      = 458795222;
  MKey: Int64      = 123456899;
  AKey: Int64      = 12345685525;

function VerEntschluesseln(Value: string; Flag: Boolean;
  Schl: TVerSchluesselArt): string;
function DateiVerEndSchluesseln(QuellDateiname, ZielDateiname: string): Boolean;
function CharToHexStr(Value: Char): string;
function CharToUniCode(Value: Char): string;
function Hex2Dec(Value: Str002): Byte;
function HexStrCodeToStr(Value: string): string;
function UniCodeToStr(Value: string): string;

implementation

uses
  Sysutils;

const
  ChS = '0123456789abcdefghijklmnopqrstuvwxyz';

var
  SchluesselSatz: string;

function CharToHexStr(Value: Char): string;
var
  Ch: Char;
begin
  Result := IntToHex(Ord(Value), 2);
  if Ch = #0 then Result := IntToHex(Ord(Value), 2);
end;

function CharToUniCode(Value: Char): string;
var
  S1: string;
  Ch: Char;
begin
  Result := '';
  S1     := AnsiUpperCase(ChS);
  Ch     := UpCase(Value);
  if StrScan(PChar(S1), Ch) = nil then Result := '%' + IntToHex(Ord(Value), 2)
  else 
    Result := Value;
  if Ch = #0 then Result := '%' + IntToHex(Ord(Value), 2)
end;

function Hex2Dec(Value: Str002): Byte;
var
  Hi, Lo: Byte;
begin
  Hi := Ord(Upcase(Value[1]));
  Lo := Ord(Upcase(Value[2]));
  if Hi > 57 then Hi := Hi - 55 
  else 
    Hi := Hi - 48;
  if Lo > 57 then Lo := Lo - 55 
  else 
    Lo := Lo - 48;
  Result := 16 * Hi + Lo
end;

function HexStrCodeToStr(Value: string): string;
var
  i: Integer;
begin
  I      := 1;
  Result := '';
  repeat
    Result := Result + chr(Hex2Dec(Copy(Value, I, 2)));
    Inc(I, 2);
  until I > Length(Value);
end;

function UniCodeToStr(Value: string): string;
var
  I: Integer;
  function HexToStr: string;
  begin
    Result := chr(Hex2Dec(Copy(Value, I + 1,2)));
    Inc(I, 2);
  end;
begin
  I      := 1;
  Result := '';
  try
    repeat
      if Value[I] = '%' then Result := Result + HexToStr
      else 
        Result := Result + Value[I];
      Inc(I);
    until I > Length(Value);
  except
    Result := '';
  end;
end;

function Verschluessel(Value: string; Schl: TVerSchluesselArt): string;
var
  I, J: Integer;
  SKey1: Int64;
begin
  Result := '';
  SKey1  := SKey;
  J      := 1;
  for I := 1 to Length(Value) do
  begin
    case Schl of
      sUniCode: Result   := Result + CharToUniCode(Char(Byte(Value[I]) xor
                Byte(SchluesselSatz[J]) xor (SKey1 shr 16)));
      sHexCode: Result   := Result + CharToHexStr(Char(Byte(Value[I]) xor
                Byte(SchluesselSatz[J]) xor (SKey1 shr 16)));
      sNormalStr: Result := Result + Char(Byte(Value[I]) xor
                Byte(SchluesselSatz[J]) xor (SKey1 shr 16));
    end;

    SKey1 := (Byte(SchluesselSatz[J]) + SKey1) * MKey + AKey;
    Inc(J);
    if J > Length(SchluesselSatz) then J := 1;
  end;
end;

function Entschluessel(Value: string): string;
var
  I, J: Integer;
  SKey1: Int64;
begin
  Result := '';
  SKey1  := SKey;
  J      := 1;
  for I := 1 to Length(Value) do
  begin
    Result := Result + Chr(Ord(Value[I]) xor (Byte(SchluesselSatz[J]) xor (SKey1 shr 16)));
    SKey1  := (Byte(SchluesselSatz[J]) + SKey1) * MKey + AKey;
    Inc(J);
    if J > Length(SchluesselSatz) then J := 1;
  end;
end;

function VerEntschluesseln(Value: string; Flag: Boolean;
  Schl: TVerSchluesselArt): string;
begin
  if Flag then Result := Verschluessel(Value, Schl)
  else 
  begin
    case Schl of
      sUniCode: Result   := Entschluessel(UniCodeToStr(Value));
      sHexCode: Result   := Entschluessel(HexStrCodeToStr(Value));
      sNormalStr: Result := Entschluessel(Value);
    end;
  end;
end;

function DateiVerEndSchluesseln(QuellDateiname, ZielDateiname: string): Boolean;
var
{$I-}
  Gelesen: Integer;
  Quelle, Ziel: file;
  Buf: array [0..65535] of Byte;

  procedure Coder(I: Integer);
  var
    J: Integer;
    SKey1: Int64;
  begin
    SKey1 := SKey;
    J     := 1;
    for I := 0 to I do
    begin
      Buf[I] := Buf[I] xor Byte(SchluesselSatz[J]) xor (SKey1 shr 16);
      SKey1  := (Byte(SchluesselSatz[J]) + SKey1) * MKey + AKey;
      Inc(J);
      if J > Length(SchluesselSatz) then J := 1;
    end;
  end;
  {$I+}
begin
  AssignFile(Quelle, QuellDateiname);
  {$I-}
  reset(Quelle, 1);
  {$I+}
  Result := not Boolean(ioResult);
  if not Result then  Exit;

  AssignFile(Ziel, ZielDateiname);

  {$I-}
  reWrite(Ziel, 1);
  {$I+}
  Result := not Boolean(ioResult);
  if not Result then  Exit;

  Sleep(1300);

  {$I-}
  blockRead(Quelle, Buf, SizeOf(Buf), Gelesen);
  {$I+}
  while Gelesen <> 0 do
  begin
    Coder(Gelesen);
    blockWrite(Ziel, Buf, Gelesen);
    blockRead(Quelle, Buf, SizeOf(Buf), Gelesen);
  end;
  {$I-}
  CloseFile(Quelle);
  CloseFile(Ziel);
  {$I+}
end;

var
  I, J: Integer;
  C1, C2: Char;

initialization
  begin
    {$I-}
    SchluesselSatz := '';
    RandSeed       := CRandSeed;
    for I := 0 to 255 do
      for J := 1 to 255 do SchluesselSatz := SchluesselSatz + chr(J);
    for I := 1 to Length(SchluesselSatz) do
    begin
      J  := Random(Length(SchluesselSatz)) + 1;
      C1 := SchluesselSatz[J];
      C2 := SchluesselSatz[I];
      SchluesselSatz[I] := C1;
      SchluesselSatz[J] := C2;
    end;
    {$I+}
    Randomize;
  end;
end.

Unit1 :

uses CoderDeCoder

//

// Crypt Unicode
procedure TForm1.Button1Click(Sender: TObject);
var
  VerSch, EntSch: string;
begin
  VerSch := Memo1.Text;
  VerSch := VerEntschluesseln(VerSch, True, sUniCode);
  Memo1.Text := VerSch;
end;

// Decrypt Unicode
procedure TForm1.Button4Click(Sender: TObject);
var
  VerSch, EntSch: string;
begin
  EntSch := Memo1.Text;
  EntSch := VerEntschluesseln(EntSch, False, sUniCode);
  Memo1.Text := EntSch;
end;

// Crypt UnicodeHEX
procedure TForm1.Button5Click(Sender: TObject);
var
  VerSch, EntSch: string;
begin
  VerSch := Memo1.Text;
  VerSch  := VerEntschluesseln(VerSch,true,sHexCode);
  Memo1.Text := VerSch;
end;

// // Decrypt UnicodeHEX
procedure TForm1.Button6Click(Sender: TObject);
var
  VerSch, EntSch: string;
begin
  EntSch := Memo1.Text;
  EntSch  := VerEntschluesseln(EntSch,false,sHexCode);
  Memo1.Text := EntSch;
end;

Die Library ist auch in der Lage, Dateien zu verschlüsseln, was sie auch erfolgreich erledigt, nur erzeugt sie einen Zugriffsfehler, den ich bis heute nicht beseitigen konnte. Der Zugriffsfehler entsteht wirklich bei allen Compilern, die ich angewendet habe. 

Hier ist der Code für die Dateiverschlüsselung und Entschlüsselung, vielleicht hat ein anderer mehr Glück als ich.

// Datei Crypt
procedure TForm1.Button2Click(Sender: TObject);
begin
  if OpenDialog1.Execute then begin
  if not DateiVerEndSchluesseln(OpenDialog1.FileName,
                         OpenDialog1.FileName + '.decrypt')
  then
  ShowMessage('Decrypt failed..');
  end;
end;

// Datei Decrypt
procedure TForm1.Button3Click(Sender: TObject);
begin
  if OpenDialog1.Execute then begin
  DateiVerEndSchluesseln(OpenDialog1.FileName, OpenDialog1.FileName + '.crypt');
  end;
end;