unit CoderDeCoder;
{$X+}
interface
type
TVerSchluesselArt = (sUniCode, sHexCode, sNormalStr);
Str002 = string[2];
const
CRandSeed: Int64 = 258974566;//Beispiel
SKey: Int64 = 458795222;
MKey: Int64 = 123456899;
AKey: Int64 = 12345685525;
function VerEntschluesseln(Value: string; Flag: Boolean;
Schl: TVerSchluesselArt): string;
function DateiVerEndSchluesseln(QuellDateiname, ZielDateiname: string): Boolean;
{Folgen Function globalisiert muß aber nicht***********************************}
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';
// Da ich nicht genau weiß welche Zeichen bei, z.B. der Übertragung zum I-Net codiert werden
// habe ich nur die genommen, von denen ich vermute das sie nicht codiert werden.
// Wer möchte kann "Chs" vervollständigen. Alle Zeichen in Chs werden "nicht" hex-codiert.
// bei A..Z wird automatisch die Groß- und Kleinschrift "nicht" hex-codiert
// Die Funktion:
// function StrToUniCode(Value:string):string; und
// function UniCodeToStr(Value:string):string;
// machen es daher möglich Strings ins I-Net zu übertragen
// Die Umwandlung in String-Hex-Zahlen muß stattfinden weil sonst wenn z.B. #0 auftaucht der
// String dort abgeschnitten werden würde. *g
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
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;
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;
blockRead(Quelle, Buf, SizeOf(Buf), Gelesen);
while Gelesen <> 0 do
begin
Coder(Gelesen);
blockWrite(Ziel, Buf, Gelesen);
blockRead(Quelle, Buf, SizeOf(Buf), Gelesen);
end;
CloseFile(Quelle);
CloseFile(Ziel);
end;
{initialization****************************************************************}
var
I, J: Integer;
C1, C2: Char;
initialization
begin
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;
Randomize;
end;
end.Beispiele:
//------------------------------------------------------------------------------
procedure TMain.Button1Click(Sender: TObject);
var
VerSch, EntSch: string;
begin
VerSch := 'Ich bin ein Test';
//Möglichkeit 1 (Wegen der Null-Byte muß eine Umwandlung Stattfinden) Ini Daten wäre eine Anwendung}
// VerSch := VerEntschluesseln(VerSch,true,sHexCode);
// EntSch := VerEntschluesseln(VerSch,false,sHexCode);
//Möglichkeit 2 z.B. für metohde Post bei Html-Sachen}
VerSch := VerEntschluesseln(VerSch, True, sUniCode);
EntSch := VerEntschluesseln(VerSch, False, sUniCode);
// Möglichkeit 3 (Macht aber nicht wirklich Sinn wegen dem Auftreten von ggf. Null-Byte
// ein Memofeld/TString würde den Text nach #0 abschneiden
// VerSch := VerEntschluesseln(VerSch,true,sNormalStr);
// EntSch := VerEntschluesseln(VerSch,false,sNormalStr);
Memo1.Text := EntSch;
Memo2.Text := VerSch;
end;
//------------------------------------------------------------------------------
procedure TMain.Button2Click(Sender: TObject);
begin
{Die Dateilänge wird nicht länger
Tipp: Vorher, NICHT nachher die Datei Zippen dann wird sie noch unleserlicher und kleiner *g
5 MB dauern selbst mit einem Schwachen Rechner unter 1 sek}
DateiVerEndSchluesseln('Quelle.mpg', 'Ziel1.txt'); // Verschlüssen
DateiVerEndSchluesseln('Ziel1.txt', 'Ziel2.txt'); // und wieder Endschlüssen
end;