Array.copy method in vb.net - vb.net

Public Shared Function EncryptRSA(ByVal infilename As String, ByVal outfilename As String, ByVal pubkey As String) As String
Dim buffer2 As Byte()
Dim buffer3 As Byte()
Dim provider As New RSACryptoServiceProvider
provider.FromXmlString(File.ReadAllText(pubkey))
Dim sourceArray As Byte() = File.ReadAllBytes(infilename)
Dim num As Integer = (sourceArray.Length / &H3A)
Dim stream As FileStream = File.Create(outfilename)
Dim num2 As Integer = 0
For num2 = 0 To num - 1
buffer2 = New Byte(&H3A - 1) {}
Array.Copy(sourceArray, (num2 * &H3A), buffer2, 0, &H3A)
buffer3 = provider.Encrypt(buffer2, True)
stream.Write(buffer3, 0, buffer3.Length)
Next num2
If ((sourceArray.Length Mod &H3A) <> 0) Then
buffer2 = New Byte((sourceArray.Length Mod &H3A) - 1) {}
Array.Copy(sourceArray, ((sourceArray.Length / &H3A) * &H3A), buffer2, 0, (sourceArray.Length Mod &H3A))
buffer3 = provider.Encrypt(buffer2, True)
stream.Write(buffer3, 0, buffer3.Length)
End If
stream.Close()
Return File.ReadAllText(outfilename)
End Function
Error 1 Overload resolution failed because no accessible 'Copy' can be called without a narrowing conversion:
'Public Shared Sub Copy(sourceArray As System.Array, sourceIndex As Long, destinationArray As System.Array, destinationIndex As Long, length As Long)': Argument matching parameter 'sourceIndex' narrows from 'Double' to 'Long'.
'Public Shared Sub Copy(sourceArray As System.Array, sourceIndex As Integer, destinationArray As System.Array, destinationIndex As Integer, length As Integer)': Argument matching parameter 'sourceIndex' narrows from 'Double' to 'Integer'. C:\Users\user\AppData\Local\Temporary Projects\WindowsApplication1\Crypto.vb 52 13 WindowsApplication1

You have this line:
Array.Copy(sourceArray, ((sourceArray.Length / &H3A) * &H3A), buffer2, 0, (sourceArray.Length Mod &H3A))
What the compiler wants to tell you is that you provided a double value for sourceIndex but it expected a long value. double cannot be cast to long implicitly because long cannot represent all possible values of double.
So do the conversion explicitly:
Array.Copy(sourceArray, CLng((sourceArray.Length / &H3A) * &H3A), buffer2, 0, (sourceArray.Length Mod &H3A))

Related

VB NET - ZLIB - Uncompress a stream

I have a little class that can uncompress a byte array with zlib. Here it is :
<Runtime.InteropServices.DllImport("zlib1.DLL", CallingConvention:=Runtime.InteropServices.CallingConvention.Cdecl, EntryPoint:="compress2", charset:=Runtime.InteropServices.CharSet.Auto)> _
Private Shared Function CompressByteArray2(ByVal dest As Byte(), ByRef destLen As Integer, ByVal src As Byte(), ByVal srcLen As Integer, ByVal level As Integer) As Integer
End Function
Public Shared Function DeCompressBytes(ByVal Bytes() As Byte) As Byte()
Dim OrigSize As Integer = BitConverter.ToUInt32(Bytes, 0)
Dim Data(Bytes.Length - 5) As Byte
Array.Copy(Bytes, 4, Data, 0, Bytes.Length - 4)
Dim DLLfunctionResult As Integer
Dim bResult(CInt(OrigSize + (OrigSize * 0.01) + 12)) As Byte
DLLfunctionResult = UncompressByteArray(bResult, OrigSize, Data, Data.Length)
If DLLfunctionResult = 0 Then
ReDim Preserve bResult(OrigSize - 1)
Return bResult
Else
Return Bytes
End If
End Function
It Works, no problem.
I would like to know if it's possible to uncompress from a stream instead of a byte array. Because right now, I have to read the stream and put it in a variable, then uncompress it and put the new result in a variable. The purpose is to accelerate the process. Maybe it will not do that, but I would still like to know about
(French here, sorry for my english)

Lempel-Ziv-Welch algorithm

Heys guys,
I'm trying to implement the Lempel-Ziv-Welch algorithm on byte level in VB.NET. Here is what the Code looks like so far:
Dim FileBytes As Byte() = {Convert.ToByte(12), Convert.ToByte(13), Convert.ToByte(12), Convert.ToByte(13), Convert.ToByte(12), Convert.ToByte(13)}
Dim bw As New BitWriter(New BinaryWriter(New FileStream(output, FileMode.Create)))
Dim ByteDictionary As New Dictionary(Of Byte(), Integer)
Dim DictionaryN As Integer = 1
Dim DictionaryMax As Integer = 4048
Dim outputs As New List(Of Integer)
Dim bts As New List(Of Byte)
For index As Integer = 0 To FileBytes.Length - 1
Dim currentbyte As Byte = FileBytes(index)
If ContainsByte(ByteDictionary, AddToList(bts, currentbyte).ToArray) Then
bts.Add(currentbyte)
Else
If bts.Count > 1 Then
ByteDictionary.Add(bts.ToArray, 255 + DictionaryN)
DictionaryN += 1
Else
ByteDictionary.Add(New Byte() {currentbyte}, currentbyte)
End If
Console.WriteLine(GetByteValue(ByteDictionary, bts.ToArray))
bts.Clear()
bts.Add(currentbyte)
End If
Next
End Sub
Public Function ContainsByte(ByVal dic As Dictionary(Of Byte(), Integer), ByVal bt As Byte()) As Boolean
Dim flag = True
For Each kp As KeyValuePair(Of Byte(), Integer) In dic
If ByteArrayEquals(kp.Key, bt) Then
Return True
End If
Next
Return False
End Function
Public Function AddToList(ByVal list As List(Of Byte), ByVal bt As Byte) As List(Of Byte)
Dim newlist = New List(Of Byte)(list)
newlist.Add(bt)
Return newlist
End Function
Public Function ByteArrayEquals(ByVal first As Byte(), ByVal second As Byte()) As Boolean
If first.Length = second.Length Then
Dim flag = True
For index As Integer = 0 To first.Length - 1
If first(index) <> second(index) Then
flag = False
End If
Next
Return flag
Else
Return False
End If
End Function
Public Function GetByteValue(ByVal dic As Dictionary(Of Byte(), Integer), ByVal bt As Byte()) As Integer
For Each kp As KeyValuePair(Of Byte(), Integer) In dic
If ByteArrayEquals(kp.Key, bt) Then
Return kp.Value
End If
Next
End Function
The idea behind my implementation is from https://www.cs.cf.ac.uk/Dave/Multimedia/node214.html . But somehow it doesn't work, it simply puts out the input bytes. What is wrong with it?
The main problem is these two lines:
If bts.Count > 1 Then
ByteDictionary.Add(bts.ToArray, 255 + DictionaryN)
In both lines here you're using bts where you should be using bts + currentByte, i.e. you want something like
Dim currentbyte As Byte = FileBytes(index)
Dim btsPlusCurrentByte As List(Of Byte) = AddToList(bts, currentbyte)
If ContainsByte(ByteDictionary, btsPlusCurrentByte.ToArray) Then
bts.Add(currentbyte)
Else
If btsPlusCurrentByte.Count > 1 Then
ByteDictionary.Add(btsPlusCurrentByte.ToArray, 255 + DictionaryN)
The other problem is that you'll complete the loop with data left in bts that you haven't output, so I think you'll need a block to do that afterwards. It may be safe to just do
Console.WriteLine(GetByteValue(ByteDictionary, bts.ToArray))
again after the Next but I haven't thought about that very carefully.
I also think you should be able to use .NET's own built-ins rather than your four helper functions.

Cant use .GetBytes and .ComputeHash methods on VBA

I want to translate a VB function to VBA. The function is using "System.Text.UTF8Encoding" and "System.Security.Cryptography.HMACSHA256"
Objects and their ".GetBytes" and ".ComputeHash" methods.
I already added "System" and "mscorlib.dll" referrences to the VBA code, but I'm receiving "Invalid procedure call or argument" error.
Here is my VB function:
Function HashString(ByVal StringToHash As String, ByVal HachKey As String) As String
Dim myEncoder As New System.Text.UTF8Encoding
Dim Key() As Byte = myEncoder.GetBytes(HachKey)
Dim Text() As Byte = myEncoder.GetBytes(StringToHash)
Dim myHMACSHA256 As New System.Security.Cryptography.HMACSHA256(Key)
Dim HashCode As Byte() = myHMACSHA256.ComputeHash(Text)
Dim hash As String = Replace(BitConverter.ToString(HashCode), "-", "")
Return hash.ToLower
End Function
And this is what I've already translated into VBA:
Function HashString(ByRef StringToHash As String, ByRef HachKey As String) As String
Dim myEncoder As Object
Dim myHMACSHA256 As Object
Dim Key As Byte
Dim Text As Byte
Dim HashCode As Byte
Dim hash As String
Set myEncoder = CreateObject("System.Text.UTF8Encoding")
Set myHMACSHA256 = CreateObject("System.Security.Cryptography.HMACSHA256")
Key = myEncoder.GetBytes(HachKey)
Text = myEncoder.GetBytes(StringToHash)
HashCode = myHMACSHA256.ComputeHash(Text)
hash = Replace(BitConverter.ToString(HashCode), "-", "")
HashString = hash.ToLower
End Function
Can anybody help on this? My first guess is that I'm using ".GetBytes" and ".ComputeHash" methods incorrectly
Thanks in advance
A working example to compute the HMACSHA256 with VBA:
Function ComputeHMACSHA256(key As String, text As String) As String
Dim encoder As Object, crypto As Object
Dim hash() As Byte, hmacsha As String, i As Long
' compute HMACSHA256
Set encoder = CreateObject("System.Text.UTF8Encoding")
Set crypto = CreateObject("System.Security.Cryptography.HMACSHA256")
crypto.key = encoder.GetBytes_4(key)
hash = crypto.ComputeHash_2(encoder.GetBytes_4(text))
' convert to an hexa string
hmacsha = String(64, "0")
For i = 0 To 31
Mid$(hmacsha, i + i + (hash(i) > 15) + 2) = Hex(hash(i))
Next
ComputeHMACSHA256 = LCase(hmacsha)
End Function
Sub UsageExample()
Debug.Print ComputeHMACSHA256("abcdef", "12345")
End Sub
When used via COM in order to support overloading .Net functions have implementations based on Name_n. As GetBytes is overloaded you need GetBytes_4() which is the overload that accepts a string and _2 for ComputeHash()
Function HashString(ByRef StringToHash As String, ByRef HachKey As String) As String
Dim myEncoder As Object
Dim myHMACSHA256 As Object
Dim Key() As Byte '// all need to be arrays
Dim Text() As Byte
Dim HashCode() As Byte
Dim hash As String
Set myEncoder = CreateObject("System.Text.UTF8Encoding")
Set myHMACSHA256 = CreateObject("System.Security.Cryptography.HMACSHA256")
Key = myEncoder.GetBytes_4(HachKey)
Text = myEncoder.GetBytes_4(StringToHash)
HashCode = myHMACSHA256.ComputeHash_2(Text)
Dim i As Long
For i = 0 To UBound(HashCode)
Debug.Print Format$(Hex(HashCode(i)), "00")
Next
End Function
?HashString("qwe", "rty")
80
D5
22
5D
83
06
...

VisualBasic 2013 ReadMemory

why I only get "0" back? My Code:
Dim GeldAdresse As String = "811768"
Dim offsets(1) As Integer
offsets = {&H28, &H2C}
Dim ergebniss As Integer = Memory.ReadPointerInteger("eurotrucks2", 811768, offsets)
The Module "Memory":
Public Function ReadPointerInteger(ByVal EXENAME As String, ByVal Pointer As Integer, ByVal ParamArray Offset As Integer()) As Integer
Dim Value As Integer
If Process.GetProcessesByName(EXENAME).Length <> 0 Then
Dim Handle As Integer = Process.GetProcessesByName(EXENAME)(0).Handle
If Handle <> 0 Then
For Each I As Integer In Offset
ReadMemoryInteger(Handle, Pointer, Pointer)
Pointer += I
Next
ReadMemoryInteger(Handle, Pointer, Value)
End If
End If
Return Value
End Function
In the Example:
' Me.Text = ReadPointerInteger("gta_sa", &HB71A38,&H540,&H544).ToString()
Must I convert 0x2C in a Integer?
Dim Value As Integer
...
Return Value
You are returning Value but never assing a real value to it. Looks like you need to change your code to:
Dim Value As Integer
...
Value = ReadMemoryInteger(...
...
Return Value
The class is broken. I use antoher.

Fortran dll call from VB.Net

Below code contains the fortran77 dll call from vb.net with two-dimensional array and struture. Input Parameters are flg & a_in(,), it calculates some value and in turn it populates the output array in a_pn(,) and a_vOUT(,). There is a addressof callback function used in fortran dll. I wasn't able to fetch the output values to proceed further.
---VB.Net Code with Fortran dll call---
Dim flg As Int32
Dim a_in(,) As Double --- Input array with values
Dim a_PN(,) as Double ----Output array return from Fortran77 DLL (Value calculated from a_in(,) array and returns)
Dim a_vOUT(,) as Double ----Output array return from Fortran77 DLL
Dim a_Flgs(,) as Int32
Dim a_b() as byte
Dim a_string1 As New VB6.FixedLengthString(255)
Public Structure Case_Info
Dim nx() As Double
Dim ny() As Double
Dim tc() As Double
Dim ip(,) As Double
End Structure
W_Ftrn(Flg, a_in(1, 1), a_PN(1, 1),a_vOUT(1, 1), a_Flgs(1, 1), .TC(1), .ip(1, 1),.nx(1), .ny(1), AddressOf CallBack0, AddressOf CallBack1, a_b(1), a_string1.Value, 255)
---Fortran declaration in vb.net--
Public Declare Sub W_Ftrn _
Lib "D:\Proj2\Fortran.DLL" Alias "W_Ftrn" _
(ByRef flg As integer,ByRef a_in As Double, ByRef a_PN As Double, ByRef a_vOUT As Double, ByRef a_Flgs As Int32, _
ByRef constray As Double, ByRef ipn As Double, _
ByRef aGX%, ByRef aGY#, _
ByVal cbaddr0 As long,ByVal cbaddr1 As long,ByRef bPlain As Byte, _
ByVal s1 As String, ByRef L1 As Int32)
My guess is that you are going to have to do your own manual copy-in and copy-out of the array-cells that you want to write to before and after the F77 call. Something like this:
Dim a_in1 As Double
Dim a_PN1 as Double
Dim a_vOUT1 as Double
Dim a_Flgs1 as Int32
Dim a_b1 as byte
Dim nx As Double
Dim ny As Double
Dim tc As Double
Dim ip1 As Double
' copy-in, manually '
a_in1 = a_in(1, 1)
a_PN1 = a_PN(1, 1)
a_vOUT1 = a_vOUT(1, 1)
a_Flgs1 = a_Flgs(1, 1)
tc = .TC(1)
ip1 = .ip(1, 1)
nx = .nx(1)
ny = .ny(1)
a_b1 = a_b(1)
W_Ftrn(Flg, a_in1, a_PN1,a_vOUT1, a_Flgs1, TC, ip1, nx, ny, AddressOf CallBack0, AddressOf CallBack1, a_b1, a_string1.Value, 255)
' copy-out, manually '
a_in(1, 1) = a_in1
a_PN(1, 1) = a_PN1
a_vOUT(1, 1) = a_vOUT1
a_Flgs(1, 1) = a_Flgs1
.TC(1) = tc
.ip(1, 1) = ip1
.nx(1) = nx
.ny(1) = ny
a_b(1) = a_b1