[Back to ENCRYPT SWAG index]  [Back to Main SWAG index]  [Original]

{   AUTHOR:  Trevor J Carlsen  Copyright 1992. All rights reserved.
             PO Box 568
             Port Hedland WA 6721
             Telephone (091) 73-2026

    This program has been written to demonstrate the coding and decoding
    of a file.

    SYNTAX:   codechal password1 password2 infile outfile

    All four parameters are required.
    The passwords are case sensitive.

    Whilst this program was written purely for the purposes of a challenge
    issued in the Oz Pascal echo, it would not be difficult to upgrade it to
    a commercial grade encryption/decryption utility - there several very
    simple changes to enhance the security of the cypher output. As written it
    will only encrypt or decrypt the first 4096 bytes of a file.  If you wish
    to use the code here as a basis for a commercial product, contact the
    author for details.

    Some may scoff at its simplicity; I say; solve the challenge, then you
    will have the right to call it simple.  You have the tools, this source
    code gives the full details of the encrypting/decrypting algorithm used.

}


const
  TextSize  = 4096;

type
  buff_type = array[1..TextSize] of byte;


var
  encrypt   : boolean;
  InFile,
  OutFile   : file;
  c,
  BytesRead : word;
  b         : byte;
  key       : array[1..2] of buff_type;
  FileBuff  : buff_type;
  password  : array[1..2] of string;

procedure Hash(p : pointer; numb : byte; var result: longint);
  { When originally called numb must be equal to sizeof    }
  { whatever p is pointing at.  If that is a string numb   }
  { should be equal to length(the_string) and p should be  }
  { ptr(seg(the_string),ofs(the_string)+1)                 }
  var
    temp,
    w    : longint;
    x    : byte;

  begin
    temp := longint(p^);  RandSeed := temp;
    for x := 0 to (numb - 4) do begin
      w := random(maxint) * random(maxint) * random(maxint);
      temp := ((temp shr random(16)) shl random(16)) +
                w + MemL[seg(p^):ofs(p^)+x];
    end;
    result := result xor temp;
  end;  { Hash }

procedure CreateKey;
  { Creates the "keys" that are used to xor with the data being encrypted }
  { decrypted.                                                            }
  var
    StrPtr    : pointer;
    count,x   : word;
  begin
    FillChar(key,sizeof(key),0);
    for x := 1 to 2 do begin
      StrPtr := ptr(Seg(password[x]),Ofs(password[x])+1);
      Hash(StrPtr,length(password[x]),RandSeed);
      for count := 1 to TextSize do
        key[x,count] := key[x,count] xor random(256);
    end;
  end;

procedure Initialise;
  var st1,st2 : string[18];
  begin
    writeln('CODECHAL - copyright 1992, Trevor Carlsen. All rights
reserved.');    if ParamCount <> 4 then begin
      writeln('This program has been written to demonstrate the coding and
deco      writeln('of a file.');
      writeln;
      writeln('SYNTAX:   codechal password1 password2 infile outfile');
      writeln;
      writeln('All four parameters are required.');
      writeln('The passwords are case sensitive.');
      writeln;
      halt;
    end;
    password[1] := ParamStr(1);
    password[2] := ParamStr(2);
    if (length(password[1]) < 8)  or (length(password[2]) < 8) then begin
      writeln('Passwords must be at least 8 characters...aborting');
      halt;
    end;
    {$I-}
    assign(InFile,Paramstr(3));
    reset(InFile,1);
    assign(OutFile,Paramstr(4));
    rewrite(OutFile,1);
    if IOResult <> 0 then begin
      writeln('I/O error opening files');
      halt;
    end;
    BlockRead(InFile,FileBuff,TextSize,BytesRead);
    if IOResult <> 0 then begin
      writeln('I/O error reading file');
      halt;
    end;
  end;

procedure CodeDeCodeBuffer(var buffer: buff_type; c: word);
  var x: word;
  begin
    for x := 1 to BytesRead do
      buffer[x] := buffer[x] xor key[c,x];
  end;

begin
  Initialise;
  CreateKey;
  writeln('Working...wait');
  for c := 1 to 2 do
    CodeDecodeBuffer(FileBuff,c);
  BlockWrite(OutFile,FileBuff,BytesRead);
  close(InFile);
  close(OutFile);
end.

[Back to ENCRYPT SWAG index]  [Back to Main SWAG index]  [Original]