home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / datatype.swg / 0024_Secure Encryption.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-26  |  2.5 KB  |  122 lines
  1. {
  2. The following is result of my work to make simple, fast, and enough
  3. acceptable routine that will encrypt/decrypt any data with the given Key
  4. string. It really works, it's far from RSA and DES, but it encrypts/decrypts
  5. just as it will be _quite_ (impossibel? hard?) to restore the original data
  6. without knowing a Key. BTW, i would recommend as long Key as possibel. ;)
  7.  
  8. This Eigus Encryption released to Public Domain, and no charge is required
  9. for the author. Alsow, if you would have reccomendations, suggestions, ideas,
  10. or stories to optimise my code, please do not hestitate to ask/tell/post.
  11.  
  12. Eigus Encryption may be included in SWAG. Thank you.
  13. }
  14.  
  15. Unit Crypto;
  16. {
  17.   Copyright (c) 1994 by Andrew Eigus    Fidonet: 2:5100/33
  18.   Eigus Encryption Routine source code for Borland Pascal 7.0
  19.   Platforms: DOS, DPMI, Windows
  20. }
  21.  
  22. interface
  23.  
  24. const
  25.   { use these above as values for ecCommand parameter for Encrypt procedure }
  26.   ecEncode  = True;
  27.   ecExtract = False;
  28.  
  29. procedure Encrypt(var Buffer; Count : word; Key : string; ecCommand : boolean);
  30.  
  31. implementation
  32.  
  33. Procedure Encrypt; assembler;
  34. var
  35.   SaveDS, SaveSI : word;
  36.   N : byte;
  37. Asm
  38.   push ds
  39.   lds si,Key
  40.   cld
  41.   xor ah,ah
  42.   lodsb
  43.   mov N,al
  44.   mov bx,ax
  45.   cmp bx,0
  46.   je  @@5
  47.   mov SaveDS,ds
  48.   mov SaveSI,si
  49.   lds si,Buffer
  50.   les di,Buffer
  51.   mov cx,Count
  52.   jcxz @@5
  53. @@1:
  54.   lodsb
  55.   mov dl,al
  56.   push ds
  57.   push si
  58.   mov ds,SaveDS
  59.   mov si,SaveSI
  60.   lodsb
  61.   dec bx
  62.   cmp bx,0
  63.   jz  @@2
  64.   lds si,Key
  65.   lodsb
  66.   mov bl,al
  67. @@2:
  68.   add N,al
  69.   or  ecCommand,ecExtract
  70.   jz  @@3
  71.   add dl,al
  72.   sub dl,N
  73.   not dl
  74.   jmp @@4
  75. @@3:
  76.   not dl
  77.   add dl,N
  78.   sub dl,al
  79. @@4:
  80.   mov al,dl
  81.   mov SaveDS,ds
  82.   mov SaveSI,si
  83.   pop si
  84.   pop ds
  85.   stosb
  86.   loop @@1
  87. @@5:
  88.   pop ds
  89. End; { Encrypt }
  90.  
  91. End.
  92.  
  93.  
  94.  
  95. { CRYPDEMO.PAS }
  96.  
  97. Program CryptoDemo;
  98. {
  99. Copyright (c) 1994 by Andrew Eigus  Fidonet: 2:5100/33
  100. Demonstrates the use of unit CRYPTO.PAS
  101. }
  102.  
  103. uses Crypto;
  104.  
  105. var
  106.   Str, Key : string;
  107.  
  108. Begin
  109.   Str := 'This is text to encrypt with Encrypt procedure'; { text to encrypt }
  110.   Key := 'ExCaLiBeR'; { key string to use; longer -> safer ;I }
  111.   WriteLn(#13#10'Original string: ''', Str, '''');
  112.   Encrypt(Str[1], Length(Str), Key, ecEncode);
  113.   WriteLn('Encrypted string: ''', Str, '''');
  114.   Encrypt(Str[1], Length(Str), Key, ecExtract);
  115.   WriteLn('Decrypted string: ''', Str, '''')
  116. End.
  117.  
  118. {
  119. I hope that my CRYPTO unit might be useful for all of you. You may change my
  120. code as you want.
  121. }
  122.