First of all I'm a total newby in visual basic, I needed to hack an application that kept clicking (don't ask).
Everything is nice and dandy on my pc, then I compile, move it to its final destination and I doesn't work! At first I thought it was a OS problem, but both machines has win7, I then thought it was a compilation problem, installed visual studio on the other pc, recompiled still with no luck, then it dawned on me, may it be a problem of 32bit vs 64bit?
Sadly I don't have enough knowledge about it and so I ask you.
The piece of code is this:
Private Sub mainTimer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mainTimer.Tick
Dim keyStart As Boolean
keyStart = GetAsyncKeyState(Keys.A)
If keyStart = True Then
timeClicker.Enabled = True
timeClicker.Start()
End If
Dim keyStop As Boolean
keyStop = GetAsyncKeyState(Keys.S)
If keyStop = True Then
timeClicker.Stop()
timeClicker.Enabled = False
End If
End Sub
Private Sub timeClicker_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles timeClicker.Tick
mouse_event(mouseclickdown, 0, 0, 0, 0)
mouse_event(mouseclickup, 0, 0, 0, 0)
End Sub
MainTimer has an interval of 100 and timeClicker has an interval of 10, both are declared on the form project (not in the code).
The MainTimer works perfectly (I've done tests) it's the timeClicker that doesn't work at all!
Can somebody tell me why and possibly help me understand the issue?
Thank you very much
EDIT: as requested by max
Private Declare Sub mouse_event Lib "user32" (ByVal dwflags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cbuttons As Long, ByVal dwExtraInfo As Long)
Private Const mouseclickup = 4
Private Const mouseclickdown = 2
By the way is not a problem of mouse_event, is the timer that doesn't work.
Yes, this cannot work on a 32-bit machine, it manages to scrape by on a 64-bit machine but that's sheer luck. Your pinvoke declaration dates from the VB6 era, it is quite wrong for VB.NET. Watch out for this, there are a lot of junk declarations out there. The pinvoke.net site is a good bet to get it right. Fix:
Private Declare Sub mouse_event Lib "user32" (ByVal dwflags As Integer, ByVal dx As Integer, _
ByVal dy As Integer, ByVal cbuttons As Integer, ByVal dwExtraInfo As IntPtr)
Another thing you want to do on your dev machine so you can debug this for a 32-bit machine is Project + Properties, Compile tab, scroll down, Advanced Compile Options, Target CPU = x86. Also enables Edit+Continue, you'll love it.
Note that your GetAsyncKeyState() declaration is almost certainly wrong as well. It returns Short, not Integer.
Try to declare mouse_event this way:
Private Declare Sub mouse_event Lib "user32" (ByVal dwflags As Integer, ByVal dx As Integer, ByVal dy As Integer, ByVal cbuttons As Integer, ByVal dwExtraInfo As IntPtr)
And call it this way:
mouse_event(0, 0, 0, 0, IntPtr.Zero)
Related
I am using the same AlphaBlend function as declared like this:
Public Declare Function AlphaBlend Lib "MSIMG32.dll" (ByVal hDCDest As Long, ByVal nXOriginDest As Long, ByVal nYOriginDest As Long, ByVal nWidthDest As Long, ByVal nHeightDest As Long, ByVal hDCSrc As Long, ByVal nXOriginSrc As Long, ByVal nYOriginSrc As Long, ByVal nWidthSrc As Long, ByVal nHeightSrc As Long, ByVal lBlendFunction As Long) As Long
There are some machines where my code works perfectly fine and does exactely what it should.
On one machine, the very same code works fine in application A, but the same code in application B makes AlphaBlend fail.
Imagine the following:
You have 2 identical twins both eating an apple. Both apples are perfectly the same.
One twin swallows it successfully, the other twin dies trying to do so.
GetLastError returns 0.
How could I investigate what goes wrong?
One some machines, all is fine.
On the one machine in question however, I have compiled the very same code running in two applications: Application A and application B.
In application A, AlphaBlend fails, and in application B, AlphaBlend succeeds.
And it's ALWAYS that it fails in application A.
I have even doubted VB6's sanity and checked if "Len" actually returns the correct length.
I use VB6 since 20 years, but I have never experienced something that crazy.
Does anybody have any idea why the same code might fail in that one application?
Option Explicit
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function AlphaBlend Lib "MSIMG32.dll" (ByVal hDCDest As Long, ByVal nXOriginDest As Long, ByVal nYOriginDest As Long, ByVal nWidthDest As Long, ByVal nHeightDest As Long, ByVal hDCSrc As Long, ByVal nXOriginSrc As Long, ByVal nYOriginSrc As Long, ByVal nWidthSrc As Long, ByVal nHeightSrc As Long, ByVal lBlendFunction As Long) As Long
Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Sub MoveMemory Lib "Kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetClientRect Lib "USER32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "User32.dll" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const AC_SRC_OVER = &H0
Private Sub Timer1_Timer()
Dim lHwnd&
lHwnd = FindWindow(vbNullString, "twsseetechcamwin")
If lHwnd = 0 Then
Me.Caption = "is null!"
Exit Sub
End If
Me.Caption = "ok"
Dim LBF As Long
Dim bf As BLENDFUNCTION
With bf
.BlendOp = AC_SRC_OVER
.SourceConstantAlpha = 255
End With
Dim lLen&
lLen = Len(bf) 'just check for sanity... I wanted to make sure that it's 4, and it indeed is
Call MoveMemory(LBF, bf, Len(bf)) 'Copy struct into a Long var
Dim rOtherWin As RECT
GetClientRect lHwnd, rOtherWin
Dim lOtherDC&
lOtherDC = GetDC(lHwnd)
Dim r As RECT
GetClientRect Me.hWnd, r
Dim lret&
lret = AlphaBlend(Me.hdc, 0, 0, (r.Right - r.Left), (r.Bottom - r.Top), lOtherDC, 0, 0, (rOtherWin.Right - rOtherWin.Left), (rOtherWin.Bottom - rOtherWin.Top), LBF)
Dim lWinErr&
lWinErr = GetLastError()
Me.Caption = Time & " ret: " & lret & ", err: " & lWinErr&
ReleaseDC lHwnd, lOtherDC
End Sub
The problem occurs when the OS is set to high DPI settings (like display everything in 150%) AND if the application has a manifest that states dpiaware=true.
There are 2 possible solutions:
Remove dpiaware from the manifest
Add a manifest to the other process as well and declare dpiaware=true in that manifest, too. This way there is no discrepancy between the 2 processes. This of course only works if it's your product / process, and you have the possibility to compile it with a manifest.
Since this is machine-specific (assuming that is accurate) there is a possibility that the two programs A and B are not loading the same copy of MSIMG32.dll.
I would check: are there multiple copies of that DLL on the PC? Especially if there is a copy in the program folder for A or B?
Also you can run Process Monitor and observe the running program to see exactly what DLLs are being loaded. That could at least confirm they are both running the same DLL and eliminate that as a potential cause.
Other than that, personally I would throw in some debug logging and really verify that the inputs to the failing function are the same.
We have been using MS Access database (Office 2007, 32bit) in Windows 7 for a long time but recently we switched into Office 2016, 64 bit.
Now every form is displaying the following message and it's really irritating:
Moreover, the Access window is not getting minimized. I'm not an expert in VBA and don't know what to do. I'm pasting the codes. Please don't suggest any article or documentation provided by Microsoft. I have tried to understand those a lot and failed.
The code being used is:
Option Compare Database
Private Declare Function SetWindowPos Lib "user32.dll" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
And:
Private Sub Form_Load()
Application.RunCommand (acCmdAppRestore)
SetWindowPos Application.hWndAccessApp, 0, 0, 0, 0, 0, 0
Application.DoCmd.MoveSize 0, 0
End Sub
Previously (in 32-bit office) the Access window used to be hidden on form load but now in 64-bit it's wide open. Please help me to hide the MS Access window in 64-bit version.
Upgrading companies software without extensive test is amateurish!
But if that error message is the only problem you are lucky. You need to convert the api arguments declaration to x64, what usually means change allLongdeclarations of handles and pointers to LongPtrand add PtrSafe after Declare.
With the conditional compiler (#If VBA7 Then) Office 2010 and later use the first part, as they support VBA7 (LongPtr), Office 2007 and earlier use the else part with the old declaration.
#If VBA7 Then
Private Declare PtrSafe Function SetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
#Else
Private Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
#End If
This can be found at Declaring API Functions In 64 Bit Office.
Seems like you do not use x86 ActiveX controls or ODBC connections, because they cause trouble too.
You should read the Compatibility Inspector user's guide to get prepared for more trouble;)
I agree with ComputerVersteher for the first part, so I'll address the second part of your question. You can make the form invisible by doing this:
Private Sub Form_Load()
'this turns the forms timer event on every 1 milisecond
Me.TimerInterval = 1
End Sub
Private Sub Form_Timer()
Me.Visible = False
'this turns the timer event off so you don't waste CPU power
Me.TimerInterval = 0
End Sub
i was programming an hack for a game in Visual basic, i want simulate a keypress with the code:
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
SendKeys.Send("a")
End Sub
In my window game didn't work, but in other windows such as chrome or a test textbox work, why?
if this is not a flash game , you can get the process of the game by:
Dim TheGame as Process = Process.GetProcessesByName("YourGame")(0)
get the handle of the game window:
Dim Handle As IntPtr = TheGame.MainWindowHandle
and then use sendmessage function to send the keys to the window:
SendMessage(Handle, 258, PUT KEY HERE, 0)
for example - instead of the "PUT KEY HERE" type:
&H41 (is "A")
you can find the keys list here:
http://www.pinvoke.net/default.aspx/Enums/VirtualKeys.html
the user32.dll sendmessage function:
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As IntPtr
Edit:
if the code is not working change the 258 (wm_char) in the sendmessage to 256(wm_keydown)
note:sendkeys sends keys to the current active window, and you should try to use pinvoke functions first and if you don't have any choice then use sendkeys.
Recommendation:
explore the functions: postmessage,sendmessage,setforegroundwindow and also explore spy++ tool :).
I'm looking for the fastest way to take a print-screen, and i found out that using Bitblt was my better choice, however, it only works for device context handle's, which means for me to retrieve a bitmap from that, i'd have to use multiple API's including CreateCompatibleBitmap, which in the end it probably takes the same time as using a managed way, like graphics.CopyFromScreen (which is a bit slow for me and also consumes alot of CPU, between 7-10% on a 2.3ghz quad-core processor...)
However, i still searched for a cleaner way of retrieving a bitmap from it, so i came up with this code:
<DllImport("user32.dll")> _
Public Shared Function GetDC(ByVal hWnd As IntPtr) As IntPtr
End Function
<DllImport("user32.dll")> _
Public Shared Function ReleaseDC(ByVal hWnd As IntPtr, ByVal hDC As IntPtr) As Integer
End Function
<DllImport("gdi32.dll")> _
Public Shared Function BitBlt(ByVal hdcDest As IntPtr, ByVal xDest As Integer, ByVal yDest As Integer, ByVal wDest As Integer, ByVal hDest As Integer, ByVal hdcSource As IntPtr, _
ByVal xSrc As Integer, ByVal ySrc As Integer, ByVal rop As TernaryRasterOperations) As Boolean
End Function
Dim hwNd As IntPtr = Nothing
hwNd = GetDC(GetDesktopWindow)
picHandle = GetDC(Me.PictureBox1.Handle)
BitBlt(picHandle, 0, 0, PictureBox1.Width, PictureBox1.Height, hwNd, 0, 0, TernaryRasterOperations.SRCCOPY)
ReleaseDC(hwNd, picHandle)
I can reach ~30 fps with this... But it has two problems as i said above:
Even if displaying it on a picturebox as i'm doing it above accomplished what i want, it doesn't resize to the picturebox control, even if i change those "0" values to the picturebox x and y coordinates.
I further searched and found there's a StretchBit API for that, and it does stretch, but it also reduces quality, (Even with the necessary call to SetStretchBltMode with parameter "HALFTONE" so it doesn't "corrupt" the pixels), it also reduces performance at least in 10+ fps...
But as i need to get it as bitmap object, with the other necessary API's for that, i ended up with almost half the performance (15~ fps) which is equivalent of graphics.CopyFromScreen.
So, i'm asking, is there another way to get a bitmap from the screen using Bitblt or similar without losing performance?
If there isn't a .Net way, i kindly ask for any language-way of doing that.
If you want raw performance, you will have to get away from managed code. This is easy enough using C++ with Visual Studio. You can make calls directly to the Windows API, bypassing the .NET runtime, managed code for your application, and the overhead of p/invokes in .NET.
If you are familiar with C#, you can take your C# code, convert it to C++ (which should be straightforward, with a lot of work to replace the CLI).
Private Declare Function BitBlt Lib "GDI32" ( _
ByVal hdcDest As Integer, _
ByVal nXDest As Integer, _
ByVal nYDest As Integer, _
ByVal nWidth As Integer, _
ByVal nHeight As Integer, _
ByVal hdcSrc As Integer, _
ByVal nXSrc As Integer, _
ByVal nYSrc As Integer, _
ByVal dwRop As System.Int32) As Boolean
Declare Function QueryPerformanceCounter Lib "Kernel32" (ByRef X As Long) As Short
Declare Function QueryPerformanceFrequency Lib "Kernel32" (ByRef X As Long) As Short
Const SRCCOPY As Integer = &HCC0020
Use a form with only a picturebox and a label in it. Set the anchors of picbox accordingly. In picbox down event:
Private Sub PictureBox1_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
Dim Ctr1, Ctr2, Freq As Long
Dim dbl As Double
QueryPerformanceCounter(Ctr1)
Dim desktopDC As IntPtr = Nothing
Dim picboxDC As IntPtr = Nothing
desktopDC = GetDC(New IntPtr(0))
picboxDC = GetDC(PictureBox1.Handle)
BitBlt(picboxDC, 0, 0, PictureBox1.Width, PictureBox1.Height, desktopDC, 0, 0, SRCCOPY)
QueryPerformanceCounter(Ctr2)
QueryPerformanceFrequency(Freq)
dbl = (Ctr2 - Ctr1) / Freq
dbl *= 1000000
Label1.Text = dbl.ToString 'it is in microseconds
ReleaseDC(New IntPtr(0), desktopDC)
ReleaseDC(PictureBox1.Handle, picboxDC)
End Sub
Maximize your form and click in picturebox.
I'm using the InteropFormsToolkit version 2.1. I'm trying to make sure that when a .NET form loads from an event being thrown on the VB6 form, that the .NET form can stay on top. I've tried many things and can't get anything to work. I've tried everything from z-index, to adding a managed call into User32.dll to push it to the forefront, etc.
Any ideas are appreciated.
In vb6 you can use as:
Private Sub Form_Load()
OnTopMe Me, True
End Sub
and following code in module
Declare Function SetWindowPos Lib "User32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cX As Long, ByVal cY As Long, ByVal wFlags As Long) As Long
Public Sub OnTopMe(FormID As Object, onTop As Boolean)
If onTop = True Then SetWindowPos FormID.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
If onTop = False Then SetWindowPos FormID.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub
I don't know about how to do it in .Net