home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / files.swg / 0062_File Encryption.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-26  |  10.6 KB  |  326 lines
  1. {
  2. > Is there out there that has any good encription code.. something like rsa?
  3.  
  4. {****************************************************************************}
  5. {                Unit to Compute in a Very Pascal Way                        }
  6. {****************************************************************************}
  7. {                      Incredible File Utilities                             }
  8. {****************************************************************************}
  9. {              Version : 1.0                  Dec  1990                      }
  10. {****************************************************************************}
  11. Unit FileUtil ;
  12. {****************************************************************************}
  13. Interface uses dos ;
  14. {****************************************************************************}
  15. Const
  16.      Crea  = 'UNIT FILEUTIL.TPU V.1.0 By: Jeffrey N. Thompson' ;
  17.      Creat = '(C) Copywrite 1990,1991 By KJE Software Opportunities
  18. Exclusively' ;{ Procedure and function List }
  19. Function  FileExists(pathname:string):boolean ;
  20. function  KillFile(pathname : string):boolean ;
  21. Procedure cryptB(var Rec ; size : word ; Sym : Byte) ;
  22. Procedure CryptStr(var Rec ; Size : Word ; Ecrypt : string) ;
  23. Procedure CryptS(Var Rec ; Size : Word ; Seed : longint) ;
  24. Function  CryptfileStr(Fname:string; Ecrypt : string) : integer ;
  25. Function  CryptfileWithFile(Fname,Keyname : String) : Integer ;
  26. Function  CryptFileS(Fname : string ; Seed : longint) : integer ;
  27. {****************************************************************************}
  28. Implementation    { Uses }
  29. { Procedures and functions follow }
  30. {****************************************************************************}
  31. { Check if a filename Exists in the current drive and directory. }
  32. Function FileExists(pathname : string) : boolean ;
  33. Var
  34.         search : searchrec ;
  35.         exists : boolean ;
  36. Begin   { Exists }
  37.      exists := false ;
  38.      findfirst(pathname,anyfile,search) ;
  39.      exists := (doserror = 0) and (search.name <> '') ;
  40.      fileexists := exists ;
  41. End ;  { Exists }
  42. {****************************************************************************}
  43.  { Destroys a file.  Unrecoverably }
  44. function  KillFile(pathname : string):boolean ;
  45. var
  46.    kfile : file ;
  47.    buffer : array[1..2048] of byte ;
  48.    numread,numwritten : word ;
  49.    I  : integer ;
  50.    j2 : longint ;
  51.    found : boolean ;
  52.  
  53. begin
  54. {$F-}
  55.    if fileexists(pathname) then
  56.    begin
  57.         found := true ;
  58.         assign(kfile,pathname) ;
  59.         setfattr(kfile,0) ;
  60.         reset(kfile,1) ;
  61.         repeat
  62.              Blockread(kfile,buffer,sizeof(buffer),numread) ;
  63.              j2 := filepos(kfile) ;
  64.              for I := 1 to numread do buffer[i] := random(255) ;
  65.              seek(kfile,j2-numread) ;
  66.              blockwrite(kfile,buffer,numread,numwritten) ;
  67.              seek(kfile,j2) ;
  68.         until (numread = 0) or (numwritten <> numread) ;
  69.         close(kfile) ;
  70.         erase(kfile) ;
  71.    end else found := false ;
  72. {$F+}
  73.      killfile := (ioresult=0) and (found) ;
  74.   end ;
  75. {****************************************************************************}
  76.  { Encrypt a record of SIZE with a Byte Sized SYMbol }
  77. procedure cryptb(var Rec ; size : word ; Sym : Byte) ;
  78.  
  79. type
  80.     buffers = array[1..65535] of byte ;
  81. var
  82.    I : word ;
  83.    buffer : ^buffers ;
  84.  
  85. begin
  86.      buffer := nil ;
  87.      buffer := @rec ;
  88.      for I := 1 to size do buffer^[I] := buffer^[i] xor sym ;
  89. end ;
  90.  
  91. {****************************************************************************}
  92.  { Encrypts a record of SIZE with a Sliding String method }
  93. procedure CryptStr(var Rec ; Size : Word ; Ecrypt : string) ;
  94. type
  95.     buffers = array[1..65535] of byte ;
  96. var
  97.    I,J : word ;
  98.    buffer : ^buffers ;
  99.    l : integer ;
  100.    c1 : char ;
  101.  
  102. begin
  103.      l := length(ecrypt) ;
  104.      if l = 1 then
  105.      begin
  106.           c1 := ecrypt[1] ;
  107.           cryptb(rec,size,byte(c1)) ;
  108.           exit ;
  109.      end ;
  110.      if l<2 then exit ;
  111.      buffer := nil ;
  112.      buffer := @rec ;
  113.      j := 1 ;
  114.      for I := 1 to size do
  115.      begin
  116.           buffer^[I] := buffer^[i] xor byte(ecrypt[j]) ;
  117.           inc(j) ;
  118.           if j > l then
  119.           begin
  120.                j := 1 ;
  121.                c1 := ecrypt[1] ;
  122.                move(ecrypt[2],ecrypt[1],l-1) ;
  123.                ecrypt[l] := c1 ;
  124.           end ;
  125.      end ;
  126. end ;
  127. {****************************************************************************}
  128.  { Encrypts a record of SIZE  with a list of random numbers produced by
  129.  Initial Seeding with SEED }
  130. procedure cryptS(var Rec ; size : word ; Seed : longint) ;
  131.  
  132. type
  133.     buffers = array[1..65535] of byte ;
  134. var
  135.    I : word ;
  136.    buffer : ^buffers ;
  137.  
  138. begin
  139.      randseed := seed ;
  140.      buffer := nil ;
  141.      buffer := @rec ;
  142.      for I := 1 to size do buffer^[I] := buffer^[i] xor byte(random(254)+1) ;
  143. end ;
  144.  
  145. {****************************************************************************}
  146. { Encrypts a file, with a string using a sliding string method }
  147. { String em up! }
  148. function CryptfileStr(Fname:string; Ecrypt : string) : integer ;
  149. const
  150.      tempfilename = 'KJETLHM.DS2' ;
  151. var
  152.    fromfile,tofile : file ;
  153.    buffer : array[1..2048] of byte ;
  154.    numread,numwritten,attr : word ;
  155.    error : boolean ;
  156.    I,J,L : integer ;
  157.    j2 : longint ;
  158.    c1 : char ;
  159.  
  160. begin
  161.      if not fileexists(fname) then
  162.      begin
  163.           cryptfileStr := 1 ;
  164.           exit ;
  165.      end ;
  166.      if length(ecrypt) <= 1 then
  167.      begin
  168.           cryptfileStr := 2 ;
  169.           exit ;
  170.      end ;
  171.      l := length(ecrypt) ;
  172. {$I-}
  173.      assign(fromfile,fname) ;
  174.      assign(tofile,tempfilename) ;
  175.      getfattr(fromfile,attr) ;
  176.      setfattr(fromfile,0) ;
  177.      reset(fromfile,1) ;
  178.      rewrite(tofile,1) ;
  179.      repeat
  180.           blockread(fromfile,buffer,sizeof(buffer),numread) ;
  181.           j := 1 ;
  182.           for I := 1 to sizeof(buffer) do
  183.           begin
  184.                buffer[I] := buffer[I] xor byte(ecrypt[j]) ;
  185.                inc(j) ;
  186.                if j > l then
  187.                begin
  188.                     j := 1 ;
  189.                     c1 := ecrypt[1] ;
  190.                     move(ecrypt[2],ecrypt[1],l-1) ;
  191.                     ecrypt[l] := c1 ;
  192.                end ;
  193.           end ;
  194.           blockwrite(tofile,buffer,numread,numwritten) ;
  195.      until (numread = 0) or (numwritten <> numread) ;
  196.      close(tofile) ;
  197.      close(fromfile) ;
  198.      error := killfile(fname) ;
  199.      rename(tofile,fname) ;
  200.      setfattr(tofile,attr) ;
  201. {$I+}
  202.      cryptfileStr := (IOresult)
  203. end ;
  204. {****************************************************************************}
  205.  { encrypts a file with another file as the key, using a sliding method
  206.  }
  207. { File this sucker! }
  208. Function CryptfileWithFile(Fname,Keyname : String) : Integer ;
  209. const
  210.      Tempfilename = 'KJETLHM.DS3' ;
  211. var
  212.    Infile,Keyfile,Outfile : file ;
  213.    Bfile : File of Byte ;
  214.    inBuffer,keybuffer,outbuffer : array[1..2048] of byte ;
  215.    attr,kattr : word ;
  216.    I,J : longint ;
  217.    numread,numwritten,numkread : word ;
  218.    error : boolean ;
  219.  
  220. begin
  221.      if not fileexists(fname) then
  222.      begin
  223.           cryptfilewithfile := 1 ;
  224.           exit ;
  225.      end ;
  226.      if not fileexists(keyname) then
  227.      begin
  228.           cryptfilewithfile := 2  ;
  229.           exit ;
  230.      end ;
  231.      {$I-}
  232.      Assign(infile,fname) ;
  233.      assign(keyfile,keyname) ;
  234.      assign(outfile,tempfilename) ;
  235.      getfattr(infile,attr) ;
  236.      getfattr(keyfile,kattr) ;
  237.      setfattr(infile,0) ;
  238.      setfattr(keyfile,0) ;
  239.      reset(infile,1) ;
  240.      reset(keyfile,1) ;
  241.      rewrite(outfile,1) ;
  242.      repeat
  243.           { Fill the input buffer }
  244.           blockread(infile,inbuffer,sizeof(inbuffer),numread) ;
  245.           { Fill the key buffer }
  246.           blockread(keyfile,keybuffer,sizeof(keybuffer),numkread) ;
  247.           j := numkread ;
  248.           if numkread < numread then { The Keyfile is smaller }
  249.           repeat  { Keep resetting and reading until the buffer is full }
  250.                reset(keyfile,1) ;
  251.                blockread(keyfile,keybuffer[j+1],numread-j,numkread) ;
  252.                j := j + numkread ;
  253.                if j > numread then HALT(3) ;
  254.           until j = numread ;
  255.           for I := 1 to numread do
  256.            outbuffer[I] := inbuffer[I] XOR keybuffer[I] ;
  257.           blockwrite(outfile,outbuffer,numread,numwritten) ;
  258.      until (numread = 0) or (numwritten <> numread) ;
  259.      close(keyfile) ;
  260.      setfattr(keyfile,kattr) ;  { Restore the attributes }
  261.      close(infile) ;
  262.      close(outfile) ;
  263.      { Now destroy the old file }
  264.      error := killfile(fname) ;
  265.      rename(outfile,fname) ;
  266.      setfattr(outfile,attr) ;
  267. {$I+}
  268.      cryptfilewithfile := IoResult ;
  269. end ;
  270. {****************************************************************************}
  271.  { Encrypts a file, using a list of random numbers generated with an
  272.  initial SEED.   The Seed is your key } 
  273. function CryptfileS(Fname:string; Seed : Longint) : integer ;
  274. const
  275.      tempfilename = 'KJETLHM.DS4' ;
  276. var
  277.    fromfile,tofile : file ;
  278.    buffer : array[1..2048] of byte ;
  279.    numread,numwritten,attr : word ;
  280.    I : integer ;
  281.    error : boolean ;
  282.  
  283. begin
  284.      if not fileexists(fname) then
  285.      begin
  286.           cryptfileS := 1 ;
  287.           exit ;
  288.      end ;
  289.      randseed := seed ;
  290. {$I-}
  291.      assign(fromfile,fname) ;
  292.      assign(tofile,tempfilename) ;
  293.      getfattr(fromfile,attr) ;
  294.      setfattr(fromfile,0) ;
  295.      reset(fromfile,1) ;
  296.      rewrite(tofile,1) ;
  297.      repeat
  298.           blockread(fromfile,buffer,sizeof(buffer),numread) ;
  299.           for I := 1 to numread do
  300.            buffer[I] := buffer[I] xor byte(random(254)+1) ;
  301.           blockwrite(tofile,buffer,numread,numwritten) ;
  302.      until (numread = 0) or (numwritten <> numread) ;
  303.      close(tofile) ;
  304.      close(fromfile) ;
  305.      error := killfile(fname);
  306.      rename(tofile,fname) ;
  307.      setfattr(tofile,attr) ;
  308. {$I+}
  309.      cryptfileS := IOresult  ;
  310. end ;
  311. {****************************************************************************}
  312. {****************************************************************************}
  313. end. { Unit }
  314.  
  315. {
  316. These are not weird math methods of encryption.  They are simple
  317.  Extreemly fast XOR methods.  By using multiple methods on various parts
  318.  of a file, or database, you can foil any attempt at cracking.  This is
  319.  true because the cracker has no way of knowing where to start, even if
  320.  he possesses the keys..
  321.  
  322.      I have a standing challenge, if anyone cares to take it...  Here
  323.  are the methods, I'll post a small file, and even give you the keys I
  324.  used to ecrypt a simple one line sentence.  If you can crack it, I'll
  325.  buy you a pentium computer!
  326. }