Mega Code Archive
How to code and decode strings and files
<![CDATA[
Title: How to code and decode strings and files
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';
var
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';
Memo1.Text := EntSch;
Memo2.Text := VerSch;
end;
//------------------------------------------------------------------------------
procedure TMain.Button2Click(Sender: TObject);
begin
end;
]]>