Posts: 3,522
Threads: 189
Joined: Dec 2003
Cowards!
Tell you what, I'll give you all some special benefits in FV.. you'll all have the name postfix: The Spineless
Hows that for ya? 
Oh.. I think I hear some chickens over there! You know them? :lol:
Posts: 1,845
Threads: 44
Joined: Aug 2002
Ok this is my 2nd entry. It uses Random Numbers to encrypt the data. It is pretty strong, and pretty fast (and not really simple).
It's a singular encryption, meaning the message can be decrypted again using the same function.
Code: Option Explicit
Option Dynamic
Declare Function neov2Crypt (Msg As String, Pwd As String) As String
Declare Function neov2Random (Seed As Integer) As Integer
'#####################################################################
' neov2Crypt Function :: String
'#####################################################################
Private Function neov2Crypt (Msg As String, Pwd As String) As String
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' Define general variables
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Dim i As Integer, j As Integer, k As Integer, l As Integer
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' Static wavetable (needs to be initialized upon first call)
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Static WaveTable(255, 255) As UByte
If WaveTable(0, 0) = 0 Then
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' Initialize wavetable
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
i = neov2Random(-1)
For i = 0 To 255 ' first arg
For j = 0 To 255 ' second arg
WaveTable(i, j) = ( Int( _
(j * Tan(i)) + _
(i / Tan(j + i) ^ 2) + _
i * j) _
And &HFF ) _
Xor &H55 _
Xor neov2Random(i)
Next j
Next i
i = neov2Random(-1)
End If
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' Compile the password into a seed
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Dim Seed As Integer
j = 0: k = Len(Pwd) - 1
For i = 0 To k
Seed = Seed Xor (Pwd[i] shl j)
j = (j + 8) And 15
Next i
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' Create return message
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Dim retStr As String
retStr = Msg: j = 0: l = Len(Msg) - 1
For i = 0 To l
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' Add wavetable and a random number
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
retStr[i] = retStr[i] _
Xor WaveTable(i And 255, Pwd[j]) _
Xor neov2Random(Seed)
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' Increase password counter location
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
j += IIf(j = k, -j, 1)
Next i
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' Reset random number generator
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
j = neov2Random(-1)
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' Return returnmessage
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
neov2Crypt = retStr
End Function
'#####################################################################
' neov2Random Function :: Integer
'#####################################################################
Private Function neov2Random (Seed As Integer) As Integer
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' Static variables containing the last number & seed
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Static lastnumber As UInteger = 0
Static lastseed As UInteger = &HFFFFFFFF
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' Check for generator reset
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
If lastseed <> Seed Then
lastseed = Seed
lastnumber = Seed
neov2Random = lastnumber \ 65536: Exit Function
End If
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' Generate next number using linear generation (fast)
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
lastnumber = (lastnumber * &H343FD + &H269EC3) And 16777215
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' Return number in the range 0-255
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
neov2Random = lastnumber \ 65536
End Function
If I run this in the same testing environment as above, I get the following:
Neo (#2):
Quote:Encryption: 27.65389462680149 MB/s (3.531374199471851e-002 ms/kB)
Decryption: 26.60258625916841 MB/s (3.670930677514236e-002 ms/kB)
Side Notes: Random numbers, needs to be initialized
hi, i just made mine 'better' because XOR is all the rage these days. still can't touch red marvins speed...
Code: Option Explicit
Declare Function __crypt_msg ( s As String, p As String ) As String
Dim As String msg, msg2
Dim As Integer tb, p
Dim As Double t
msg =" Updated: 06:38 PM EDTDeputies Apologize for Los Angeles Shooting" + _
"Sheriffs Fired 120 Rounds in ideotaped ConfrontationBy ALICIA CHANG, APAP" + _
" They're not hiding,'' the sheriffs' lawyer jdhfksieosl37fdifj"
'? Len(msg)
t = Timer
For p = 0 To 44999
msg2 = __crypt_msg ( msg, "password" )
Next
? Timer - t ; " seconds to do 45000"
? (Timer - t) / 45000; " seconds to do one"
'Sleep
?
? __crypt_msg (msg2, "passwprd")
?
'Sleep
? __crypt_msg (msg2, "passxpse") '' close..
?
'Sleep
? __crypt_msg (msg2, "ozrrxpse") '' close..
?
'Sleep
? __crypt_msg (msg2, "password") '' close..
?
Sleep
End
Function __crypt_msg ( s As String, p As String ) As String
Dim As Integer a, e, c, l, x, y, z, ac, av, ls, zz
Dim r As String
r = s
l = Len ( p )
ls = Len ( s )
Dim a2 ( l )
For av = 0 To l - 1
ac += p [av]
Next
ac = ac \ l
a = ls Xor ac
y = 0
z = l - 1
Do
a2 ( y ) = l - (a Xor (( p [y] Xor p [z] ) Xor (69 Or a))) '
y += 1
z -= 1
Loop Until z <= y
Do
For e = 0 To a
r [c] = (( s [c] )) Xor ( e Xor a2 ( zz )) Xor ( p [zz] )
c + = 1
If c = ls Then Return r
zz += 1
If zz = l Then zz = 0
Next
Loop
End Function
also unrolled some functions and stuff, overall pretty tight n fast
Posts: 1,845
Threads: 44
Joined: Aug 2002
Chaos (#2):
Quote:Encryption: 32.90807978908001 MB/s (2.967546287292204e-002 ms/kB)
Decryption: 32.99461372840881 MB/s (2.959763396651516e-002 ms/kB)
Side Notes: None
alright (i think) this is my last one. im extremely happy with the level of encryption it gives now, my latest entry before this showed similarities in decrypted data using similar passwords, with this version i hope to avoid this shortcoming (..sort of):
Code: Option Explicit
Declare Function __crypt_msg ( s As String, p As String ) As String
Function __crypt_msg ( s As String, p As String ) As String
Dim As Integer a, e, c, l, x, y, z, ac, av, ls, zz
Dim r As String
r = s
l = Len ( p )
ls = Len ( s )
Dim a2 ( l )
For av = 0 To l - 1
ac += p [av]
Next
ac = ac \ l
a = ls Xor ac
y = 0
z = l - 1
Do
a2 ( y ) = l - (a Xor (( p [y] Xor p [z] ) Xor (69 Or a))) '
y += 1
z -= 1
Loop Until z <= y
Do
For e = 0 To a
r [c] = (( s [c ] )) Xor ( e Xor a2 ( zz Xor 256)) Xor ( p [zz] )
c + = 1
If c = ls Then Return r
zz += 1
If zz = l Then zz = 0
Next
Loop
End Function
i doubt speed is much different.. you can still test it if you like =)
btw, thanks neo for doing the tests in the first place
Posts: 193
Threads: 20
Joined: Jun 2005
I've optimized the code greatly by removing those ugly chr$()s and asc()s. String indexing rules!  .
Neo, can you benchmark the new code for me? thx 8) .
Code: Declare Sub SetBit (source As Short, targetBit As Byte, change As Byte)
Declare Sub GetBitChangeList (bitChangeList() As Byte, password As String)
Declare Function ReadBit (source As Short, targetBit As Byte) As Byte
Declare Function BlueEncrypt (text As String, password As String) As String
Declare Function BlueDecrypt (text As String, password As String) As String
Dim myString As String
Dim myPassword As String
Dim myEncryptedString As String
Dim myDecryptedString As String
Dim startTime As Double
Dim totalTime As Double
Dim c As Long
myString = "This is a test...testing, one, two, three."
myPassword = "This password is also a test"
startTime = Timer
For c = 0 To 9999
myEncryptedString = BlueEncrypt(myString, myPassword)
myDecryptedString = BlueDecrypt(myEncryptedString, myPassword)
Next
totalTime = Timer - startTime
Print "String encrypted and decrypted 10000 times in"; totalTime; " seconds."
Print "Each encryption/decryption cycle took"; (totalTime / 10000) * 1000; " ms."
print "String length:"; Len(myString)
print "Encrypted string length:"; Len(myEncryptedString)
Print "Encrypted: "; myEncryptedString
Print "Decrypted: "; myDecryptedString
sleep
Function BlueEncrypt (text As String, password As String) As String
Dim bitChangeList(7) As Byte, target(len(text) - 1) As Short, actualByte As Short
Dim c As Short, c2 As Byte, actualResult As String
GetBitChangeList bitChangeList(), password
actualResult = text
For c = 0 To len(text) - 1
actualByte = text[c]
For c2 = 0 To 7
SetBit target(c), bitChangeList(c2), ReadBit(actualByte, c2)
Next
actualResult[c] = target(c)
Next
Return actualResult
End Function
Function BlueDecrypt (text As String, password As String) As String
Dim bitChangeList(7) As Byte, target(len(text) - 1) As Short, actualByte As Short
Dim c As Short, c2 As Byte, actualResult As String
GetBitChangeList bitChangeList(), password
actualResult = text
For c = 0 To len(text) - 1
actualByte = text[c]
For c2 = 0 To 7
SetBit target(c), c2, ReadBit(actualByte, bitChangeList(c2))
Next
actualResult[c] = target(c)
Next
Return actualResult
End Function
Sub GetBitChangeList (bitChangeList() As Byte, password As String)
Dim bitChangeString As String, i As Short
bitChangeString = "01234567"
For i = 1 To len(password) - 1
Swap bitChangeString[password[i - 1] And 7], bitChangeString[i And 7]
Next
For i = 0 To 7
bitChangeList(i) = bitChangeString[i] - 48
Next
End Sub
Function ReadBit (source As Short, targetBit As Byte) As Byte
Return (source shr targetBit) And 1
End Function
Sub SetBit (source As Short, targetBit As Byte, change As Byte)
If (change = 1) Then source = source Or (change shl targetBit)
End Sub
Posts: 1,956
Threads: 65
Joined: Jun 2003
Hey Z!re and Neo,
You didn't say anything about the littile encryption algorithm that I posted earlier in the thread. What's wrong with it? 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
*****
Posts: 489
Threads: 34
Joined: Jan 2005
Quote:dumbledore:
Quote:Side Notes: Not testable due to memoryleaks and -errors
care to elaborate on that?  hifty: or at least post the data you're using to test?
ttp://m0n573r.afraid.org/
Quote:quote: "<+whtiger> you... you don't know which way the earth spins?" ... see... stupidity leads to reverence, reverence to shakiness, shakiness to... the dark side
...phear
Posts: 1,845
Threads: 44
Joined: Aug 2002
Quote:Hey Z!re and Neo,
You didn't say anything about the littile encryption algorithm that I posted earlier in the thread. What's wrong with it?
I'm sorry, I overlooked that little one. But also:
Quote:* Functions should be formated as: Function (Msg As STRING, Pwd As STRING) As STRING
If you can rewrite it in that form I'll test it. I don't have enough time to convert the code to the proper layout.
Also, please try to make it faster, I can already see it will be slow in this form.
Just a suggestion
Posts: 1,845
Threads: 44
Joined: Aug 2002
Quote:care to elaborate on that? or at least post the data you're using to test?
I'll try.
First of all I'm using your FB wrapper:
Code: type FBSTRING
data as zstring ptr
len as integer
size as integer
end type
function encrypt(msg as string, pwd as string) as string
dim as string ret
dim as FBSTRING ptr retptr
dim as any ptr stuff
stuff = encrypt_c( strptr( msg ), strptr( pwd ), len( msg ) + 1 )
retptr = cptr( FBSTRING ptr, @ret )
retptr->data = stuff
retptr->len = len( msg ) + 7
retptr->size = len( msg ) + 7
return ret
end function
function decrypt(msg as string, pwd as string) as string
dim as string ret
dim as FBSTRING ptr retptr
dim as any ptr stuff
stuff = decrypt_c( strptr( msg ), strptr( pwd ) )
retptr = cptr( FBSTRING ptr, @ret )
retptr->data = stuff
retptr->len = len( msg ) - 7
retptr->size = len( msg ) - 6
return ret
end function
I generate 3979 pseudo-random messages (length 1-3979), and 3979 passwords, completely random (length 1-1000).
And I feed those into the functions encrypt and decrypt.
The code to generate the random messages and password is very simple (but little bit messy):
Code: For j = 1 To Len(buffer)
msgs(j) = Mid$(buffer, Int(Rnd * (Len(buffer) - j + 1)) + 1, j)
B = Int(Rnd * 1000) + 1
pass(j) = Space$(B)
For T = 1 To Int(B)
pass(j)[Int(T - 1)] = Int(Rnd * 256)
Next T
Locate 1, 1: Print j
Next j
I then just feed the msgs() array together with the pass() array in your encrypt, and store the result in an array encs(). I use the encs() array and the pass() array to put in the decrypt, and store the result in decs(). In the end I compare decs() and msgs() for consistency.
While encrypting I just get the famous error:
Quote:cryptctest.exe has generated errors and will be closed by
Windows. You will need to restart the program.
An error log is being created.
Which indicates a memory problem.
Now that I look at it...
Code: retptr->len = len( msg ) + 7
retptr->size = len( msg ) + 7
Code: retptr->len = len( msg ) - 7
retptr->size = len( msg ) - 6
Inconsistent?
I have to reboot my computer again soon because of this nice program.
|
