home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / ENDECR / ENDECR.PAS
Pascal/Delphi Source File  |  1992-04-13  |  8KB  |  232 lines
  1. {$A+,B-,D-,E+,F-,G+,I+,L-,N-,O-,R-,S-,V-,X+}
  2. {$M 4048,0,131040}
  3. program encrypt;
  4.  
  5. { Author Trevor J Carlsen - released into the public domain 1992         }
  6. {        PO Box 568                                                      }
  7. {        Port Hedland                                                    }
  8. {        Western Australia 6721                                          }
  9. {        Voice +61 91 73 2026  Data +61 91 73  2569                      }
  10. {        FidoNet 3:690/644                                               }
  11.  
  12. { Syntax: encrypt /p=Password /k=Keyfile /f=File                         }
  13. { Example -                                                              }
  14. {         encrypt /p=billbloggs /k=c:\command.com /f=p:\prog\anyfile.pas }
  15.  
  16. {         Password can be any alpha-numeric sequence of AT LEAST four    }
  17. {         characters.                                                    }
  18.  
  19. {         Keyfile is the full path of any file on the system that this   }
  20. {         program runs on.  This file, preferably a large one, must not  }
  21. {         be subject to changes.  This is critical as it is used as a    }
  22. {         pseudo "one time pad" style key and the slightest change will  }
  23. {         render decryption invalid.                                     }
  24.  
  25. {         File is the full path of the file to be encrypted or decrypted.}
  26.  
  27. { Notes:  Running Encrypt a second time with exactly the same parameters }
  28. {         decrypts an encrypted file.  For total security the keyfile    }
  29. {         can be stored separately on a floppy.  Without this keyfile or }
  30. {         knowledge of its contents it is IMPOSSIBLE to decrypt the      }
  31. {         encrypted file.                                                }
  32.  
  33. {         Parameters are case insensitive and may be in any order and    }
  34. {         may not contain any dos separator characters.                  }
  35.  
  36. const
  37.   BufferSize   = 65520;
  38.   Renamed      : boolean = false;
  39.  
  40. type
  41.   buffer_      = array[0..BufferSize - 1] of byte;
  42.   buffptr      = ^buffer_;
  43.   str80        = string[80];
  44.  
  45. var
  46.   OldExitProc  : pointer;
  47.   KeyFile,
  48.   OldFile,
  49.   NewFile      : file;
  50.   KeyBuffer,
  51.   Buffer       : buffptr;
  52.   KeyFileSize,
  53.   EncFileSize  : longint;
  54.   Password,
  55.   KFName,
  56.   FFName       : str80;
  57.  
  58.  
  59. procedure Hash(p : pointer; numb : byte; var result: longint);
  60.   { When originally called numb must be equal to sizeof    }
  61.   { whatever p is pointing at.  If that is a string numb   }
  62.   { should be equal to length(the_string) and p should be  }
  63.   { ptr(seg(the_string),ofs(the_string)+1)                 }
  64.   var
  65.     temp,
  66.     w    : longint;
  67.     x    : byte;
  68.  
  69.   begin
  70.     temp := longint(p^);  RandSeed := temp;
  71.     for x := 0 to (numb - 4) do begin
  72.       w := random(maxint) * random(maxint) * random(maxint);
  73.       temp := ((temp shr random(16)) shl random(16)) +
  74.                 w + MemL[seg(p^):ofs(p^)+x];
  75.     end;
  76.     result := result xor temp;
  77.   end;  { Hash }
  78.  
  79. procedure NewExitProc; far;
  80.   { Does the "housekeeping" necessary on program termination }
  81.   var code : integer;
  82.   begin
  83.     ExitProc := OldExitProc;  { Reset exit procedure pointer to original }
  84.     case ExitCode of
  85.     0: writeln('Successfully encrypted or decrypted ',FFName);
  86.     1: begin
  87.          writeln('This program requires 3 parameters -');
  88.          writeln('  /pPassword');
  89.          writeln('  /kKeyFile (full path and name)');
  90.          write  ('  /fFile (The full path and name of the file');
  91.          writeln(' to be processed)');
  92.          writeln;
  93.          write  ('These parameters can be in any order, are case,');
  94.          writeln(' insensitive, and may not contain any spaces.');
  95.        end;
  96.     2: writeln('Could not find key file');
  97.     3: writeln('Could not rename and/or open original file');
  98.     4: writeln('Could not create encrypted file');
  99.     5: writeln('I/O error during processing - could not complete');
  100.     6: writeln('Insufficient memory available');
  101.     7: begin
  102.          writeln('Key  file is too small - aborted');
  103.          writeln;
  104.          writeln(' Key File must be at least as large as the buffer size ');
  105.          write  (' or the size of the file to be encrypted, whatever is the');
  106.          writeln(' smaller.');
  107.        end;
  108.     8: writeln('Password must consist of at least 4 characters');
  109.     else { any other error }
  110.       writeln('Aborted with error ',ExitCode);
  111.     end; { case }
  112.     if Renamed and (ExitCode <> 0) then
  113.       writeln(#7'WARNING: Original file''s name is now TEMP.$$$');
  114.     {$I-}
  115.     close(KeyFile); Code := IOResult;
  116.     close(NewFile); Code := IOResult;
  117.     close(OldFile); Code := IOResult;
  118.     if ExitCode = 0 then
  119.       Erase(OldFile); Code := IOResult;
  120.     {$I+}
  121.   end; { NewExitProc }
  122.  
  123.  
  124. function Str2UpCase(var S: string): string;
  125.   { Converts a string S to upper case.  Valid for English. }
  126.   var
  127.     x : byte;
  128.   begin
  129.     Str2UpCase[0] := S[0];
  130.     for x := 1 to length(S) do
  131.       Str2UpCase[x] := UpCase(S[x]);
  132.   end; { Str2UpCase }
  133.  
  134.  
  135. procedure Initialise;
  136.   var
  137.     CommandLine : string;
  138.     FPos,FLen,
  139.     KPos,KLen,
  140.     PPos,PLen   : byte;
  141.  
  142.   procedure  AllocateMemory(var p: buffptr; size: longint);
  143.     begin
  144.       if size < BufferSize then begin
  145.         if MaxAvail < size then halt(6);
  146.         GetMem(p,size);
  147.       end
  148.       else begin
  149.         if MaxAvail < BufferSize then halt(6);
  150.         new(p);
  151.       end;
  152.     end; { AllocateMemory }
  153.  
  154.   begin
  155.     FillChar(OldExitProc,404,0);       { Initialise all global variables }
  156.     FillChar(Password,243,32);
  157.     ExitProc    := @NewExitProc;             { Set up new exit procedure }
  158.     if ParamCount <> 3 then halt(1);
  159.     CommandLine := string(ptr(PrefixSeg,$80)^)+' '; { Add trailing space }
  160.     CommandLine := Str2UpCase(CommandLine);      { Convert to upper case }
  161.     PPos        := pos('/P=',CommandLine);     { Find password parameter }
  162.     KPos        := pos('/K=',CommandLine);      { Find keyfile parameter }
  163.     FPos        := pos('/F=',CommandLine); { Find filename for encryption}
  164.     if (PPos = 0) or (KPos = 0) or (FPos = 0) then    { Parameters wrong }
  165.       Halt(1);
  166.     FFName      := copy(CommandLine,FPos+3,80);
  167.     FFName[0]   := chr(pos(' ',FFName)-1);       { Correct string length }
  168.     KFName      := copy(CommandLine,KPos+3,80);
  169.     KFName[0]   := chr(pos(' ',KFName)-1);
  170.     Password    := copy(CommandLine,PPos+3,80);
  171.     Password[0] := chr(pos(' ',Password)-1);
  172.     if length(Password) < 4 then halt(8);
  173.     { Create a random seed value based on the password }
  174.     Hash(ptr(seg(Password),ofs(Password)+1),length(Password),RandSeed);
  175.     assign(OldFile,FFName);
  176.     {$I-}
  177.     rename(OldFile,'TEMP.$$$');        { Rename the file to be encrypted }
  178.     if IOResult <> 0 then halt(3) else renamed := true;
  179.     assign(OldFile,'TEMP.$$$');
  180.     reset(OldFile,1);
  181.     if IOResult <> 0 then halt(3);
  182.     assign(NewFile,FFName);
  183.     rewrite(NewFile,1);
  184.     if IOResult <> 0 then halt(4);
  185.     assign(KeyFile,KFName);
  186.     reset(KeyFile,1);
  187.     if IOResult <> 0 then halt(2);
  188.     EncFileSize := FileSize(OldFile);
  189.     KeyFileSize := FileSize(KeyFile);
  190.     if KeyFileSize > EncFileSize then KeyFileSize := EncFileSize;
  191.     if IOResult <> 0 then halt(5);
  192.     {$I+}
  193.     if (KeyFileSize < BufferSize) and (KeyFileSize < EncFileSize) then
  194. halt(7);
  195.     AllocateMemory(buffer,EncFileSize);
  196.     AllocateMemory(KeyBuffer,KeyFileSize);
  197.   end; { Initialise }
  198.  
  199. procedure Main;
  200.   var
  201.     BytesRead : word;
  202.     finished  : boolean;
  203.  
  204.   procedure CodeBuffer(number: word);
  205.     { This is the actual encryption/decryption engine }
  206.     var x : word;
  207.     begin
  208.       for x := 0 to number - 1 do
  209.         buffer^[x] := buffer^[x] xor KeyBuffer^[x] xor Random(256);
  210.     end; { CodeBuffer }
  211.  
  212.   begin
  213.     {$I-}
  214.     finished := false;
  215.     repeat
  216.       BlockRead(OldFile,buffer^,BufferSize,BytesRead);
  217.       if (FilePos(KeyFile) + BytesRead) > KeyFileSize then
  218.         seek(KeyFile,0);
  219.       BlockRead(KeyFile,KeyBuffer^,BytesRead,BytesRead);
  220.       CodeBuffer(BytesRead);
  221.       finished := BytesRead < BufferSize;
  222.       BlockWrite(NewFile,buffer^,BytesRead);
  223.       if IOResult <> 0 then halt(5);
  224.     until finished;
  225.     {$I+}
  226.   end;  { Main }
  227.  
  228. begin
  229.   Initialise;
  230.   Main;
  231. end.
  232.