Delphi source codes

CryptoGear encryption algorithm

Delphi version

My own encryption cipher.
Designed to be simple and fast, while providing a decent level of security.
It is a symmetric-key block cipher, which can operate in ECB or CBC mode.
Particularities of this block cipher include the fact that it doesn’t produce padding, so the size of plain-text and cipher-text will be always the same, and doesn’t need to be a multiple of the block size.
You can imagine it’s mechanism like a bycicle gear. The gear is the keystream, while the chain that slides though the gear is the data to be crypted. Each gear cog and chain ring rapresents a byte.

When initializing cipher, a unique keystream is generated, based on provided key and initialization vector.

So each tooth of our gear can be different and is generated depending on the key we choose.

Each time a gear cog passes on the data, data gets changed.
In CBC mode, the tooth of the gear gets changed too each time it encrypts a byte.

This way, on each round the gear (keystream) will be very different from the previous one, and will crypt the block in a different way (even if block data is identical to the one of previous round).

You can find also C++ version of the same algorithm.

CryptoGear source and Delphi full sample, a file crypter.
You can encrypt any file to protect it, and it is possible to decrypt it only if using same key, mode of operation and initialization vector.

Download “CryptoGear Delphi” CryptoGear-Delphi.zip – Downloaded 487 times – 251 KB

unit uCryptoGear;

{*****************************************************************************
*
*  CryptoGear Encryption Algorithm v1.0
*  Delphi version
*
*	 Author: Viotto
*	 Official website: Breaking-Security.Net
*
*	 This algorithm and code can be freely used,
*	 as long as you keep reference and credit to author and website.
*
******************************************************************************}

interface

const
  MODE_ECB = 0;
  MODE_CBC = 1;
  g_lenKeystream = 256;

type
  TByteArray = array of Byte;

  CCryptoGear = class
  private
    m_KeyStream: array[0..g_lenKeystream-1] of Byte;
    m_InitializationVector: Byte;
    m_ModeOfOperation: Byte;
  public
    constructor Initialize(sKey: AnsiString; ModeOfOperation: Byte = MODE_CBC; InitializationVector: Byte = 0);
    procedure Encrypt(var pData: TByteArray); overload;
    procedure Decrypt(var pData: TByteArray); overload;
    function Encrypt(sData: AnsiString): AnsiString; overload;
    function Decrypt(sData: AnsiString): AnsiString; overload;
end;


implementation


constructor CCryptoGear.Initialize(sKey: AnsiString; ModeOfOperation: Byte = MODE_CBC; InitializationVector: Byte = 0);
var
  pKey: TByteArray;
  i, lenKey: Cardinal;
begin
  m_ModeOfOperation := ModeOfOperation;
  lenKey := Length(sKey);
  SetLength(pKey, lenKey);
  Move(sKey[1], pKey[0], lenKey);

  for i := 0 to g_lenKeystream - 1 do
  begin
    m_KeyStream[i] := (i + InitializationVector) mod 256;
  end;

  for i := 0 to (g_lenKeystream - 1) do
  begin
    // xor initial keystream element value(0 - 255) with corresponding byte from key offset
    m_KeyStream[i] := (m_KeyStream[i] xor (lenKey + pKey[i mod lenKey])) mod 256;
  end;
end;


function CCryptoGear.Encrypt( sData: AnsiString): AnsiString;
var
  pData: TByteArray;
  lenData: Cardinal;
begin
  lenData := Length(sData);
  SetLength(pData, lenData);
  Move(sData[1], pData[0], lenData);
  Encrypt(pData);
  SetString(sData, PAnsiChar(@pData[0]), lenData);
  Result := sData;
end;


function CCryptoGear.Decrypt( sData: AnsiString): AnsiString;
var
  pData: TByteArray;
  lenData: Cardinal;
begin
  lenData := Length(sData);
  SetLength(pData, lenData);
  Move(sData[1], pData[0], lenData);
  Decrypt(pData);
  SetString(sData, PAnsiChar(@pData[0]), lenData);
  Result := sData;
end;


procedure CCryptoGear.Encrypt( var pData: TByteArray);
var
  lenData, Offset: Cardinal;
  i: Cardinal;
  KeyStream: array[0..g_lenKeystream-1] of Byte;
  extra: Byte;
begin
  Offset := 0;
  lenData := Length(pData);

  //Create a local copy of the original KeyStream.
  for i := 0 to g_lenKeystream - 1 do
  begin
    KeyStream[i] := m_KeyStream[i];
  end;

  // Calculate padding
  extra := lenData mod 4;
  // If plain-text data size is not a multiple of block size,
  // then we must add a temporary padding (will be removed after finishing encrypting)
  if (extra > 0) then
  begin
    extra := 4 - extra;
    lenData := lenData + extra;
    SetLength(pData, lenData);
  end;

  //Encrypt the data.
  repeat
    pData[Offset]                   :=  pData[Offset] xor KeyStream[Offset mod g_lenKeystream];
    pData[(Offset + 1) mod lenData] := (pData[(Offset + 1) mod lenData] +  pData[Offset] + KeyStream[ (Offset + 1) mod g_lenKeystream]) mod 256;
    pData[(Offset + 2) mod lenData] := Byte(pData[(Offset + 2) mod lenData] + (pData[(Offset + 1) mod lenData] - KeyStream[ (Offset + 2) mod g_lenKeystream]) mod 256);
    pData[(Offset + 3) mod lenData] := (pData[(Offset + 3) mod lenData] + (pData[(Offset + 2) mod lenData] xor KeyStream[ (Offset + 3) mod g_lenKeystream])) mod 256;

    if (m_ModeOfOperation = MODE_CBC) then
    begin

      if (Offset > 0) then
      begin
      // xor block with previous block.
        pData[Offset]                   := (pData[Offset] xor pData[(Offset - 4) mod lenData]) mod 256;
        pData[(Offset + 1) mod lenData] := (pData[(Offset + 1) mod lenData] xor pData[(Offset - 3) mod lenData]) mod 256;
        pData[(Offset + 2) mod lenData] := (pData[(Offset + 2) mod lenData] xor pData[(Offset - 2) mod lenData]) mod 256;
        pData[(Offset + 3) mod lenData] := (pData[(Offset + 3) mod lenData] xor pData[(Offset - 1) mod lenData]) mod 256;
      end;

      // keystream elements used in this block are shifted.
      // This way on next key round the corresponding keystream byte will be different.
      for i := 0 to 3 do
      begin
        KeyStream[(Offset + i) mod g_lenKeystream] := Byte(KeyStream[(Offset + i) mod g_lenKeystream] + pData[(Offset + i) mod lenData] mod 256);
      end;
    end;
    Inc(Offset, 4);
  until Offset >= lenData;

  // Remove padding.
  if (extra > 0) then
  begin
    lenData := lenData - extra;
    setlength(pData, lenData);
  end;
end;


procedure CCryptoGear.Decrypt( var pData: TByteArray);
var
  KeyStream: array[0..g_lenKeystream-1] of Byte;
  lenData, Offset: Cardinal;
  extra     : Byte;
  a, b, c, d: Byte;
  e, f, g, h: Byte;
  i, j, k   : Byte;
begin
  Offset := 0;
  lenData := Length(pData);

  //Create a local copy of the original KeyStream.
  for i := 0 to g_lenKeystream -1 do
  begin
    KeyStream[i] := m_KeyStream[i];
  end;

  // Calculate padding
  extra := lenData mod 4;
  // If plain-text data size is not a multiple of block size,
  // then we must add a temporary padding (will be removed after finishing encrypting)
  if (extra > 0) then
  begin
    extra := 4 - extra;
    lenData := lenData + extra;
    SetLength(pData, lenData);
  end;

  //Decrypt the data.
  repeat

    if m_ModeOfOperation = MODE_CBC then
    begin
      // Save original encrypted bytes, used for key shifting later
      a := pData[Offset];
      b := pData[(Offset + 1) mod lenData];
      c := pData[(Offset + 2) mod lenData];
      d := pData[(Offset + 3) mod lenData];

      // Do from second cycle
      if (Offset > 0) then
      begin
        // xor block with previous block
        pData[Offset] :=  pData[Offset] xor e ;
        pData[(Offset + 1) mod lenData] := pData[(Offset + 1) mod lenData] xor f ;
        pData[(Offset + 2) mod lenData] := pData[(Offset + 2) mod lenData] xor g ;
        pData[(Offset + 3) mod lenData] := pData[(Offset + 3) mod lenData] xor h ;
      end;

      // Store encrypted bytes of this block for next cycle
      e := a;
      f := b;
      g := c;
      h := d;
    end;

    // Save xored bytes (or original encrypted bytes if we are using ECB).
    // With those we can shift back keystream operations and obtain clear-text.
    i := pData[Offset];
    j := pData[(Offset + 1) mod lenData];
    k := pData[(Offset + 2) mod lenData];

    pData[Offset]                   := pData[Offset] xor KeyStream[Offset mod g_lenKeystream];
    pData[(Offset + 1) mod lenData] := Byte(pData[(Offset + 1) mod lenData] - (i  + KeyStream[(Offset + 1) mod g_lenKeystream]) mod 256);
    pData[(Offset + 2) mod lenData] := Byte(pData[(Offset + 2) mod lenData] - (j  - KeyStream[(Offset + 2) mod g_lenKeystream]) mod 256);
    pData[(Offset + 3) mod lenData] := Byte(pData[(Offset + 3) mod lenData] - (k xor KeyStream[(Offset + 3) mod g_lenKeystream]) mod 256);

    if m_ModeOfOperation = MODE_CBC then
    begin
      // Values of KeyStream elements used in this block are modified.
      // This way on each key round the corresponding key byte will be different.
      KeyStream[Offset mod g_lenKeystream]       := Byte(KeyStream[Offset mod g_lenKeystream]       + a);
      KeyStream[(Offset + 1) mod g_lenKeystream] := Byte(KeyStream[(Offset + 1) mod g_lenKeystream] + b);
      KeyStream[(Offset + 2) mod g_lenKeystream] := Byte(KeyStream[(Offset + 2) mod g_lenKeystream] + c);
      KeyStream[(Offset + 3) mod g_lenKeystream] := Byte(KeyStream[(Offset + 3) mod g_lenKeystream] + d);
    end;
    Inc(Offset, 4);
  until Offset >= lenData;

  // Remove padding.
  if (extra > 0) then
  begin
    lenData := lenData - extra;
    setlength(pData, lenData);
  end;
end;


end.

Inter-process communication using Windows named pipes

This sample is intended to show a method to make different processes communicate and exchange data among them.
A thanks goes to Peter Bloomfield, who wrote a nice tutorial about Windows pipes in C++.

program PipeServer;

// Server application which creates an inbound pipe and waits for data from client processes.

{$APPTYPE CONSOLE}

uses

  SysUtils,

  Windows;

procedure ReceivePipeData();

var

  pipe: Cardinal;

  RecBuffer: Array[0..999] of Byte;

  numBytesRead: DWORD;

  result: LongBool;

  sReadData: AnsiString;

  sa: SECURITY_ATTRIBUTES;

  sd: SECURITY_DESCRIPTOR;

begin

  // Must grant access rights in case User Account Control is on, on WinVista and above,

  // and communicating processes are under a different user (which can be also SYSTEM).

  // Otherwise, the other side of the pipe will receive ERROR_ACCESS_DENIED upon CreateFile().

  // If UAC is on and we are trying to use pipe between a userlevel and a system process,

  // even if we are inside the same user account, pipe communication will fail.

  // In order to avoid this, we must initialize a security descriptor for the pipe.

  InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION);

  // There is an important difference between an empty and a nonexistent DACL.

  // When a DACL is empty, it contains no access control entries (ACEs); therefore, no access 

     rights are explicitly granted.

  // As a result, access to the object is implicitly denied.

  // When an object has no DACL (when the pDacl parameter is NULL),

  // no protection is assigned to the object, and all access requests are granted.

  SetSecurityDescriptorDacl(@sd, True, nil, False);

  sa.bInheritHandle := false;

  sa.lpSecurityDescriptor := @sd;

  sa.nLength := sizeof(sa);

  while true do begin

    repeat

      // Create a new pipe to receive data

      pipe := CreateNamedPipe(

         '\\.\pipe\SamplePipe', // Our pipe name

         PIPE_ACCESS_INBOUND, // Read-only pipe

         PIPE_TYPE_MESSAGE or PIPE_READMODE_MESSAGE, //Using Message mode

         PIPE_UNLIMITED_INSTANCES ,

         0,  // No outbound buffer

         0,  // No inbound buffer

         0,  // Use default wait time

         @sa // Set security attributes to grant access rights

      );

      if (pipe = INVALID_HANDLE_VALUE) then begin

        Write('[ERROR] Failed to create pipe. Error code ' + IntToStr(GetLastError()) + #13#10 + 

              'Press Enter to retry');

        Readln;

      end;

    until pipe <> INVALID_HANDLE_VALUE;

    WriteLn('[INFO] Inbound pipe created! Waiting for a client process to connect...');

    // This call blocks until a client process connects to the pipe

    result := ConnectNamedPipe(pipe, nil);

    if (result = false) then begin

      Writeln('[ERROR] Failed to connect to pipe. Error code ' + IntToStr(GetLastError()));

    end

    else begin

      Writeln('[INFO] Client connected! Waiting for data...');

      numBytesRead := 0;

      // The read operation will block until there is data to read

      result := ReadFile(

          pipe,

          RecBuffer[0], // The data from the pipe will be put here

          sizeof(RecBuffer), // Number of bytes allocated

          numBytesRead, // This will store number of bytes actually read

          nil // Not using overlapped IO

      );

      if (result = false) then begin

          Writeln('[ERROR] Failed to read pipe data! Error code ' + IntToStr(GetLastError()));

      end else begin

          SetString(sReadData,PAnsiChar(@recBuffer[0]), numBytesRead); //Copy byte array to string

          Writeln('[SUCCESS] Data received: ' + sReadData);

      end;

    end;

    //Close our pipe handle

    CloseHandle(pipe);

  end;

end;

//Program start procedure

begin

  Writeln('*** Pipe Server Application ***' + #13#10);

  Write('[INFO] Press Enter to create pipe server and start listening for incoming data');

  ReadLn;

  ReceivePipeData();

end.

program PipeClient;
// Client application which sends data to pipe server.

{$APPTYPE CONSOLE}

uses
SysUtils,
Windows,
Classes;

// Data to send via pipe is read from a file.
function GetDataFromFile(sFileName: AnsiString): AnsiString;
var
DataFile: TFileStream;
ReadBuffer: array of Byte;
sDataToSend: AnsiString;
begin
  try
    DataFile := TFileStream.Create( sFileName , fmOpenRead);
    SetLength(ReadBuffer, DataFile.Size);
    DataFile.Read(ReadBuffer[0], Length(ReadBuffer));
    SetString(sDataToSend,PAnsiChar(@ReadBuffer[0]), DataFile.Size); //Copy byte array to string
    DataFile.Free;
    Result := sDataToSend;
  except
    Result := '';
  end;
end;

procedure SendPipeData();
var
pipe: Cardinal;
numBytesWritten: DWORD;
result: LongBool;
sDataToSend: AnsiString;
begin
  repeat
    // Open the named pipe, previusly created by server application
    pipe := CreateFile(
    '\\.\pipe\SamplePipe', // Our pipe name
    GENERIC_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE,
    nil,
    OPEN_EXISTING,
    FILE_ATTRIBUTE_NORMAL,
    0
    );
    if (pipe = INVALID_HANDLE_VALUE) then begin
      Write('[ERROR] Failed to open pipe (server must be running first).' + #13#10 + 'Press Enter to 
      retry');
      Readln;
    end;
  until pipe <> INVALID_HANDLE_VALUE;

  repeat
    //Get data to send from file
    sDataToSend := GetDataFromFile(ExtractFilePath(ParamStr(0)) + 'DataToSend.txt');
    if sDataToSend = '' then begin
      Write('[ERROR] Unable to read data from file (may be unexistent or empty).' + #13#10 + 'Press
      Enter to retry');
      Readln;
    end;
  until sDataToSend <> '';

  numBytesWritten := 0;
  result := WriteFile(
  pipe, // Handle to our outbound pipe
  sDataToSend[1], // Pointer to data to send
  Length(sDataToSend), // Length of data to send (bytes)
  numBytesWritten, // Will store actual amount of data sent
  nil // Not using overlapped IO
  );

  if (result = false) then
    Writeln('[ERROR] Failed to send pipe data. Error code ' + IntToStr(GetLastError()))
  else Writeln('[SUCCESS] Pipe data sent: ' + sDataToSend);

  // Close the pipe handle
  CloseHandle(pipe);
end;

//Program start procedure
begin
  Writeln('*** Pipe Client Application ***' + #13#10);
  while true do begin
    Write('[INFO] Press Enter to send pipe data to server');
    Readln;
    SendPipeData();
  end;
end.

Download “Interprocess communication sample (Delphi)” Pipe-Sample-Delphi.zip – Downloaded 140 times – 75 KB