unit crypt;
{$I define.pas}
{$Q-,R-}
{$IFNDEF CRYPT}
{$I nodebug.pas}
{$ENDIF}

interface
uses mylib, {drivers, app, }objects, dos, txgh, hcgh;
const
  InternalPassword = '%.^43rTz}@g*sD#1,p{-UfG<'; {used for encrypting of user passwords
        added to the begining of encrypted file}

{TEncrypt.Status error values:}
  encKeyFileNotFound   = -1;
  encKeyFileReadError  = -2;
  encKeyFileAccesError = -3;
  encOutOfMemory       = -4;
  encMixedEncryptCalls = -5; {both decrypt and encrypt methods called
                           between init and done}
  encEmptyPassword     = -6; {init called with akey empty}


type


  TPasswordString = string[MaxPasswordLen];
  PPasswordString = ^TPasswordString;

  PEncrypt = ^TEncrypt;
  TEncrypt = object (TObject)
    OrigRandSeed, CurrentSeed: Longint;
    Encrypting:byte; {0 at the beginning, 1 for encryption, 2 for decryption,
                     doesn't matter what it is, for current encryption method,
                     but should warn user if he calls both encrypt and decrypt
                     methods between init and done by setting status to mixedcalls}
    Key: TPasswordString;
    KeyFileName: PathStr;
    KeyFile: File;
    Status:integer;{set to 0 in init, set to errors during processing}
    KeyBuffer : PByteBuffer;
    BufferSize,
    KeyFileSize,
    KeyFilePos: LongInt;

    constructor Init(AKey:PathStr; AKeyFile: boolean);
     {initialize password or password file(if AKeyFile is true)}
    procedure Encrypt(var Data; DataLen:word);
    procedure Decrypt(var Data; DataLen:word);
    procedure Seek(L:Longint); {set random value to value, which would be
                               obtained after L encrypted bytes ater init}
    destructor Done;virtual;

    private
    procedure Error(ErrorCode:Integer);{set status, inform user}
    procedure DoIt(var Data; DataLen:word);
  end;

const
  CyclusLen = 3;{doporuceni delkacykl<mindelkahesla}

{Program encrypt;}
{ Author Trevor J Carlsen - released into the public domain 1992         }
{        PO Box 568                                                      }
{        Port Hedland                                                    }
{        Western Australia 6721                                          }
{        Voice +61 91 73 2026  Data +61 91 73  2569                      }
{        FidoNet 3:690/644                                               }

{ Syntax: encrypt /p=PassWord /k=KeyFile /f=File                         }
{ Example -                                                              }
{         encrypt /p=billbloggs /k=c:\command.com /f=p:\prog\anyFile.pas }

{         PassWord can be any alpha-numeric sequence of AT LEAST four    }
{         Characters.                                                    }

{         KeyFile is the full path of any File on the system that this   }
{         Program runs on.  This File, preferably a large one, must not  }
{         be subject to changes.  This is critical as it is used as a    }
{         pseudo "one time pad" style key and the slightest change will  }
{         render decryption invalid.                                     }

{         File is the full path of the File to be encrypted or decrypted.}

{ notes:  Running Encrypt a second time With exactly the same parameters }
{         decrypts an encrypted File.  For total security the keyFile    }
{         can be stored separately on a floppy.  Without this keyFile or }
{         knowledge of its contents it is IMPOSSIBLE to decrypt the      }
{         encrypted File.                                                }

{         Parameters are Case insensitive and may be in any order and    }
{         may not contain any Dos separator Characters.                  }
implementation

Const
  BufferSize   = 12288;
  Renamed      : Boolean = False;


Var
  Encrypt: PEncrypt;
{  OldExitProc  : Pointer;}

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 := longint(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 NewExitProc; Far;
  { Does the "housekeeping" necessary on Program termination }
Var
  code : Integer;

begin
  ExitProc := OldExitProc;  { Reset Exit Procedure Pointer to original }
  Case ExitCode of
  0: Writeln('Successfully encrypted or decrypted ',FFName);
    1: begin
         Writeln('This Program requires 3 parameters -');
         Writeln('  /pPassWord');
         Writeln('  /kKeyFile (full path and name)');
         Write  ('  /fFile (The full path and name of the File');
         Writeln(' to be processed)');
         Writeln;
         Write  ('These parameters can be in any order, are Case,');
         Writeln(' insensitive, and may not contain any spaces.');
       end;
    2: Writeln('Could not find key File');
    3: Writeln('Could not rename and/or open original File');
    4: Writeln('Could not create encrypted File');
    5: Writeln('I/O error during processing - could not Complete');
    6: Writeln('Insufficient memory available');
    7: begin
         Writeln('Key  File is too small - aborted');
         Writeln;
         Writeln(' Key File must be at least as large as the buffer size ');
         Write  (' or the size of the File to be encrypted, whatever is the');
         Writeln(' smaller.');
       end;
    8: Writeln('PassWord must consist of at least 4 Characters');
    else { any other error }
      Writeln('Aborted With error ',ExitCode);
    end; { Case }
    if Renamed and (ExitCode <> 0) then
      Writeln(#7'WARNinG: original File''s name is now TEMP.$$$');
    {$I-}
    close(KeyFile); Code := Ioresult;
    close(NewFile); Code := Ioresult;
    close(OldFile); Code := Ioresult;
    if ExitCode = 0 then
      Erase(OldFile); Code := Ioresult;
    {$I+}
  end; { NewExitProc }

*)

constructor TEncrypt.Init(AKey: PathStr; AKeyFile: boolean);
var l:longint;
begin
  if not inherited init then
   fail;
  OrigRandSeed := RandSeed;
{  Encrypting:= 0; set in seek}
  Status:= 0;
{  RandSeed:=0; set in seek, global pascal var, equals to call randomize(0)}
  Key:= '';
  KeyFileName:= '';
  KeyFileSize:= 0;
{  KeyFilePos:= 0; set in seek}
  BufferSize:=0;
  KeyBuffer:=nil;

  if AKeyFile then begin
    assign(KeyFile,AKey);
    {$I-}reset(KeyFile,1);{$I-}
    if ioresult<>0 then begin
      Error(encKeyFileNotFound);
      exit;
    end;
    KeyFileName:= AKey;
    KeyFileSize:= FileSize(KeyFile);
    if KeyFileSize>BufferSize then KeyFileSize:= BufferSize;

    l:= MaxAvail - 4096;
    if l< KeyFileSize then begin
      Error(encOutOfMemory);
      exit;
    end;
    GetMem(KeyBuffer,KeyFileSize);
    {$I-}BlockRead(KeyFile, KeyBuffer^, KeyFileSize);{$I+}
    if ioresult<>0 then begin
      Error(encKeyFileReadError);
      exit;
    end;
  end else begin
    Key:= AKey;
    if Key='' then begin
      Error(encEmptyPassword);
      exit;
    end;
  end;
  Seek(0);
  RandSeed := OrigRandSeed;
end;

procedure TEncrypt.Seek(L: Longint);
var s:pathstr;r:word; old : Longint;
begin
  old := RandSeed;
  Encrypting:= 0;
  if Key = '' then begin
    RandSeed:= 0;
    if ((L < 0) and (KeyFilePos > 0)) then begin
      while L<0 do begin
        L := KeyFilePos + L;
      end;
    end else L:=0;
    KeyFilePos:= 0;
    while L>0 do begin
      r:=Random(256);
      inc(KeyFilePos);
      if KeyFilePos = KeyFileSize then KeyFilePos:= 0;
      dec(L);
    end;
  end else begin
    Hash(ptr(seg(Key),ofs(Key)+1),length(Key),RandSeed);
    while L>0 do begin r:=Random(256); dec(L); end;
  end;
  CurrentSeed := RandSeed;
  RandSeed := old;
end;

procedure TEncrypt.Encrypt(var Data; DataLen:word);
begin
  if Status<>0 then exit;
  if Encrypting = 0 then Encrypting:= 1 else if Encrypting = 2 then begin
    Error(encMixedEncryptCalls);
    exit;
  end;
  DoIt(Data, DataLen);
end;

procedure TEncrypt.Decrypt(var Data; DataLen:word);
begin
  if Status<>0 then exit;
  if Encrypting = 0 then Encrypting:= 2 else if Encrypting = 1 then begin
    Error(encMixedEncryptCalls);
    exit;
  end;
  DoIt(Data, DataLen);
end;

procedure TEncrypt.Error(ErrorCode:Integer);
var tx,hc:word; errproc:tencrypterrorprocedure absolute EncryptError;
begin
  Status:= ErrorCode;
{  if Desktop<>nil then begin}
    if EncryptError<>nil then
      ErrProc(ErrorCode);
{  end;}
end;

destructor TEncrypt.Done;
begin
  RandSeed:= OrigRandSeed;
  if Key='' then begin
    if Status <> encKeyFileNotFound then begin
      {$I-}close(KeyFile);{$I+}
      if ioresult<>0 then Error(encKeyFileAccesError);
      if KeyBuffer<>nil then FreeMem(KeyBuffer,KeyFileSize);
    end;
  end;
  inherited Done;
end;

procedure TEncrypt.DoIt(var Data; DataLen:word);
var buffer :TByteBuffer absolute Data;
    x: word;
    old : Longint;
begin
 { This is the actual encryption/decryption engine }
  old := RandSeed;
  RandSeed := CurrentSeed;
  if DataLen=0 then exit;
  for x := 0 to datalen - 1 do begin
    if Key='' then begin
      buffer[x] := buffer[x] xor KeyBuffer^[KeyFilePos] xor Random(256);
      inc(KeyFilePos);
      if KeyFilePos = KeyFileSize then KeyFilePos:= 0;
    end else begin
      buffer[x]:= buffer[x] xor Random(256);
    end;
  end;
  CurrentSeed := RandSeed;
  RandSeed := old;
end;


end.