Unit Cryptage.pas :
unit cryptage;
interface
uses SysUtils;
procedure RCrypter ( FichierSource: string; FichierDestination : String );
procedure RDecrypter( FichierSource: string; FichierDestination : String );
implementation
procedure RCrypter( FichierSource: string; FichierDestination : String );
var
BufSource : Array[1..4] of Char;
BufCrypte : Array[0..4] of Char;
SourceF, DestF : File;
CryptageKey : Byte;
Lu : Integer;
Ecrit : Integer;
i : Integer;
begin
Randomize;
Assign (SourceF, FichierSource);
Reset (SourceF, 1);
Assign (DestF, FichierDestination);
Rewrite(DestF, 1);
repeat
FillChar( BufSource, SizeOf(BufSource), #0 );
FillChar( BufCrypte, SizeOf(BufCrypte), #0 );
CryptageKey := Random(255);
BlockRead( SourceF, BufSource, SizeOf( BufSource ), Lu );
BufCrypte[0] := Chr( CryptageKey );
for i := 1 to Lu do
BufCrypte[i] := Chr( ( Ord( BufSource[i] ) xor CryptageKey ) + CryptageKey );
if Lu > 0 then BlockWrite( DestF, BufCrypte, Lu + 1, Ecrit );
until ( ( Lu = 0 ) or ( ( Lu + 1 )<> Ecrit ) );
Close( SourceF );
Close( DestF );
end;
procedure RDecrypter( FichierSource: string; FichierDestination : String );
var
BufCrypter : Array[0..4] of Char;
BufDecrypt : Array[1..4] of Char;
SourceF, DestF : File;
CryptageKey : Byte;
Lu : Integer;
Ecrit : Integer;
i : Integer;
begin
Assign (SourceF, FichierSource);
Reset (SourceF, 1);
Assign (DestF, FichierDestination);
Rewrite(DestF, 1);
repeat
FillChar( BufCrypter, SizeOf(BufCrypter), #0 );
FillChar( BufDecrypt, SizeOf(BufDecrypt), #0 );
BlockRead( SourceF, BufCrypter, SizeOf( BufCrypter ), Lu );
CryptageKey := Ord( BufCrypter[0] );
for i := 1 to (Lu - 1) do
BufDecrypt[i] := Chr( ( Ord( BufCrypter[i] ) - CryptageKey ) xor CryptageKey );
if Lu > 0 then BlockWrite( DestF, BufDecrypt, (Lu - 1), Ecrit );
until ( ( Lu <= 0 ) or ( (Lu - 1) <> Ecrit ) );
Close( SourceF );
Close( DestF );
end;
end.
Unit1 :
uses ExtCtrls, Cryptage
const
CAP_CRYPTER = 'Crypter';
CAP_DECRYPTER = 'Decrypter';
//
procedure TForm1.FormCreate(Sender: TObject);
begin
RadioGroup1.ItemIndex := 0;
Button2.Caption := CAP_CRYPTER;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if Trim(EditSource.Text) = '' then
begin
MessageBoxA( Handle, PChar('Please select a source file!'), PChar('Source file?'), MB_ICONEXCLAMATION );
Exit;
end;
if Trim(EditDestination.Text) = '' then
begin
MessageBoxA( Handle, PChar('Choose a path and file name to create!'), PChar('Encrypt where?'), MB_ICONEXCLAMATION );
Exit;
end;
if not FileExists( Trim(EditSource.Text) ) then
begin
MessageBoxA( Handle, PChar('The source file you provided does not exist!'), PChar('File does not exist!'), MB_ICONERROR );
Exit;
end;
Button2.Enabled := False;
EditSource.Enabled := False;
EditDestination.Enabled := False;
RadioGroup1.Enabled := False;
Button1.Enabled := False;
case RadioGroup1.ItemIndex of
0 : begin
RCrypter( EditSource.Text, EditDestination.Text );
end;
1 : begin
RDecrypter( EditSource.Text, EditDestination.Text );
end;
else
MessageBoxA( Handle, PChar('First select an action to perform (Encryption or decryption)!'), PChar('Attention'), MB_ICONEXCLAMATION );
end;
Button2.Enabled := True;
EditSource.Enabled := True;
EditDestination.Enabled := True;
RadioGroup1.Enabled := True;
Button1.Enabled := True;
MessageBoxA( Handle, PChar('Operation completed'), PChar('Ok'), MB_ICONINFORMATION );
end;
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
if RadioGroup1.ItemIndex = 0 then
Button2.Caption := CAP_CRYPTER
else
Button2.Caption := CAP_DECRYPTER;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
if Trim(OpenDialog1.FileName) <> '' then
EditSource.Text := OpenDialog1.FileName;
end;
end;
Keine Kommentare:
Kommentar veröffentlichen