Any help with the following greatly appreciated.....
I have some C++ code I've inherited which decrypts certain structures/byte arrays; I've been trying to write a test program in VB.net which exactly mimics the C++ decryption routine using the same functions, ie. using the WinAPI Crypto calls; in testing, CryptAcquireContext, CryptCreateHash, CryptHashData and CryptDeriveKey all succeed;
However, both the CryptEncrypt and CryptDecrypt functions fail with the Invalid Parameter error, even in the most simple scenario;
(I am aware of the System.Security.Cryptography namespace...and I will resort to this...but the C++ code includes structures with unions, and for testing, it seemed better to try the WinAPI route first)
the sample code is below...I am on Win7x64 sp1, vs 2010 sp1...
Private Sub cmdTest(sender As System.Object, e As System.EventArgs) Handles cmdtest.Click
Dim hCrypt As IntPtr
Dim hSecretHash, hUserHash As IntPtr
Dim hSecretKey As IntPtr
Dim success As Boolean
If CryptAcquireContext(hCrypt, vbNullString, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) Then
'create hash
success = CryptCreateHash(hCrypt, CALG_MD5, 0, 0, hSecretHash)
'hash stage 1
success = CryptHashData(hSecretHash, Encoding.ASCII.GetBytes("yyyyyy"), "xxxxxx".length, 0)
success = CryptHashData(hSecretHash, Encoding.ASCII.GetBytes("yyyyyy"), "yyyyyy".length, 0)
'derive key
success = CryptDeriveKey(hCrypt, CALG_RC4, hSecretHash, 0, hSecretKey)
Dim newb(127) As Byte
Dim teststring As String = "Testing"
Dim testbytes() As Byte = Encoding.ASCII.GetBytes(teststring)
Buffer.BlockCopy(testbytes, 0, newb, 0, testbytes.Length)
Dim inputlength As UShort = Convert.ToUInt16(testbytes.Length)
Dim newblength As UShort = CUShort(newb.Length)
Dim bufferlength As UShort = newblength
'---------------BOTH THESE FAIL (all above OK)
success = CryptEncrypt(hSecretKey, 0, True, 0, newb, newblength, inputlength)
success = CryptDecrypt(hSecretKey, 0, True, 0, newb, newblength)
'--------------------------------------------
'Destroy the user keycode
CryptDestroyHash(hUserHash)
'Destroy the secret key
CryptDestroyKey(hSecretKey)
CryptDestroyHash(hSecretHash)
'Release the provider
CryptReleaseContext(hCrypt, 0)
End If
End Sub
Public Const ALG_CLASS_DATA_ENCRYPT As Int32 = 24576
Public Const ALG_CLASS_HASH As Int32 = 32768
Public Const ALG_TYPE_ANY As Int32 = 0
Public Const ALG_SID_RC4 As Int32 = 1
Public Const ALG_SID_RC2 As Int32 = 2
Public Const ALG_SID_MD5 As Int32 = 3
Public Const ALG_SID_SHA1 As Int32 = 4
Public Const ALG_SID_MAC As Int32 = 5
Public Const ALG_SID_HMAC As Int32 = 9
Public Const ALG_TYPE_BLOCK As Int32 = 1536
Public Const ALG_TYPE_STREAM As Int32 = 2048
Public Const CALG_MD5 As Int32 = ALG_CLASS_HASH + ALG_TYPE_ANY + ALG_SID_MD5
Public Const CALG_RC2 As Int32 = ALG_CLASS_DATA_ENCRYPT + ALG_TYPE_BLOCK + ALG_SID_RC2
Public Const CALG_RC4 As Int32 = ALG_CLASS_DATA_ENCRYPT + ALG_TYPE_STREAM + ALG_SID_RC4
Public Const CALG_SHA1 As Int32 = ALG_CLASS_HASH + ALG_TYPE_ANY + ALG_SID_SHA1
Public Const CALG_MAC As Int32 = ALG_CLASS_HASH + ALG_TYPE_ANY + ALG_SID_MAC
Public Const CALG_HMAC As Int32 = ALG_CLASS_HASH + ALG_TYPE_ANY + ALG_SID_HMAC
Public Const PROV_RSA_FULL As Int32 = &H1
Public Const CRYPT_VERIFYCONTEXT As Int32 = &HF0000000
Public Const HP_ALGID As Int32 = 1
Public Const HP_HASHVAL As Int32 = 2
Public Const HP_HASHSIZE As Int32 = 4
Public Const HP_HMAC_INFO As Int32 = 5
Public Const MS_DEF_PROV As String = "Microsoft Base Cryptographic Provider v1.0"
'Imported Functions:
<DllImport("advapi32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
Public Shared Function CryptAcquireContext( _
ByRef hProv As IntPtr, _
ByVal pszContainer As String, _
ByVal pszProvider As String, _
ByVal dwProvType As Int32, _
ByVal dwFlags As Int32 _
) As Boolean
End Function
<DllImport("advapi32.dll", SetLastError:=True)>
Public Shared Function CryptEncrypt( _
ByVal hKey As IntPtr, _
ByVal hHash As IntPtr, _
ByVal Final As Boolean, _
ByVal dwFlags As UShort, _
pbData() As Byte, _
pdwDataLen As UShort, _
ByVal dwBufLen As UShort) As Boolean
End Function
<DllImport("advapi32.dll", SetLastError:=True, CharSet:=CharSet.Unicode)>
Public Shared Function CryptDecrypt( _
ByVal hKey As IntPtr, _
ByVal hHash As IntPtr, _
ByVal Final As Boolean, _
ByVal dwFlags As UShort, _
pbData() As Byte, _
pdwDataLen As UShort _
) As Boolean
End Function
<DllImport("advapi32.dll", SetLastError:=True)> _
Public Shared Function CryptCreateHash( _
ByVal hProv As IntPtr, _
ByVal Algid As Int32, _
ByVal hKey As IntPtr, _
ByVal dwFlags As Int32, _
ByRef phHash As IntPtr _
) As Boolean
End Function
<DllImport("advapi32.dll", SetLastError:=True)> _
Public Shared Function CryptDestroyHash( _
ByVal hHash As IntPtr _
) As Boolean
End Function
<DllImport("advapi32.dll", SetLastError:=True)> _
Public Shared Function CryptHashData( _
ByVal hHash As IntPtr, _
ByVal pbData() As Byte, _
ByVal dwDataLen As Int32, _
ByVal dwFlags As Int32 _
) As Boolean
End Function
<DllImport("advapi32.dll", setlasterror:=True)> _
Public Shared Function CryptDeriveKey( _
ByVal hProv As IntPtr, _
ByVal Algid As Integer, _
ByVal hBaseData As IntPtr, _
ByVal dwflags As Integer, _
ByRef phKey As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
<DllImport("advapi32.dll", SetLastError:=True)> _
Public Shared Function CryptDestroyKey( _
ByVal hKey As IntPtr _
) As Boolean
End Function
The Final parameter of CryptEncrypt is a BOOL, which is a 32-bit int. Try changing the parameter to Final as int32,or use MarshalAs(UnmanagedType.Bool)
Could be more things, but immediately ByVal dwFlags As UShort looks off to me.
The msdn lists that parameter as:
DWORD dwFlags,
A DWORD is 4 bytes, so would be an Int32 or Integer (in VB.NET)
Related
CryptAcquireContext function returns FALSE with The Keyset is not defined error message. Here is my code.
<DllImport("advapi32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
Public Shared Function CryptAcquireContext(ByRef hProv As IntPtr, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Int32, ByVal dwFlags As UInt32) As Boolean
End Function
<DllImport("advapi32.dll", SetLastError:=True)>
Public Shared Function CryptCreateHash(ByVal hProv As IntPtr, ByVal Algid As Int32, ByVal hKey As IntPtr, ByVal dwFlags As Int32, ByRef phHash As IntPtr) As Boolean
End Function
<DllImport("advapi32.dll", SetLastError:=True)>
Public Shared Function CryptHashData(ByVal hHash As IntPtr, ByVal pbData() As Byte, ByVal dwDataLen As Int32, ByVal dwFlags As Int32) As Boolean
End Function
Public Const PROV_RSA_FULL As Int32 = 1
Private Const CRYPT_VERIFYCONTEXT As UInt32 = &HF0000000UI
Private Function GetHash(ByVal text As String) As Boolean
Dim bResult As Boolean = False
Dim hProv As IntPtr
Dim hHash As IntPtr
If CryptAcquireContext(hProv, vbNull, vbNull, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) Then
If CryptCreateHash(hProv, CALG_SHA1, 0, 0, hHash) Then
If CryptHashData(hHash, Encoding.ASCII.GetBytes(text), text.Length, 0) Then
Dim bHash(20) As Byte
Dim dwHashLen As Int32 = Marshal.SizeOf(bHash)
bResult = CryptGetHashParam(hHash, HP_HASHVAL, bHash, dwHashLen, 0)
If bResult = True Then
//Rest of string operations
End If
End If
End If
End If
Dim errorMessage As String = New Win32Exception(Marshal.GetLastWin32Error()).Message
MsgBox(errorMessage)
Return bResult
End Function
Do you have any idea about what i'm doing wrong?
Thanks
I have the following issue with my code.
Win32 handle that was passed to Icon is not valid or is the wrong type
The line of codes are as follow:
SHFILEINFO Declaration
Private Structure SHFILEINFO
Public hIcon As IntPtr ' : iconc
Public iIcon As Integer ' : icondex
Public dwAttributes As Integer ' : SFGAO_ flags
_
Public szDisplayName As String
_
Public szTypeName As String
End Structure
SHGetFileInfo Declaration
Private Declare Auto Function SHGetFileInfo Lib "shell32.dll" _
(ByVal pszPath As String, _
ByVal dwFileAttributes As Integer, _
ByRef psfi As SHFILEINFO, _
ByVal cbFileInfo As Integer, _
ByVal uFlags As Integer) As IntPtr
Private Const SHGFI_ICON = &H100
Private Const SHGFI_SMALLICON = &H1
Private Const SHGFI_LARGEICON = &H0 ' Large icon
Private Const MAX_PATH = 260
SHGetFileInfo Usage
Private Sub AddImageToImageListBox(ByVal strFileName As String)
On Error GoTo errHandler
Dim shInfo As SHFILEINFO
shInfo = New SHFILEINFO()
shInfo.szDisplayName = New String(vbNullChar, MAX_PATH)
shInfo.szTypeName = New String(vbNullChar, 80)
Dim hIcon As IntPtr
hIcon = SHGetFileInfo(strFileName, 0, shInfo, Marshal.SizeOf(shInfo), SHGFI_ICON Or SHGFI_SMALLICON)
Dim MyIcon As Drawing.Bitmap
MyIcon = Drawing.Icon.FromHandle(shInfo.hIcon).ToBitmap
imgAttachment.AddImage(MyIcon)
ilstAttachments.Items.Add(strFileName.ToString(), imgAttachment.Images.Count - 1)
Exit Sub
errHandler:
ErrMsg("AddImageToImageListBox (errHandler)")
End Sub
Runtime
Here are the values that being passed into SHGetFileInfo.
strFileName = "Copy (223) of Uncollected Card - Multiple Pages.TIF"
shInfo.dwAttributes = 0
shInfo.hIcon = 0
shInfo.iIcon = 0
shInfo.szDisplayName = ""
shInfo.szTypeName = ""
Error
When the stated values above are being passed to SHGetFileInfo, it returns 0 value thus making hIcon = 0.
When it reaches
MyIcon = Drawing.Icon.FromHandle(shInfo.hIcon).ToBitmap
The following error occurred
Win32 handle that was passed to Icon is not valid or is the wrong type
Can you guys help me to identify what is the issue?
Thank you
Try changing SHFILEINFO and SHGetFileInfo to this
Private Structure SHFILEINFO
Public hIcon As IntPtr ' : iconc
Public iIcon As Integer ' : icondex
Public dwAttributes As Integer ' : SFGAO_ flags
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=260)> _
Public szDisplayName As String
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=80)>
Public szTypeName As String
End Structure
Private Declare Ansi Function SHGetFileInfo Lib "shell32.dll" (ByVal pszPath As String, _
ByVal dwFileAttributes As Integer, ByRef psfi As SHFILEINFO, ByVal cbFileInfo As Integer, _
ByVal uFlags As Integer) As IntPtr
Also, I would lose the On Error Goto and use a Try/Catch.
I'm using this code to enumerate all values in a registry key.
Private ReadOnly HKeyLocalMachine As New IntPtr(-2147483646)
Private Const KeyQueryValueWow64Key As Integer = &H101
Private Const ErrorNoMoreItems As Integer = &H103
Private Const errorSuccess As Integer = &H0
Dim keyHandle As IntPtr = Nothing
RegOpenKeyEx(HKeyLocalMachine, newPath, 0, KeyQueryValueWow64Key, keyHandle)
If keyHandle = Nothing Then
Return "Error accessing registry key"
End If
Dim index As Integer = 0
Dim valueName As New StringBuilder(1000)
Dim valueLenght As UInteger
Dim valueDataLenght As IntPtr
If RegQueryInfoKey(keyHandle, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, valueLenght, valueDataLenght, Nothing, Nothing) = errorSuccess Then
Debug.WriteLine("SUCCESS IN REGQUERYINFOKEY")
End If
Do
returnValue = RegEnumValue(keyHandle, index, valueName, valueLenght, Nothing, Nothing, datalenght, valueDataLenght)
If returnValue = errorSuccess Then
Debug.WriteLine("Success")
End If
index = index + 1
Loop Until returnValue = ErrorNoMoreItems
Here are my API declarations:
<DllImport("advapi32.dll", CharSet:=CharSet.Unicode)> _
Private Shared Function RegOpenKeyEx( _
hKey As IntPtr, _
subKey As String, _
ulOptions As Integer, _
samDesired As Integer, _
ByRef hkResult As IntPtr _
) As Integer
End Function
<DllImport("advapi32.dll", SetLastError:=True)> _
Private Shared Function RegEnumValue( _
ByVal hKey As IntPtr, _
ByVal dwIndex As Integer, _
ByVal lpValueName As StringBuilder, _
ByRef lpcValueName As UInteger, _
ByVal lpReserved As IntPtr, _
ByVal lpType As IntPtr, _
ByVal lpData As IntPtr, _
ByVal lpcbData As IntPtr _
) As Integer
End Function
<DllImport("advapi32.dll")> _
Private Shared Function RegQueryInfoKey( _
hkey As IntPtr, _
ByRef lpClass As StringBuilder, _
ByRef lpcbClass As UInteger, _
lpReserved As IntPtr, _
ByRef lpcSubKeys As UInteger, _
ByRef lpcbMaxSubKeyLen As UInteger, _
ByRef lpcbMaxClassLen As UInteger, _
ByRef lpcValues As UInteger, _
ByRef lpcbMaxValueNameLen As UInteger, _
ByRef lpcbMaxValueLen As IntPtr, _
ByRef lpcbSecurityDescriptor As UInteger, _
lpftLastWriteTime As IntPtr _
) As Integer
End Function
And i'm getting AccessViolationException when i pass the last parameter of RegEnumValue non-null, if i pass a null IntPtr the function succeeds but no data is retrieved, only the name.
I've tried changing the API variables with no luck, the other two functions always succeed.
The reason that the code fails is that you did not initialise valueDataLenght. Incidentally, you mean to name this variable valueDataLength.
You need the IntPtr variable valueDataLength to refer to a DWORD that contains the length of the data buffer. Using IntPtr here makes life difficult for you. I'd declare the parameter like this instead:
ByRef lpcbData As Integer
I want to use a function from a dll :
<DllImport("netXTransport.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto, ExactSpelling:=True)> _
Public Shared Function xSysdeviceUpload(ByVal hSysdevice As IntPtr, ByVal ulChannel As UInt32, ByVal ulMode As UInt32, ByVal pszFileName As IntPtr, ByVal pabFileData As IntPtr, ByVal pulFileSize As IntPtr, ByVal pfnCallback As PFN_NXAPI_PROGRESS_CALLBACK, ByVal pfnRecvPktCallback As PFN_NXAPI_BROWSE_CALLBACK, ByVal pvUser As IntPtr) As Int32
End Function
with
Public Delegate Sub PFN_NXAPI_PROGRESS_CALLBACK(ByVal ulStep As UInt32, ByVal ulMaxStep As UInt32, ByVal pvUser As IntPtr, ByVal bFinished As Char, ByVal lError As Int32)
(for information the C interface is :
int32_t APIENTRY xSysdeviceUpload(CIFXHANDLE hSysdevice, uint32_t ulChannel, uint32_t ulMode, char* pszFileName, uint8_t* pabFileData, uint32_t* pulFileSize, PFN_PROGRESS_CALLBACK pfnCallback, PFN_RECV_PKT_CALLBACK pfnRecvPktCallback, void* pvUser)`;)
My pfnCallback function is done in managed memory (vb.net) :
<AllowReversePInvokeCalls()>
Public Shared Sub TCPRenderProgressBar(ByVal ulStep As UInt32, ByVal ulMaxStep As UInt32, ByVal pvUser As IntPtr, ByVal bFinished As Char, ByVal lError As Int32)
End Sub
therefore I did this in my code to use the function :
Dim pFile As IntPtr = Marshal.AllocHGlobal(CInt(FileLength))
Dim pFileLength As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(FileLength))
Dim pszFileName As IntPtr = Marshal.AllocHGlobal(szFileName.Length)
Dim Temp() As Byte = g_encoding.GetBytes(szFileName & " ")
Temp(szFileName.Length) = 0
Marshal.Copy(Temp, 0, pszFileName, (szFileName.Length + 1))
iResult = xSysdeviceUpload(g_hSysdevice, 0, DOWNLOAD_MODE_FILE, pszFileName, pFile, pFileLength, AddressOf TCPRenderProgressBar, Nothing, Nothing)
All run good if no callback is declared (AddressOf TCPRenderProgressBar replaced by anything), but if I declare (AddressOf) TCPRenderProgressBar, I saw that I pass in function TCPRenderProgressBar but I an error AccessViolationException after...
What is the problem ?
Thank you for your help
the purpose is to send a message from an vb.net application to another application using winapi sendmessage. I cannot get it to work. Your help is greatly appreciated
This is what I have, but it does not seems to work
Public Class WinAPI
Private hwnd As Integer
Private Declare Auto Function FindWindow Lib "user32" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As IntPtr
'FindWindowByClass
Private Declare Auto Function FindWindow Lib "user32" _
(ByVal lpClassName As String, _
ByVal zero As IntPtr) As IntPtr
'FindWindowByCaption
Private Declare Auto Function FindWindow Lib "user32" _
(ByVal zero As IntPtr, _
ByVal lpWindowName As String) As IntPtr
Private Declare Auto Function SendMessage Lib "user32" _
(ByVal hWnd As IntPtr, _
ByVal Msg As Integer, _
ByVal wParam As IntPtr, _
ByRef lParam As COPYDATASTRUCT) As Boolean
Public Const WM_COPYDATA As Integer = &H4A
<StructLayout(LayoutKind.Sequential)> _
Structure COPYDATASTRUCT
Dim dwData As Long
Dim cbData As Long
Dim lpData As IntPtr
End Structure
Public Sub SendToeSignal(ByVal strMessage As String)
hwnd = FindWindow(vbNullString, "eSignalSink")
' hwnd = FindWindow("eSignalSink", "vbNullString")
Dim DataStruct As New COPYDATASTRUCT
' strMessage = "1" & "," & strMessage & Chr(0) & vbCr 'Null terminated & carriage return
strMessage = "1" & "," & strMessage & vbCr 'Null terminated & carriage return
DataStruct.dwData = 1
DataStruct.cbData = strMessage.Length * Marshal.SystemDefaultCharSize
DataStruct.lpData = Marshal.StringToCoTaskMemAuto(strMessage)
SendMessage(hwnd, WM_COPYDATA, 0, DataStruct)
Marshal.FreeCoTaskMem(DataStruct.lpData)
End Sub
End Class
It looks like you have a VB6 style definition of your COPYDATASTRUCT try this instead.
From above PInvoke link:
<StructLayout(LayoutKind.Sequential)> _
Structure COPYDATASTRUCT
Public dwData As IntPtr
Public cdData As Integer
Public lpData As IntPtr
End Structure
First of all do yourself a favor and enable Option Strict expecially when you are working with API functions. You are sending a structure between your applications and will need to make sure you can retrieve it at the receiving application. I made some changes to your example code and it does work, receiving the data in a test program that the main Form is named TestApp.
Your example with modifications
Option Strict On
Imports System.Runtime.InteropServices
Public Class Form1
Public Sub New()
' This call is required by the designer.
InitializeComponent()
Dim myWinAPI As WinAPI = New WinAPI
myWinAPI.SendToeSignal("Hello World")
' Add any initialization after the InitializeComponent() call.
End Sub
End Class
Public Class WinAPI
Private hwnd As IntPtr
Private Declare Auto Function FindWindow Lib "user32" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As IntPtr
'FindWindowByClass
Private Declare Auto Function FindWindow Lib "user32" _
(ByVal lpClassName As String, _
ByVal zero As IntPtr) As IntPtr
'FindWindowByCaption
Private Declare Auto Function FindWindow Lib "user32" _
(ByVal zero As IntPtr, _
ByVal lpWindowName As String) As IntPtr
Private Declare Auto Function SendMessage Lib "user32" _
(ByVal hWnd As IntPtr, _
ByVal Msg As Integer, _
ByVal wParam As IntPtr, _
ByRef lParam As COPYDATASTRUCT) As Boolean
Public Const WM_COPYDATA As Integer = &H4A
<StructLayout(LayoutKind.Sequential)> _
Structure COPYDATASTRUCT
Dim dwData As IntPtr
Dim cbData As Integer
Dim lpData As IntPtr
End Structure
Public Sub SendToeSignal(ByVal strMessage As String)
hwnd = FindWindow(IntPtr.Zero, "TestApp")
Dim DataStruct As New COPYDATASTRUCT
strMessage = "1" & "," & strMessage & vbCr 'Null terminated & carriage return
DataStruct.dwData = CType(1, IntPtr)
DataStruct.cbData = strMessage.Length * Marshal.SystemDefaultCharSize
DataStruct.lpData = Marshal.StringToCoTaskMemAuto(strMessage)
SendMessage(hwnd, WM_COPYDATA, IntPtr.Zero, DataStruct)
Marshal.FreeCoTaskMem(DataStruct.lpData)
End Sub
Public Sub New()
End Sub
End Class
Receiving Application
Imports System.Runtime.InteropServices
Imports System.Text
Public Class Form1
<StructLayout(LayoutKind.Sequential)> _
Structure COPYDATASTRUCT
Dim dwData As IntPtr
Dim cbData As Integer
Dim lpData As IntPtr
End Structure
Public Const WM_COPYDATA As Integer = &H4A
Dim split() As String = New String() {",", " "}
Dim myData() As String
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
MyBase.WndProc(m)
If m.Msg = WM_COPYDATA Then
Dim CD As COPYDATASTRUCT = DirectCast(m.GetLParam(GetType(COPYDATASTRUCT)), COPYDATASTRUCT)
Dim B As Byte() = New Byte(CD.cbData - 1) {}
Dim lpData As IntPtr = CD.lpData
Marshal.Copy(lpData, B, 0, CD.cbData)
Dim strData As String = Encoding.[Default].GetString(B)
myData = strData.Split(split, StringSplitOptions.None)
End If
End Sub
End Class
Thanks for the first example that almost worked for my application.
The receiver application need the string in ANSI ( WinAmp ) so I had to change the line:
DataStruct.lpData = Marshal.StringToCoTaskMemAuto(strMessage)
to
DataStruct.lpData = Marshal.StringToCoTaskMemAnsi(strMessage)
Besides that it worked like a charm, first example that got the pointers correctly for x64 - x32. Just wish I found this first in my 24 hr quest
Win 10. Visualstudio2017 vb.net