Connect remote PC with credentials - vb.net

I have been trying to connect remote PC(with known credentials and on the same network) to my PC with vb.net but struck at following Error:
Managed Debugging Assistant 'PInvokeStackImbalance' : 'A call to PInvoke function 'WindowsApp1!WindowsApp1.Form1::WNetAddConnection2' has unbalanced the stack. This is likely because the managed PInvoke signature does not match the unmanaged target signature. Check that the calling convention and parameters of the PInvoke signature match the target unmanaged signature.'
Whereas same code has been executed flawlessly in Vb6.
Code:
Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
Private Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, ByVal fForce As Long) As Long
Private Structure NETRESOURCE
Dim dwType As Long
Dim lpRemoteName As String
End Structure
Private Const RESOURCETYPE_DISK = &H1
Private Sub ConnectToPC()
Dim networkResource As New NETRESOURCE
Dim lon As Long
With networkResource
.dwType = RESOURCETYPE_DISK
.lpRemoteName = "\\192.168.1.1"
End With
lon = WNetAddConnection2(networkResource, "123", "ADMIN", 0)
End Sub
Exception is thrown at lon and code coudn't execute further.
I am new to VB.net language.Any assistance would be very helpful.

From JQSOFT's comment:
In the signature replace (lpNetResource As NETRESOURCE, ...
with
(ByRef lpNetResource As NETRESOURCE, ... because the NETRESOURCE here is a
structure and not a class. Also, replace any Long with Integer

Related

How to resolve Error-487 during WNetAddConnection in VB.NET

I have been trying to connect remote PC with known Credentials but variable lon(refer below code) is showing Error-487.
Code:
Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" ( ByRef lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Integer) As Long
Private Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, ByVal fForce As Integer) As Long
Private Structure NETRESOURCE
Dim dwType As Long
Dim lpRemoteName As String
End Structure
Private Const RESOURCETYPE_DISK = &H1
Private Sub ConnectToPC()
Dim networkResource As New NETRESOURCE
Dim lon As Long
With networkResource
.dwType = RESOURCETYPE_DISK
.lpRemoteName = "\\192.168.1.1"
End With
lon = WNetAddConnection2(networkResource, "123", "ADMIN", 0)
msgbox(lon)
lon = WNetCancelConnection2("\\192.168.1.1", 0, 1)
msgbox(lon)
End Sub
Tried Below thing but it didn't serve my purpose
- Change type from Integer to Int32/Int64
I have been working on this issue for last two days but couldn't gain any success. Can anybody tell me what went wrong with code? Any help will be highly Appreciated

Calling On-Screen Keyboard from Excel VBA

I'm trying to pull up the on-screen keyboard.
Here are my attempts so far:
' Only needed for Test3
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Sub Test1()
' Run-time error'53':
' File Not found
Dim RetVal As Variant
RetVal = Shell("C:\WINDOWS\system32\osk.exe", 1)
End Sub
Sub Test2()
' Run-time error '432':
' File name or class name not found during Automation operation
ActiveWorkbook.FollowHyperlink Address:="C:\Windows\System32\osk.exe"
End Sub
Sub Test3()
' No error. Nothing happens at all
ShellExecute 0, vbNullString, "osk.exe", vbNullString, "C:\", 1
End Sub
Test2 from this forum.
Test3 from this forum.
I checked the path to osk.exe is correct.
I have a Surface laptop/tablet, so it has a touch screen and a "touch" keyboard (different from the osk). Is that what's causing the issue or possibly it's a Windows 10 thing?
On a 64-Bit OS try this
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function Wow64EnableWow64FsRedirection Lib "kernel32.dll" (ByVal Enable As Boolean) As Boolean
Private Sub RunOsk_on64Bit()
Const SW_SHOWNORMAL = 1
On Error Resume Next
Wow64EnableWow64FsRedirection False
ShellExecute 0, "open", "osk.exe", "", "C:\windows\system32\osk.exe", SW_SHOWNORMAL
Wow64EnableWow64FsRedirection True
End Sub
Found here, this might the explanation, quote from the link
This is an issue with 64-bit OS, it affects any 64-bit version of Windows.
Basically you are calling osk.exe, but your program you are calling it
from is a 32-bit app. Windows won't allow you to call a 64-bit OSK.exe
from your program. The comments appear to miss your point here, anyone
can start osk.exe from Run, but call it from within a 32-bit
application won't work in 64-bit Windows.
I am developing software that uses the on-screen keyboard, the only
work around is Wow64DisableWow64FsRedirection.
Update: A "nicer" version might look like that
Option Explicit
Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type
Public Declare Function ShellExecuteEx Lib "shell32.dll" _
(lpExecInfo As SHELLEXECUTEINFO) As Long
Declare Function Wow64DisableWow64FsRedirection Lib "kernel32.dll" (ByRef ptr As Long) As Boolean
Declare Function Wow64RevertWow64FsRedirection Lib "kernel32.dll" (ByRef ptr As Long) As Boolean
Public Function KeyboardOpen()
Dim shInfo As SHELLEXECUTEINFO
Dim lngPtr As Long
With shInfo
.cbSize = Len(shInfo)
.lpFile = "C:\Windows\Sysnative\cmd.exe" 'best to use Known folders here
.lpParameters = "/c start osk.exe"
.lpDirectory = "C:\windows\system32" 'best to use Known folders here
.lpVerb = "open"
.nShow = 0
End With
Call Wow64DisableWow64FsRedirection(lngPtr)
Call ShellExecuteEx(shInfo)
Call Wow64RevertWow64FsRedirection(lngPtr)
End Function
Based on the information in MSDN it might be more reliable to use Wow64DisableWow64FsRedirection and Wow64RevertWow64FsRedirection functions instead.

Is there a way to call: Protected Override void WndProc(ref Message m) in VB6?

I am implementing an application in C#.net that is passing a message to an VB6 application.
For testing I created 2 applications both in C#.NET:- One sends message and 2nd receives the message.
The receiving application (C#.NET) makes use of the following function to catch the message:-
Protected Override void WndProc(ref Message m)
I now need to implement this receiver app in VB6.. How do we implement Protected Override void WndProc(ref Message m) in VB6? Or is there any other alternative?
Overriding the default windows procedure is possible in VB6 and is called Subclassing.
In a module:
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const GWL_WNDPROC As Long = (-4)
Private originalWindowProcAddr As Long
Public Sub subclassForm(hwnd As Long)
'// replace existing windows procedure save its address
originalWindowProcAddr = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
End Sub
Public Function NewWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Debug.Print "received message for:", hwnd, "message:", uMsg
'// forward message to default
NewWindowProc = CallWindowProc(originalWindowProcAddr, hwnd, uMsg, wParam, lParam)
End Function
Public Sub unSubclassForm(hwnd As Long)
'// must tidy up by restoring the original window proc
SetWindowLong hwnd, GWL_WNDPROC, originalWindowProcAddr
End Sub
In the form
Private Sub Form_Load()
subclassForm Me.hwnd
End Sub
Private Sub form_Unload(Cancel As Integer)
unSubclassForm Me.hwnd
End Sub
Failing to call unSubclassForm will crash the VB IDE, as will breaking into debug mode.
I have followed this method:-
http://support.microsoft.com/kb/176058/en-us
Alternate link: https://web.archive.org/web/20150118054920/http://support.microsoft.com:80/kb/176058
How To Pass String Data Between Applications Using SendMessage
SUMMARY
There are many ways to achieve inter-process communication using Visual Basic. Unless you establish an OLE Automation client server relationship, string data is difficult to handle cleanly. The main reason is that 32-bit applications run in a separate address space, so the address of a string in one application is not meaningful to another application in a different address space. Using the SendMessage() API function to pass a WM_COPYDATA message avoids this problem.
This article demonstrates how to pass string data from one application to another by using the SendMessage API function with the WM_COPYDATA message.
WARNING: One or more of the following functions are discussed in this article; VarPtr, VarPtrArray, VarPtrStringArray, StrPtr, ObjPtr. These functions are not supported by Microsoft Technical Support. They are not documented in the Visual Basic documentation and are provided in this Knowledge Base article "as is." Microsoft does not guarantee that they will be available in future releases of Visual Basic.
Visual Basic does not support pointers and castings in the manner of Visual C++. In order to pass string data from one Visual Basic application to another, the Unicode string must be converted to ASCII prior to passing it to the other application. The other application must then convert the ASCII string back to Unicode.
The following summarizes how to pass string data from one application to another.
Step-by-Step Example
Convert the string to a byte array using the CopyMemory() API.
Obtain the address of the byte array using the VarPtr() intrinsic function and copy the address and length of the byte array into a COPYDATASTRUCT structure.
Pass the COPYDATASTRUCT to another application using the WM_COPYDATA message, setting up the other application to receive the message.
Unpack the structure on the target system using CopyMemory(), and convert the byte array back to a string using the StrConv() intrinsic function.
The next section shows you how to create a sample program that demonstrates passing string data from one application to another.
Steps to Create the Sample
To create this sample, you create two separate projects; a sending project and a target project.
Create the target application:
Start a new Standard EXE project in Visual Basic. Form1 is created by default. This project will be your target application.
Add a Label control to Form1.
Copy the following code to the Code window of Form1:
Private Sub Form_Load()
gHW = Me.hWnd
Hook
Me.Caption = "Target"
Me.Show
Label1.Caption = Hex$(gHW)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unhook
End Sub
Add a module to the project and paste the following code in the Module1 code window:
Type COPYDATASTRUCT
dwData As Long
cbData As Long
lpData As Long
End Type
Public Const GWL_WNDPROC = (-4)
Public Const WM_COPYDATA = &H4A
Global lpPrevWndProc As Long
Global gHW As Long
'Copies a block of memory from one location to another.
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Declare Function CallWindowProc Lib "user32" Alias _
"CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As _
Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As _
Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As _
Long) As Long
Public Sub Hook()
lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, _
AddressOf WindowProc)
Debug.Print lpPrevWndProc
End Sub
Public Sub Unhook()
Dim temp As Long
temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
End Sub
Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = WM_COPYDATA Then
Call mySub(lParam)
End If
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, _
lParam)
End Function
Sub mySub(lParam As Long)
Dim cds As COPYDATASTRUCT
Dim buf(1 To 255) As Byte
Call CopyMemory(cds, ByVal lParam, Len(cds))
Select Case cds.dwData
Case 1
Debug.Print "got a 1"
Case 2
Debug.Print "got a 2"
Case 3
Call CopyMemory(buf(1), ByVal cds.lpData, cds.cbData)
a$ = StrConv(buf, vbUnicode)
a$ = Left$(a$, InStr(1, a$, Chr$(0)) - 1)
Form1.Print a$
End Select
End Sub
Save the project and minimize the Visual Basic IDE.
Create the Sending Application
Start a second instance of the Visual Basic IDE and create a new Standard EXE project in Visual Basic. Form1 is created by default.
Add a CommandButton to Form1.
Copy the following code to the Code window of Form1:
Private Type COPYDATASTRUCT
dwData As Long
cbData As Long
lpData As Long
End Type
Private Const WM_COPYDATA = &H4A
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName _
As String) As Long
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal _
wParam As Long, lParam As Any) As Long
'Copies a block of memory from one location to another.
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Sub Command1_Click()
Dim cds As COPYDATASTRUCT
Dim ThWnd As Long
Dim buf(1 To 255) As Byte
' Get the hWnd of the target application
ThWnd = FindWindow(vbNullString, "Target")
a$ = "It Works!"
' Copy the string into a byte array, converting it to ASCII
Call CopyMemory(buf(1), ByVal a$, Len(a$))
cds.dwData = 3
cds.cbData = Len(a$) + 1
cds.lpData = VarPtr(buf(1))
i = SendMessage(ThWnd, WM_COPYDATA, Me.hwnd, cds)
End Sub
Private Sub Form_Load()
' This gives you visibility that the target app is running
' and you are pointing to the correct hWnd
Me.Caption = Hex$(FindWindow(vbNullString, "Target"))
End Sub
Save the project.
Running the Sample
Restore the target application and press the F5 key to run the project. Note that the value of the hWnd displayed in the label.
Restore the sending application and press the F5 key to run the project. Verify that the hWnd in the form caption matches the hWnd in the label on the target application. Click the CommandButton and the text message should be displayed on the form of the target application.

Mapping/unmapping drives failing

I need to first map and then later unmap 2x drives using VB.NET.
When mapping the drives, I also need to pass a username and password (as not all users have admin access).
However, not only is the below not working (failing to map, so in turn failing to unmap), but I notice that I only have the option to pass a password when mapping a drive, not a username.
Can anyone help me in fixing these problems? Thanks.
Private Declare Function WNetAddConnection Lib "mpr.dll" Alias "WNetAddConnectionA" (ByVal lpszNetPath As String,
ByVal lpszPassword As String,
ByVal lpszLocalName As String) As Long
Private Declare Function WNetCancelConnection Lib "mpr.dll" Alias "WNetCancelConnectionA" (ByVal lpszName As String,
ByVal bForce As Long) As Long
Public Function MapDrive(ByVal UNCPath As String, ByVal Password As String, ByVal DriveLetter As String) As Boolean
Dim MappedResult As Long = WNetAddConnection(UNCPath, Password, DriveLetter)
Return IIf(MappedResult = 0, True, False)
End Function
Public Function UnmapDrive(ByVal DriveLetter As String) As Boolean
Dim UnmappedResult As Long = WNetCancelConnection(DriveLetter, 0)
Return IIf(UnmappedResult = 0, True, False)
End Function
You should switch to using the WNetAddConnection2/WNetCancelConnection2 functions. The former allows you to specify a username in the call. Here are the PInvoke signatures I've used successfully in the past:
Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" _
(ByRef lpNetResource As NETRESOURCE, ByVal lpPassword As String, _
ByVal lpUserName As String, ByVal dwFlags As Integer) As Integer
Private Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" _
(ByVal lpName As String, ByVal dwFlags As Integer, ByVal fForce As Integer) As Integer
Private Declare Function WNetGetLastError Lib "mpr.dll" Alias "WNetGetLastErrorA" _
(ByRef nError As Integer, ByRef lpErrorBuf As String, ByVal nErrorBufSize As Integer, _
ByRef lpNamebuf As String, ByVal nNameBufSize As Integer) As Integer
<StructLayout(LayoutKind.Sequential)> _
Public Structure NETRESOURCE
Public dwScope As Integer
Public dwType As Integer
Public dwDisplayType As Integer
Public dwUsage As Integer
Public lpLocalName As String
Public lpRemoteName As String
Public lpComment As String
Public lpProvider As String
End Structure
Private Const ForceDisconnect As Integer = 1
Private Const RESOURCETYPE_DISK As Long = &H1
GetLastError is useful for figuring out why the mapping failed (bad password, etc).

Moving from VB5 to VB.NET and having problems with USB .dll calls

I'm trying to communicate with a usb device that uses the FDTI 232RL. I've installed the drivers and integrated the .dll calls into my VB5 code and it works well. I want to get this to work on VB.net but I get the PInvokeStackImballance error message. In VB5 I have the following code sequence:
Private Declare Function FT_ListDevices Lib "FTD2XX.DLL" (ByVal arg1 As Long, ByVal arg2 As String, ByVal dwFlags As Long) As Long
...
Dim strSerialNumber As String * 256
...
LoggerList.AddItem ("ListDevices by S/N")
If FT_ListDevices(0, strSerialNumber, FT_LIST_BY_INDEX Or FT_OPEN_BY_SERIAL_NUMBER) <> FT_OK Then
...
In VB.NET:
Private Declare Function FT_ListDevices Lib "FTD2XX.DLL" (ByVal arg1 As Long, ByVal arg2 As String, ByVal dwFlags As Long) As Long
...
Dim strSerialNumber As Stringbuilder new = stringbuilder (" ",256)
...
LoggerList.AddItem ("ListDevices by S/N")
If FT_ListDevices(0, strSerialNumber, FT_LIST_BY_INDEX Or FT_OPEN_BY_SERIAL_NUMBER) <> FT_OK Then
...
The error occurs at the if statement. Do I need to import the Dll with import("FTD2XX.dll")? I've also tried Dim strSerialNumber(256) as char and that doesn't work either. Am I working the wrong problem?
In VB5 a long is 32 bits while it is 64 its in VB.Net. Change the parameters in your function from long to int which is 32 bits on VB.Net.
Private Declare Function FT_ListDevices Lib "FTD2XX.DLL" (ByVal arg1 As Integer, _
ByVal arg2 As String, ByVal dwFlags As Integer) As Integer