this slowpoke moves

Random File Crypter

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

Beliebte Posts

Translate