Real Software Forums

The forum for Real Studio and other Real Software products.
[ REAL Software Website | Board Index ]
It is currently Fri Mar 24, 2017 6:59 pm
xojo

All times are UTC - 5 hours




Post new topic Reply to topic  [ 4 posts ] 
Author Message
 Post subject: Need help converting high security encryption class
PostPosted: Wed Apr 25, 2012 3:37 pm 
Offline
User avatar

Joined: Sun Aug 12, 2007 10:10 am
Posts: 1086
Location: Boiling Springs, SC
I would like to convert the following vb encryption class to RS and remove the windows API's to make it cross-platform compatible... could someone please assist...having trouble :-(

Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function CoCreateGuid Lib "OLE32.DLL" (pGUID As GUID) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function StringFromGUID2 Lib "OLE32.DLL" (pGUID As GUID, ByVal PointerToString As Long, ByVal MaxLength As Long) As Long

Public Event Progress(Percent As Integer)

' Default rounds is 4. Lower rounds provide faster speed but
' less security. Higher rounds provide insane security but less speed.
' Recommend simply leaving it at 4.
Const Rounds = 4

Private ByteArray() As Byte
Private hiByte As Long
Private hiBound As Long

Private sbox_a(255, 255) As Byte
Private sbox_b(255, 255) As Byte

Private Type GUID
Guid1 As Long
Guid2 As Long
Guid3 As Long
Guid4(0 To 7) As Byte
End Type


Private Type POINTAPI
X As Long
y As Long
End Type


Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type


Private Function GSeed() As Double
' Retrieves the GUID value into a double variable
Dim udtGUID As GUID, sGUID As String, lResult As Long

lResult = CoCreateGuid(udtGUID)
If lResult Then
GSeed = 0
Else
With udtGUID
GSeed = CInt(CLng((CDbl(.Guid1) + CDbl(.Guid2) + CDbl(.Guid3)) / CDbl(32766)) Mod 32766)
End With
End If
End Function


Private Function Hash(Data As String) As Double
' Simple, primitive yet fast 80-bit one-way hash function
Dim i As Double, NBox As Long, OBox As Long, PBox As Long, QBox As Long, RBox As Long
For i = 1 To Len(Data)
NBox = NBox + Asc(Mid$(Data, i, 1))
NBox = (NBox * 1765 + 1066) Mod 1048576
OBox = OBox + Asc(Mid$(Data, i, 1))
OBox = (OBox * 815 + 1801) Mod 1048576
PBox = PBox + Asc(Mid$(Data, i, 1))
PBox = (PBox * 1364 + 1083) Mod 1048576
QBox = QBox + Asc(Mid$(Data, i, 1))
QBox = (QBox * 1624 + 1564) Mod 1048576
RBox = RBox + Asc(Mid$(Data, i, 1))
RBox = (RBox * 1454 + 1905) Mod 1048576
Next

NBox = (NBox * 1765 + 1066) Mod 1048576: NBox = (NBox * 1765 + 1066) Mod 1048576
NBox = (NBox * 1765 + 1066) Mod 1048576: NBox = (NBox * 1765 + 1066) Mod 1048576
NBox = (NBox * 1765 + 1066) Mod 1048576: NBox = (NBox * 1765 + 1066) Mod 1048576
NBox = (NBox * 1765 + 1066) Mod 1048576

OBox = (OBox * 815 + 1801) Mod 1048576: OBox = (OBox * 815 + 1801) Mod 1048576
OBox = (OBox * 815 + 1801) Mod 1048576: OBox = (OBox * 815 + 1801) Mod 1048576
OBox = (OBox * 815 + 1801) Mod 1048576: OBox = (OBox * 815 + 1801) Mod 1048576
OBox = (OBox * 815 + 1801) Mod 1048576

PBox = (PBox * 1364 + 1083) Mod 1048576: PBox = (PBox * 1364 + 1083) Mod 1048576
PBox = (PBox * 1364 + 1083) Mod 1048576: PBox = (PBox * 1364 + 1083) Mod 1048576
PBox = (PBox * 1364 + 1083) Mod 1048576: PBox = (PBox * 1364 + 1083) Mod 1048576
PBox = (PBox * 1364 + 1083) Mod 1048576

QBox = (QBox * 1624 + 1564) Mod 1048576: QBox = (QBox * 1624 + 1564) Mod 1048576
QBox = (QBox * 1624 + 1564) Mod 1048576: QBox = (QBox * 1624 + 1564) Mod 1048576
QBox = (QBox * 1624 + 1564) Mod 1048576: QBox = (QBox * 1624 + 1564) Mod 1048576
QBox = (QBox * 1624 + 1564) Mod 1048576

RBox = (RBox * 1454 + 1905) Mod 1048576: RBox = (RBox * 1454 + 1905) Mod 1048576
RBox = (RBox * 1454 + 1905) Mod 1048576: RBox = (RBox * 1454 + 1905) Mod 1048576
RBox = (RBox * 1454 + 1905) Mod 1048576: RBox = (RBox * 1454 + 1905) Mod 1048576
RBox = (RBox * 1454 + 1905) Mod 1048576

Hash = NBox + OBox + PBox + QBox + RBox
End Function


Public Function PRNG(Lower As Double, Upper As Double, Optional CustomSeed As Double) As Double
' An implementation of ECG for the DS2 cipher. ECG is a secure
' pseudo-random number generator
Dim HSeed As Double, SSeed As Double, RSeed As Double
Dim TSeed As Double, USeed As Double, VSeed As Double
Dim WSeed As Double, XSeed As Double, FinalSeed As Double

Dim iLoop As Long, R As String
Dim Mouse As POINTAPI, Dimensions As RECT

GetCursorPos Mouse
Randomize (GetTickCount + Mouse.X + Mouse.y)
HSeed = Hash(CStr((Int(Rnd * 1000000) + Mouse.X - Mouse.y)))

For iLoop = 1 To 1000
GetWindowRect iLoop, Dimensions
RSeed = RSeed + GetWindowTextLength(iLoop)
XSeed = XSeed + Dimensions.Bottom + Dimensions.Top + Dimensions.Left + Dimensions.Right
Next

GetCursorPos Mouse
SSeed = Upper + Lower
TSeed = Mouse.X
USeed = Mouse.y

VSeed = GetTickCount
Randomize (GetTickCount + RSeed + XSeed + TSeed + USeed)
WSeed = Int(Rnd * 9999999999#) + 1

FinalSeed = GSeed + HSeed + SSeed + RSeed + TSeed + USeed + VSeed + WSeed + XSeed + CustomSeed

Randomize FinalSeed
PRNG = Int(Rnd * (Upper - Lower + 1)) + Lower
End Function


Private Sub Append(ByRef StringData As String, Optional Length As Long)
' Appends data into memory block
Dim DataLength As Long
If Length > 0 Then DataLength = Length Else DataLength = Len(StringData)
If DataLength + hiByte > hiBound Then
hiBound = hiBound + 1024
ReDim Preserve ByteArray(hiBound)
End If
CopyMem ByVal VarPtr(ByteArray(hiByte)), ByVal StringData, DataLength
hiByte = hiByte + DataLength
End Sub


Private Function DeHex(Data As String) As String
' Decodes a Hexadecimal string into ASCII
Dim iCount As Double
Reset
For iCount = 1 To Len(Data) Step 2
Append Chr$(Val("&H" & Mid$(Data, iCount, 2)))
Next
DeHex = GData
Reset
End Function


Public Function EnHex(Data As String) As String
' Encodes a string into Hexadecimal
Dim iCount As Double, sTemp As String
Reset
For iCount = 1 To Len(Data)
sTemp = Hex$(Asc(Mid$(Data, iCount, 1)))
If Len(sTemp) < 2 Then sTemp = "0" & sTemp
Append sTemp
Next
EnHex = GData
Reset
End Function


Private Function FileExist(FileName As String) As Boolean
' Checks if a file exists
On Error GoTo errorhandler
GoSub begin

errorhandler:
FileExist = False
Exit Function

begin:
Call FileLen(FileName)
FileExist = True
End Function


Private Property Get GData() As String
' Retrieves block from memory
Dim StringData As String
StringData = Space(hiByte)
CopyMem ByVal StringData, ByVal VarPtr(ByteArray(0)), hiByte
GData = StringData
End Property


Public Function EncryptFile(InFile As String, OutFile As String, Overwrite As Boolean, Optional key As String) As Boolean
On Error GoTo errorhandler
GoSub begin

errorhandler:
EncryptFile = False
Exit Function

begin:
If FileExist(InFile) = False Then
EncryptFile = False
Exit Function
End If
If FileExist(OutFile) = True And Overwrite = False Then
EncryptFile = False
Exit Function
End If
Dim FileO As Integer, Buffer() As Byte, bKey() As Byte, bOut() As Byte
FileO = FreeFile
Open InFile For Binary As #FileO
ReDim Buffer(0 To LOF(FileO))
Buffer(LOF(1)) = 32
Get #FileO, , Buffer()
Close #FileO

bKey() = StrConv(key, vbFromUnicode)
bOut() = EncryptByte(Buffer(), bKey())
If FileExist(OutFile) = True Then Kill OutFile
FileO = FreeFile
Open OutFile For Binary As #FileO
Put #FileO, , bOut()
Close #FileO
EncryptFile = True
End Function


Public Function EncryptString(Text As String, Optional key As String, Optional OutputInHex As Boolean) As String
On Error Resume Next
EncryptString = StrConv(EncryptByte(StrConv(Text, vbFromUnicode), StrConv(key, vbFromUnicode)), vbUnicode)
If OutputInHex = True Then EncryptString = EnHex(EncryptString)
End Function


Public Function DecryptString(Text As String, Optional key As String, Optional IsTextInHex As Boolean) As String
On Error Resume Next
If IsTextInHex = True Then Text = DeHex(Text)
DecryptString = StrConv(DecryptByte(StrConv(Text, vbFromUnicode), StrConv(key, vbFromUnicode)), vbUnicode)
End Function


Public Function DecryptFile(InFile As String, OutFile As String, Overwrite As Boolean, Optional key As String) As Boolean
On Error GoTo errorhandler
GoSub begin

errorhandler:
DecryptFile = False
Exit Function

begin:
If FileExist(InFile) = False Then
DecryptFile = False
Exit Function
End If
If FileExist(OutFile) = True Then
DecryptFile = False
Exit Function
End If
Dim FileO As Integer, Buffer() As Byte, bKey() As Byte, bOut() As Byte
FileO = FreeFile
Open InFile For Binary As #FileO
ReDim Buffer(0 To LOF(FileO) - 1)
Get #FileO, , Buffer()
Close #FileO
bKey() = StrConv(key, vbFromUnicode)
bOut() = DecryptByte(Buffer(), bKey())
If FileExist(OutFile) = True Then Kill OutFile
FileO = FreeFile
Open OutFile For Binary As #FileO
Put #FileO, , bOut()
Close #FileO
DecryptFile = True
End Function


Private Sub Reset()
' Clears block from memory
hiByte = 0
hiBound = 1024
ReDim ByteArray(hiBound)
End Sub


Public Function EncryptByte(DS() As Byte, key() As Byte)
Dim tmp2() As Byte, p As Double, i As Double, Bound As Double, R As Integer, Total As Double, Prog As Double

' DS2 requires a 16-bit key or greater. If the received key is smaller
' than 16-bits then simple key expansion is performed.
If UBound(key) < 0 Then
ReDim key(1) As Byte: key(0) = 1: key(1) = 1
ElseIf UBound(key) = 0 Then
ReDim tmp2(0) As Byte: tmp2(0) = key(0)
ReDim key(1) As Byte: key(0) = tmp2(0): key(1) = 1
ReDim tmp2(0) As Byte
End If

' Initialize sbox with Key
InitBox key()

' Generate and apply salt to array
ReDim tmp2((UBound(DS)) + 6)
tmp2(0) = PRNG(1, 255)
tmp2(1) = PRNG(1, 255)
tmp2(2) = PRNG(1, 255)
tmp2(UBound(tmp2)) = PRNG(1, 255)
tmp2(UBound(tmp2) - 1) = PRNG(1, 255)
tmp2(UBound(tmp2) - 2) = PRNG(1, 255)

Call CopyMem(tmp2(3), DS(0), UBound(DS) + 1)
ReDim DS(UBound(tmp2)) As Byte
DS() = tmp2()
ReDim tmp2(0)

' Encrypt block x rounds
Bound = UBound(key)
Total = UBound(DS) * Rounds
For R = 1 To Rounds
p = 0
For i = 0 To UBound(DS) - 1
If p = Bound Then p = 0
DS(i) = sbox_b(DS(i), sbox_a(DS(i + 1), key(p)))
DS(i + 1) = sbox_b(DS(i), DS(i + 1))
DS(i) = sbox_b(DS(i), sbox_a(DS(i + 1), key(p + 1)))
p = p + 1
Prog = Prog + 1: RaiseEvent Progress((Prog / Total) * 100)
Next
Next

EncryptByte = DS()
End Function

Public Function DecryptByte(DS() As Byte, key() As Byte)
On Error Resume Next
Dim tmp2() As Byte, p As Double, i As Double, Bound As Integer, R As Integer, Total As Double, Prog As Double

' DS2 requires a 16-bit key or greater. If the received key is smaller
' than 16-bits then simple key expansion is performed.
If UBound(key) < 0 Then
ReDim key(1) As Byte: key(0) = 1: key(1) = 1
ElseIf UBound(key) = 0 Then
ReDim tmp2(0) As Byte: tmp2(0) = key(0)
ReDim key(1) As Byte: key(0) = tmp2(0): key(1) = 1
ReDim tmp2(0) As Byte
End If

' Initialize sbox with Key
InitBox key()

' Decrypt block
Total = UBound(DS) * Rounds
For R = 1 To Rounds
Bound = (UBound(key))
p = (UBound(DS)) Mod (UBound(key))
For i = (UBound(DS)) To 1 Step -1
If p = 0 Then p = Bound
DS(i - 1) = sbox_b(DS(i - 1), sbox_a(DS(i), key(p)))
DS(i) = sbox_b(DS(i - 1), DS(i))
DS(i - 1) = sbox_b(DS(i - 1), sbox_a(DS(i), key(p - 1)))
p = p - 1
Prog = Prog + 1: RaiseEvent Progress((Prog / Total) * 100)
Next
Next

' Filter out salt
tmp2() = DS()
ReDim DS((UBound(tmp2)) - 3) As Byte
Call CopyMem(DS(0), tmp2(3), UBound(DS))
ReDim Preserve DS(UBound(DS) - 3) As Byte

DecryptByte = DS()
End Function


Public Sub InitBox(key() As Byte)
Dim i As Integer, j As Integer, p As Double, Bound As Double
Bound = UBound(key())
For i = 0 To 255
For j = 0 To 255
If p = Bound Then p = 0
sbox_b(i, j) = CByte(i Xor j)
sbox_a(i, j) = CByte((i + j * key(p)) Mod 255)
p = p + 1
Next
Next
End Sub

_________________
Matthew A. Combatti
Real Studio 2012 r1.2

Visit Xojo Developer's Spot!
Systems I Use:
Windows XP/Windows Vista/Windows Server 2008 r2/Windows 7/Windows 8
Mac OSX 10.5/Mac OSX 10.6/Mac OSX Server/Ubuntu/Debian/Suse/Red Hat/
Windows Server 2011/CentOS 5.4 /ReactOS/SimOS

~All Xojo Compatible~


Top
 Profile  
 
 Post subject: Re: Need help converting high security encryption class
PostPosted: Thu Apr 26, 2012 2:21 am 
Offline

Joined: Tue Feb 14, 2012 5:39 am
Posts: 99
Location: Austria
As you want to use a "high security encryption class" i would suggest you to use prebuilt, well tested Classes from Monkeybreadsoftware, Einhugur or Toringo.

Monkeybreadsoftware delivers you AES and Blowfish.
http://www.monkeybreadsoftware.net/topi ... hash.shtml

Einhugur has got his eCryptIt-engine which supports most of the common encryptions like Blowfish, Twofish, AES and Serpent
http://www.einhugur.com/Html/eCrypt/index.html

Toringo has got DES, TDEA and RSA.
http://www.crosstwinkle.com/product/crypto.html

Or if you want to do that for free, use the openssl library and call it wia shell.
http://www.openssl.org/

They all have the advantage that they are using approved and well documented standard crypto functions which most likely wont have any bugs which may be broken by a design flaw.

TL;DR: Use Prebuilt functions. Use MBS or Einhugur if you need Blowfish/Twofish, use Toringo if you want RSA native inside your program, use openssl if you wont spend money and have time to write a wrapper.


Top
 Profile  
 
 Post subject: Re: Need help converting high security encryption class
PostPosted: Fri Apr 27, 2012 1:02 pm 
Offline
User avatar

Joined: Sun Aug 12, 2007 10:10 am
Posts: 1086
Location: Boiling Springs, SC
Not an option. I have access to almost a hundred FREE encryption methods over at RealStudioDevSpot.com. This class is part of a government encryption class (could only provide certain parts) Can't explain what happens to the data after being passed through the class above.. Let's just say it would take an eternity just for a super computer to break the above (I left out the functions which I easily converted myself.) it is already in use on most the software already used. Just wanting to provide a cross-platform option :-) ... Runs fine on windows and Linux systems (with wine installed) already... Just need Mac access.

_________________
Matthew A. Combatti
Real Studio 2012 r1.2

Visit Xojo Developer's Spot!
Systems I Use:
Windows XP/Windows Vista/Windows Server 2008 r2/Windows 7/Windows 8
Mac OSX 10.5/Mac OSX 10.6/Mac OSX Server/Ubuntu/Debian/Suse/Red Hat/
Windows Server 2011/CentOS 5.4 /ReactOS/SimOS

~All Xojo Compatible~


Top
 Profile  
 
 Post subject: Re: Need help converting high security encryption class
PostPosted: Sat Apr 28, 2012 11:50 am 
Offline
User avatar

Joined: Sun Aug 12, 2007 10:10 am
Posts: 1086
Location: Boiling Springs, SC
Tried the VB migration utility and didn't work...code was more broken than the version I tried transposing... Tried the open source VB to RB converter... Fixed 15 lines of code that couldn't be converted... Works great cross platform.. Thanks for the suggestions though.

_________________
Matthew A. Combatti
Real Studio 2012 r1.2

Visit Xojo Developer's Spot!
Systems I Use:
Windows XP/Windows Vista/Windows Server 2008 r2/Windows 7/Windows 8
Mac OSX 10.5/Mac OSX 10.6/Mac OSX Server/Ubuntu/Debian/Suse/Red Hat/
Windows Server 2011/CentOS 5.4 /ReactOS/SimOS

~All Xojo Compatible~


Top
 Profile  
 
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 4 posts ] 

All times are UTC - 5 hours


Who is online

Users browsing this forum: No registered users and 1 guest


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  
cron
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group