Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
FieldView encryption challenge
#31
It might be an early-to-ask question, but do you have a feeling of which characters the packets will mostly consist of?
I presume you don't use all 256 characters just as much.
Anyway this helps me orient the VBC table so your packets may get smaller than usual.
Reply
#32
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:


Quote: 0.6186107712155975 seconds to do 20000
3.099456913454075e-005 seconds to do one
.00003099456913454075 seconds for 200 bytes :D
Reply
#33
Quote:It might be an early-to-ask question, but do you have a feeling of which characters the packets will mostly consist of?
I presume you don't use all 256 characters just as much.
Anyway this helps me orient the VBC table so your packets may get smaller than usual.
Data is random, as it will send location packed in 4 byte uints.

So, in average, all characters would be used as much, sadly..

Although, if VBC is good enough, I guess it's possible to excrat the number and use human digits instead, you'd then need to focus on 0-9, A-Z and a-z


@Cha0s, I'll have a look later
Reply
#34
Quote:Also:
People, what happens when the password given is longer than the message, is that taken into consideration?

Do I look like a fool? I did a check with mine:

MSG$ = "H"
PASS$ = "MyPass"

Worked fine... :wink:

Edit: Wait,.. Don't answer my question... Tongue
Kevin (x.t.r.GRAPHICS)

[Image: 11895-r.png]
Reply
#35
lol :roll:

Quote:Data is random, as it will send location packed in 4 byte uints. So, in average, all characters would be used as much, sadly.. Although, if VBC is good enough, I guess it's possible to excrat the number and use human digits instead, you'd then need to focus on 0-9, A-Z and a-z
That's too bad Sad Means the VBC algorithm will have to be optimized for each single packet, or that a header has to be added. And that's not what I want, because adding a header to a very small message is nonsense as the message will become much larger. Most compressions don't work on very small messages.
Oh well, maybe it's better to just encrypt the packet very strangely.
Reply
#36
I'm thinking of making a C++ version of my encryptor/decryptor...hmmm.....

hmmm? :-?

[Edit] Optimizing FB version
It's the difference between asking someone how much flour goes into pancakes, and handing them a sorry mix of oozing green goo and asking them to fix it." - Deleter

-Founder & President of the No More Religion Threads movement-
Reply
#37
I don't really have time at the moment for making a new kind of headerless compression, so I just made a "normal" one first,
which I made in a few hours.
And don't get angry because of me entering, I like challenges/assignments. (Rather... please don't be angry at all Sad)

Code:
Option Explicit
Option Dynamic

Declare Function neoEncrypt (Msg As String, Pwd As String) As String
Declare Function neoDecrypt (Msg As String, Pwd As String) As String


'#####################################################################
' neoEncrypt Function :: String
'#####################################################################
Private Function neoEncrypt (Msg As String, Pwd As String) As String

    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    ' returnstring and pointer and make static arrays
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    Dim retStr As String, k As Integer
    Static Lcos(255) As Single
    If Lcos(0) = 0 Then
        For k = 0 To 255
            Lcos(k) = Abs(Cos(k))
        Next k
    End If
    
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    ' get dynamic checksum of the password
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    Dim passloc As Integer, i As Integer
    passloc = Len(Msg) Mod Len(Pwd)    
    Dim checksumleft As UByte = 0
    For i = passloc To Len(Pwd) - 1
        checksumleft = checksumleft Xor Pwd[i]
    Next i    
    
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    ' get bitswap array out of the password
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    Dim bitorder As String = "01234567"
    For i = 0 To Len(Pwd) - 1
        Swap bitorder[((Pwd[i] shr 5) And 7) Xor (i Mod 8)], bitorder[(Pwd[i] And 7)]
    Next i    
    
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    ' dynamically integrate the password in the message
    ' using bitswap and addition
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    Dim bits As String, j As Integer, buildByte As UByte
    retStr = Msg: passloc = 0: bits = "00000000"
    For i = 0 To Len(Msg) - 1
        '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
        ' In order:
        '  password addition, general addition, checksum addition
        '  and trigonometric addition
        '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
        retStr[i] = Msg[i] Xor Pwd[passloc] _
                           Xor &HAA _
                           Xor checksumleft _
                           Xor Int(Pwd[passloc] * Lcos(i Mod 256))
        
        '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
        ' Swap bits using the previously made bitswap array
        '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
        For j = 0 To 7
            bits[j] = ((retStr[i] shr j) And 1)
        Next j        
        buildByte = 0
        For j = 0 To 7
            buildByte = buildByte Or (bits[bitorder[j] - 48] shl j) '48=Asc("0")
        Next j        
        retStr[i] = buildByte
        
        '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
        ' Increase password location
        '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
        passloc += IIf(passloc = Len(Pwd) - 1, -passloc, 1)        
    Next i        
    
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    ' Swap Bytes
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    For i = 0 To (Int(Len(retStr) / 2) * 2 - 2) Step 2
        Swap retStr[i], retStr[i+1]
    Next i        
    
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    ' Return encrypted data
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    Return retStr

End Function


'#####################################################################
' neoDecrypt Function :: String
'#####################################################################
Private Function neoDecrypt (Msg As String, Pwd As String) As String

    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    ' returnstring and pointer and make static arrays
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    Dim retStr As String, k As Integer
    Static Lcos(255) As Single
    If Lcos(0) = 0 Then
        For k = 0 To 255
            Lcos(k) = Abs(Cos(k))
        Next k
    End If
    retStr = Msg
    
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    ' get dynamic checksum of the password
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    Dim passloc As Integer, i As Integer
    passloc = Len(Msg) Mod Len(Pwd)    
    Dim checksumleft As UByte = 0
    For i = passloc To Len(Pwd) - 1
        checksumleft = checksumleft Xor Pwd[i]
    Next i    
    
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    ' get bitswap array out of the password
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    Dim bitorder As String = "01234567"
    For i = 0 To Len(Pwd) - 1
        Swap bitorder[((Pwd[i] shr 5) And 7) Xor (i Mod 8)], bitorder[(Pwd[i] And 7)]
    Next i    
    
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    ' Swap Bytes back
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    For i = 0 To (Int(Len(retStr) / 2) * 2 - 2) Step 2
        Swap retStr[i], retStr[i+1]
    Next i        
    
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    ' dynamically disintegrate the password in the message
    ' using bitswap and addition
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    Dim bits As String, j As Integer, buildByte As UByte
    passloc = 0: bits = "00000000"
    For i = 0 To Len(Msg) - 1
        '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
        ' Swap bits back using the previously made bitswap array
        '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
        For j = 0 To 7
            bits[j] = ((retStr[i] shr j) And 1)
        Next j        
        buildByte = 0
        For j = 0 To 7
            buildByte = buildByte Or (bits[j] shl (bitorder[j] - 48)) '48=Asc("0")
        Next j        
        retStr[i] = buildByte
        
        '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
        ' In reverse order:
        '  password addition, general addition, checksum addition
        '  and trigonometric addition
        '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
        retStr[i] = retStr[i] Xor Int(Pwd[passloc] * Lcos(i Mod 256)) _
                              Xor checksumleft _
                              Xor &HAA _
                              Xor Pwd[passloc]
                    
        '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
        ' Increase password location
        '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
        passloc += IIf(passloc = Len(Pwd) - 1, -passloc, 1)        
    Next i    
    
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    ' Return decrypted data
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    Return retStr

End Function

On my computer (AMD Athlon XP 2400+ 2.0 GHz) both the encrypt and decrypt functions have a processing rate of 4 MB/s (4 megabyte per second). Which would equal 0.00004768 s (0.04768 ms) for 200 byte.

This has been tested with a 54564-byte message and some variable-length passwords.
Reply
#38
Very nice, neo, that's blazing fast Smile.
I'm impressed, all those bit shifts and...all that stuff...8).

You -> :king:
Me -> :oops:
It's the difference between asking someone how much flour goes into pancakes, and handing them a sorry mix of oozing green goo and asking them to fix it." - Deleter

-Founder & President of the No More Religion Threads movement-
Reply
#39
Really solid too.... That's cool...
Kevin (x.t.r.GRAPHICS)

[Image: 11895-r.png]
Reply
#40
Quote:.......

Post source here, easier to see, and gives ideas to others, which keeps it interessting.

Ok, Z!re, here's a short but pretty powerful algorithm by Ethan Winer.
Code:
rem X$ is the string to be encrypted/decrypted.
rem Password$ is the password.

L=len(Password$)
for X = 1 to len(X$)
     Pass = asc(mid$(Password$, (X mod L) - L  * ((X mod L) = 0), 1))
     mid$(X$,X,1) = chr$(asc(mid$(X$,X,1)) xor Pass)
next X

PS: I have used the assembly language version of the above
using a call to the Quickpak Professional library in several of
my programs, and it works fine.
*****
Reply


Forum Jump:


Users browsing this thread: 2 Guest(s)