Fortran dll call from VB.Net - 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

Related

Assign a string to a byte array in a VBA user-defined type

I work with a relay module that I normaly connect via USB. That all works perfectly. Now I would like to connect it via the network. All manufacturer's VB.NET code works in vba except for accessing this module over the network.
Public Declare PtrSafe Function DapiOpenModuleEx Lib "DELIB64" (ByVal moduleID As Long, ByVal nr As Long, ByRef exbuffer As DAPI_OPENMODULEEX_STRUCT, ByVal open_options As Long) As Long
' Definitions for DapiOpenEx
Public Type DAPI_OPENMODULEEX_STRUCT
address(255) As Byte
timeout As Long
portno As Long
encryption_type As Long
encryption_password(31) As Byte
End Type
'Open ETH-Module with parameter
Dim handle as Ulong
Dim MyModuleID As UInt32
MyModuleID = 42
Dim open_buffer As New DELib64.DAPI_OPENMODULEEX_STRUCT
open_buffer.address = System.String.Copy(192.168.1.1 As String) As String
open_buffer.portno = 0
handle = DELib.DapiOpenModuleEx(MyModuleID, 0, open_buffer)
I am getting an error "open_buffer.address = System.String.Copy(192.168.1.1 As String) As String "
Can someone help me with what i need to change here?
Dim handle as LongLong
Dim MyModuleID As Long
MyModuleID = 42
Dim open_buffer As Delib64.DAPI_OPENMODULEEX_STRUCT
open_buffer.address = system.String.Copy("192.168.1.1" AS String) As String
open_buffer.portno = 0
handle1 = DapiOpenModuleEx(MyModuleID, 0, open_buffer, 0)
According to your comment, the original line of code is
strcpy((char*) open_buffer.address, "192.168.1.10");
So you need to copy the ASCII (single-byte) string "192.168.1.10" into a VBA byte array. This is surprisingly hard, since the obvious approach of open_buffer.address = StrConv("192.168.1.10", vbFromUnicode) won't work (you can't assign to a fixed-size array that's part of a type).
One obvious solution would be to make a Windows API call to CopyMemory, but if we want a VBA-only solution, a simple loop should suffice:
Dim i As Long
Dim b() As Byte
b = StrConv("192.168.1.10", vbFromUnicode)
For i = 0 To UBound(b)
open_buffer.address(i) = b(i)
Next
open_buffer.address(UBound(b) + 1) = 0 ' C-strings need to be 0-terminated
(I do have the feeling that this should be easier, so I'll gladly upvote competing, simpler answers.)

How to perform face recognition using Dahua NVR from VB.NET

Has anyone used VB.NET to get face recognition data from a Dahua NVR using VB.NET?
I am facing two problems that I just can't figure out.
I can connect to the NVR and set up a callback for video using
bDeviceInitialized = CLIENT_Init(AddressOf DeviceDisconnected, 0)
Dim lSDKVersion As Long
lSDKVersion = CLIENT_GetSDKVersion()
console.writeline( "SDK: " + lSDKVersion.ToString.Substring(0, 1) + "." + lSDKVersion.ToString.Substring(1, 2) + " " + lSDKVersion.ToString.Substring(3) )
fAnalyzer = AddressOf AnalyzerDataCallBack
'Set reconnect callback
CLIENT_SetAutoReconnect(AddressOf DeviceReconnected, 0)
' Set device connection timeout And trial times.
' Optional operation
Dim nWaitTime As Integer = 5000 ' Timeout Is 5 seconds.
Dim nTryTimes As Integer = 3 ' If timeout, it will try to log in three times.
CLIENT_SetConnectTime(nWaitTime, nTryTimes)
'A wait is required
System.Threading.Thread.Sleep(1000)
netInLoginWithHighLevelSecurity.dwSize = Marshal.SizeOf(netInLoginWithHighLevelSecurity)
Array.Copy(System.Text.Encoding.Default.GetBytes(My.Settings.DeviceIP), netInLoginWithHighLevelSecurity.szIP, My.Settings.DeviceIP.Length)
netInLoginWithHighLevelSecurity.nPort = CInt(My.Settings.DevicePort)
Array.Copy(System.Text.Encoding.Default.GetBytes(My.Settings.DeviceUserId), netInLoginWithHighLevelSecurity.szUserName, My.Settings.DeviceUserId.Length)
Array.Copy(System.Text.Encoding.Default.GetBytes(My.Settings.DevicePassword), netInLoginWithHighLevelSecurity.szPassword, My.Settings.DevicePassword.Length)
netInLoginWithHighLevelSecurity.emSpecCap = EM_LOGIN_SPAC_CAP_TYPE.EM_LOGIN_SPEC_CAP_TCP
netOutLoginWithHighLevelSecurity.stuDeviceInfo = devInfo
netOutLoginWithHighLevelSecurity.dwSize = Marshal.SizeOf(netOutLoginWithHighLevelSecurity)
'Create a pointer for the structure
'pNetOutLoginWithHighLevelSecurity = Marshal.AllocHGlobal(Marshal.SizeOf(netOutLoginWithHighLevelSecurity))
hLoginId = CLIENT_LoginWithHighLevelSecurity(netInLoginWithHighLevelSecurity, netOutLoginWithHighLevelSecurity)
' Get the serial number of the NVR
Dim i As Integer = 0
Dim strSerial As String = ""
While i < 64 And netOutLoginWithHighLevelSecurity.stuDeviceInfo.sSerialNumber(i) <> 0
strSerial &= Chr(netOutLoginWithHighLevelSecurity.stuDeviceInfo.sSerialNumber(i))
i += 1
End While
' Enable cameras
Dim dwUser As Int64 = 0
Dim oReserved As IntPtr = 0
Dim nChannel As Int16 =0
Dim iNeedPicture As Int32 = 1
' pbChannel1 is a PictureBox
lMonitorChannel(nChannel) = CLIENT_RealPlayEx(hLoginId, nChannel, pbChannel1.Handle, EM_REAL_PLAY_TYPE.EM_REAL_PLAY_REALPLAY)
lAlarmFaceDetection(nChannel) = CLIENT_RealLoadPictureEx(hLoginId, nChannel, EVENT_IVS_ALL, iNeedPicture, fAnalyzer, Nothing, Nothing)
This works fine and I can see the video from channel 1.
The problems are in the analyzer callback which is defined as
Public Delegate Sub AnalyzerDataCallBackDelegate(lAnalyzerHandle As Int64, dwAlarmType As UInt32, AlarmInfo As IntPtr, pBuffer As IntPtr, dwBufferSize As UInt32, dwUser As Int64, nSequence As Int16, Reserved As IntPtr)
Public Shared Sub AnalyzerDataCallBack(ByVal lAnalyzerHandle As Int64, ByVal dwAlarmType As Int32, ByVal AlarmInfo As IntPtr,
ByVal pBuffer As IntPtr, ByVal dwBufferSize As Int32, ByVal dwUser As Int64, ByVal nSequence As Int16,
ByVal Reserved As IntPtr)
Firstly, I am not getting any event other than motion detect and face recognition, even though I subscribed to EVENT_IVS_ALL.
Secondly, I am not getting complete face recognition information.
I copied from the unmanaged buffer into a (complex) structure.
structFaceRecognitionInfo = CType(Marshal.PtrToStructure(AlarmInfo, GetType(DEV_EVENT_FACERECOGNITION_INFO)), DEV_EVENT_FACERECOGNITION_INFO)
But I don't get complete information. Only the first few elements are filled with the rest have garbage or zeros.
I tried copying the buffer into a byte array to inspect the data during debug and see that it is indeed filled with zeros.
Dim lenBuffer As Int32 = Marshal.SizeOf(Of DEV_EVENT_FACERECOGNITION_INFO)
ReDim bData(lenBuffer)
Dim gchBuffer As GCHandle = GCHandle.Alloc(bData, GCHandleType.Pinned)
Marshal.Copy(AlarmInfo, bData, 0, lenBuffer)
gchBuffer.Free()
I've been stuck at this point for a week.

Cross Correlation in .NET

I am working on an app that takes two audio channels and compares them to find the phase difference (delay). I came across this post;
Calculating FFT Correlation Coefficient
which refers to this sample code;
https://dotnetfiddle.net/1nWIgQ
I got the code working with correct results after translating it to VB.NET (its the language I started with years ago in this app).
The problem I see is that when I change the signal generated from random noise to a sine wave, then the code gives crazy unrelated results. Any suggestions would be appreciated.
Code below;
Imports System
Imports System.Collections.Generic
Imports System.Linq
Imports AForge.Math 'NuGet Package Aforge.Math module
Imports System.Runtime.InteropServices
Imports System.IO
Public Class Form2
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim c = New Xcorr4_2()
Dim size As Integer = 2048
Dim delay As Double
delay = 2
Dim signal1 = c.GenerateSignal(size)
Dim signal2 = c.GenerateSignal(size, delay)
Dim signal1Complex = c.ToComplexWithPadding(signal1, 2)
Dim fftSignal1 = c.FFT(signal1Complex)
Dim signal2Complex = c.ToComplexWithPadding(signal2, 2)
Dim fftSignal2 = c.FFT(signal2Complex)
Dim cc = c.CorrelationCoefficient(fftSignal1.ToArray(), fftSignal2.ToArray())
MsgBox(cc.Item1) 'correlation coeff
MsgBox(cc.Item2) 'recovered delay
End Sub
End Class
Class Xcorr4_2
Public Function CrossCorrelation(ByVal ffta As Complex(), ByVal fftb As Complex()) As Complex()
Dim conj = ffta.[Select](Function(i) New Complex(i.Re, -i.Im)).ToArray()
conj = conj.Zip(fftb, Function(v1, v2) Complex.Multiply(v1, v2)).ToArray()
FourierTransform.FFT(conj, FourierTransform.Direction.Backward)
Dim rr As Double() = New Double(conj.Length - 1) {}
rr = conj.[Select](Function(i) i.Magnitude).ToArray()
Return conj
End Function
Public Function CorrelationCoefficient(ByVal ffta As Complex(), ByVal fftb As Complex()) As Tuple(Of Double, Integer)
Dim tuble As Tuple(Of Double, Integer)
Dim correlation = CrossCorrelation(ffta, fftb)
Dim seq = correlation.[Select](Function(i) i.Magnitude)
Dim maxCoeff = seq.Max()
Dim maxIndex As Integer = seq.ToList().IndexOf(maxCoeff)
tuble = New Tuple(Of Double, Integer)(maxCoeff, maxIndex)
Return tuble
End Function
Public Function FFT(ByVal signal As Complex()) As Complex()
FourierTransform.FFT(signal, FourierTransform.Direction.Forward)
Return signal
End Function
Public Function IFFT(ByVal signal As Complex()) As Complex()
FourierTransform.FFT(signal, FourierTransform.Direction.Backward)
Return signal
End Function
Public Function ToComplexWithPadding(ByVal sample As Double(), ByVal Optional padding As Integer = 1) As Complex()
Dim logLength As Double = Math.Ceiling(Math.Log(sample.Length * padding, 2.0))
Dim paddedLength As Integer = CInt(Math.Pow(2.0, Math.Min(Math.Max(1.0, logLength), 14.0)))
Dim complex As Complex() = New Complex(paddedLength - 1) {}
Dim samples = sample.ToArray()
Dim i As Integer = 0
While i < sample.Length
complex(i) = New Complex(samples(i), 0)
i += 1
End While
While i < paddedLength
complex(i) = New Complex(0, 0)
i += 1
End While
Return complex
End Function
Public Function GenerateSignal(ByVal size As Integer, ByVal Optional shift As Integer = 0) As Double()
Dim list As List(Of Double) = New List(Of Double)()
Dim generator = New AForge.Math.Random.StandardGenerator()
' Changed original random signal to Sine wave below
For i As Integer = 0 To size - 1
'Dim randomNumber As Double = generator.[Next]()
'list.Add(randomNumber)
list.Add(Math.Sin(2 * Math.PI / 200 * i + shift))
Next
Dim list2 As List(Of Double) = New List(Of Double)()
For i As Integer = 0 To shift - 1
list2.Add(0)
Next
Dim ar = list.ToArray()
For i As Integer = 0 To size - shift - 1
list2.Add(ar(i))
Next
Return list2.ToArray()
End Function
End Class
Below is the output for original code vs the modified code with sine wave.
Original code random signal
Modified with sine wave inputs

undefined behaviour[s] with interface members

This is the story:
I want to make a vb.NET code from the DiretX 10 C++ code, the function D3DX10CreateDeviceAndSwapChain() works fine with me :
Public Declare Function D3DX10CreateDeviceAndSwapChain Lib "d3dx10_43.dll" _
(ByVal pAdapter As IDXGIAdapter,
ByVal drivertype As D3D10_DRIVER_TYPE,
ByVal software As IntPtr,
ByVal flags As UInteger,
ByRef pswapchaindesc As DXGI_SWAP_CHAIN_DESC,
ByRef ppSwapChain As IntPtr,
ByRef ppDevice As IntPtr) As Integer`
The rest of code is:
Dim swapChainDesc As New DXGI_SWAP_CHAIN_DESC()
swapChainDesc.BufferCount = 1
swapChainDesc.BufferDesc.Width = Me.Width
swapChainDesc.BufferDesc.Height = Me.Height
swapChainDesc.BufferDesc.Format = DXGI_FORMAT.DXGI_FORMAT_R8G8B8A8_UNORM
swapChainDesc.BufferUsage = 1L << (1 + 4)
swapChainDesc.OutputWindow = Me.Handle
swapChainDesc.SampleDesc.Count = 1
swapChainDesc.SampleDesc.Quality = 0
swapChainDesc.Windowed = True
Dim sc As IntPtr
Dim d As IntPtr
D3DX10CreateDeviceAndSwapChain(Nothing,D3D10_DRIVER_TYPE.D3D10_DRIVER_TYPE_HARDWARE,IntPtr.Zero,0,swapChainDesc,sc,d)
and to convert intptr to a valid interface object i use (it works fine):
Dim s As IDXGISwapChain = CType(Marshal.GetTypedObjectForIUnknown(sc, GetType(IDXGISwapChain)), IDXGISwapChain)
Dim device As ID3D10Device = CType(Marshal.GetTypedObjectForIUnknown(d, GetType(ID3D10Device)), ID3D10Device)
Dim surface As ID3D10Texture2D
s.GetBuffer(0, Marshal.GenerateGuidForType(GetType(ID3D10Texture2D)), surface)
until here the code returns success.
Dim rtv As ID3D10RenderTargetView
Dim hresult As Integer = device.CreateRenderTargetView(surface, Nothing, rtv)
surface.Release() ' this works fine
MsgBox(rtv IsNot Nothing)
the question is :
when i change the location (the ranking of the members between them into the interface ID3D10Device), i get either AccessViolationException or
ArgumentException for the line
Dim hresult as ...
why this undefined behaviours?
REMARKS : the interface ID3D10Device contains more than 80 members, i have also change some members locations and they work fine.

Array.copy method in 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))