FieldView encryption challenge

[Anonymous]

man neos is just gonna annihilate mine, i know, but this one is pretty fast. ive heard of julius caesar b4.. this is like.. dynamic julius caesar ;) ive toyed with it for a while but i could never get the password to modify the data like i was able to tonight. here, its pretty fast, i included a 1meg file to test it with.

Code:

'''' This example uses some functions to transfer data
'''' between a file and memory and to en/decrypt that data.
'''' The Subs "encrypt_file" and "decrypt_file" demonstrate
'''' how to use those functions to encrypt and decrypt an
'''' entire file to another file with a new name.
''''
'''' Added a new wrapper to match compo specs.




#Include "crt.bi"

Option Explicit



Type passtype

  l As Integer
  a As Integer
  a2 As Integer

  s As String '' <---- this is where the actual password is in memory

End Type



'''  internal subs / functions
Declare Function str2buf ( msg As String ) As uByte Ptr
Declare Function buf2str ( buffer As uByte Ptr ) As String
Declare Function fil2buf ( file_name As String ) As uByte Ptr
Declare Function decrypt_buffer ( buffer As uByte Ptr, pass As passtype ) As uByte Ptr
Declare Sub buf2fil ( file_name As String, buffer As uByte Ptr )
Declare Function encrypt_buffer ( buffer As uByte Ptr, pass As passtype ) As uByte Ptr
Declare Sub setup_pass ( pass As passtype, flen As Integer Ptr )


''   user subs
Declare Function decrypt_message ( msg As String, pass As String ) As String
Declare Function encrypt_message ( msg As String, pass As String ) As String
Declare Sub decrypt_file ( src As String, dest As String, pass As passtype )
Declare Sub encrypt_file ( src As String, dest As String, pass As passtype )



Dim As String msg, msg2

msg = "12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890"

Dim As Double t, p
t = Timer


For p = 0 To 19999
msg2 = encrypt_message ( msg, "heheh" )
Next

? Timer - t ; " seconds to do 20000"
? (Timer - t) / 20000; " seconds to do one"

Sleep


? msg2
?
Sleep
? decrypt_message ( msg2, "ohhcrap" ) '' wrong pass!!!
?
Sleep
? decrypt_message ( msg2, "mfgahhhhhhhhhhhhhthispassiscrazy" ) '' wrong pass!!!
?
Sleep
? decrypt_message ( msg2, "heheh" ) '' there we go!!!
?
Sleep



End





Function fil2buf ( file_name As String ) As uByte Ptr

  'read file into buffer

  Dim buffer As uByte Ptr
  Dim As Integer o = FreeFile

   Open file_name For Binary As o

     Dim As Integer al = Lof ( o )
     Dim As Integer Ptr fln
     Dim buf ( al - 1 ) As uByte
  
     buffer = CAllocate ( al + 4 )
  
     Get #o, , buf()

   Close

   fln = buffer
   fln[0] = al

   memcpy ( buffer + 4, @buf (0), al )

   Return buffer


End Function

Function encrypt_buffer ( buffer As uByte Ptr, pass As passtype ) As uByte Ptr

  'encrypt buffer

  Dim buffer2 As uByte Ptr
  Dim As Integer Ptr fln , fln2

   fln = buffer

   buffer2 = CAllocate ( fln[0] + 4 )

   fln2 = buffer2
   fln2[0] = fln[0]

   Dim As Integer enc, c

   Do
    
    
     For enc = 0 To pass.a
       buffer2[c + 4] = buffer[c + 4] + ( enc * pass.a2 ) Mod 256

       c + = 1
       If c = fln[0] Then Return buffer2
    
     Next
    
   Loop

End Function


Sub buf2fil ( file_name As String, buffer As uByte Ptr )

  'send buffer to file

  Dim As Integer o = FreeFile
  Dim As Integer Ptr lfn = buffer

   Open file_name For Binary As o
  
     Dim As Integer al = lfn[0]
     Dim buf ( al - 1 ) As uByte

     memcpy ( @buf(0), buffer + 4, al )
  
     Put #o, , buf()

   Close


End Sub


Function decrypt_buffer ( buffer As uByte Ptr, pass As passtype ) As uByte Ptr


  Dim buffer2 As uByte Ptr
  Dim As Integer Ptr fln, fln2

   fln = buffer

   buffer2 = CAllocate ( fln[0] + 4)

   fln2 = buffer2
   fln2[0] = fln[0]
  
   Dim As Integer enc, c
  
   Do
  
     For enc = 0 To pass.a
       buffer2[c + 4] = buffer[c + 4] - (enc * pass.a2) Mod 256
    
       c + = 1
       If c = fln[0] Then Return buffer2
  
     Next
    
   Loop


End Function


Sub encrypt_file ( src As String, dest As String, pass As passtype )


  Dim As uByte Ptr file_handle, buffer_handle
  Dim As Integer Ptr flen

   file_handle = fil2buf ( src )
   flen = file_handle

   setup_pass pass, flen

   buffer_handle = encrypt_buffer ( file_handle, pass )
   buf2fil dest, buffer_handle


End Sub


Function encrypt_message ( msg As String, pwd As String ) As String

  Dim pass As passtype
  Dim As uByte Ptr msg_handle, buffer_handle
  Dim As Integer Ptr flen
  Dim As String nwmsg

   msg_handle = str2buf ( msg )
   flen = msg_handle

   pass.s = pwd
   setup_pass pass, flen

   buffer_handle = encrypt_buffer ( msg_handle, pass )

   Return buf2str ( buffer_handle )


End Function


Function decrypt_message ( msg As String, pwd As String ) As String

  Dim pass As passtype
  Dim As uByte Ptr msg_handle, buffer_handle
  Dim As Integer Ptr flen
  Dim As String nwmsg

   msg_handle = str2buf ( msg )
   flen = msg_handle

   pass.s = pwd
   setup_pass pass, flen

   buffer_handle = decrypt_buffer ( msg_handle, pass )

   Return buf2str ( buffer_handle )


End Function


Sub decrypt_file ( src As String, dest As String, pass As passtype )




  Dim As uByte Ptr file_handle, buffer_handle
  Dim As Integer Ptr flen

   file_handle = fil2buf ( src )
   flen = file_handle

   setup_pass pass, flen
    
   buffer_handle = decrypt_buffer ( file_handle, pass )
   buf2fil dest, buffer_handle


End Sub


Sub setup_pass ( pass As passtype, flen As Integer Ptr )


  pass.l = Len(pass.s)

  Dim As Integer avg, ac

   For avg = 0 To Len(pass.s) - 1
     ac += pass.s[avg]

   Next

   ac = ac \ pass.l

   pass.a =  flen[0] Mod ac
   pass.a2 = pass.l - (pass.a + ((pass.s[0] + pass.s[Len(pass) - 1]) \ 2 ))


End Sub


Function str2buf ( msg As String ) As uByte Ptr

  'read string into buffer

  Dim As Integer al = Len ( msg )
  Dim As Integer Ptr fln
  Dim buf ( al - 1 ) As uByte
  Dim buffer As uByte Ptr
  
   buffer = CAllocate ( al + 4 )
  
   memcpy ( buffer + 4, @msg [0], al )
  
   fln = buffer
   fln[0] = al


  Return buffer


End Function


Function buf2str ( buffer As uByte Ptr ) As String


  Dim msg As String
  Dim As Integer Ptr fln = buffer
  Dim As Integer al = fln[0]

   msg = space ( al )
   memcpy ( @msg [0], buffer + 4 , al )
  


  Return msg


End Function

edit: forgot, the files at http://members.aol.com/rubentbstk/cryp.rar

edit2: made it a lil more modular

edit3: just now read the actual format you wanted the functions in, here. wrote a wrapper for my functions to use this input

edit4: edited for the last time hahahah.... just added speed testing, this is what i get:

0.6186107712155975 seconds to do 20000
3.099456913454075e-005 seconds to do one

.00003099456913454075 seconds for 200 bytes :D