I have used the following code to shutdown the system but it will perform logoff windows
Private Const EWX_LogOff = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Sub ShutDownComputer()
Call ExitWindowsEx(EWX_FORCE, &HFFFFFFFF)
End Sub
try this
Private Const EWX_POWEROFF = 8
Call ExitWindowsEx(EWX_POWEROFF, &HFFFFFFFF)
also this link may help you
Why simply calling ExitWindowsEx won’t Shutdown/Restart the Computer
Try combining SHUTDOWN with FORCE.
In addition to what Eugene said, its better to use the declaration from pinvoke:
Declare Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Int32, ByVal dwReserved As Int32) As Int32
which declares as arguments two four-bytes integers (as the ExitWindowsEx function in the dll).
Related
I am trying to implement a script which would disable "close" button of the ms access window.
However, I get compilation error when trying to declare functions:
Option Compare Database
Option Explicit
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal wRevert As Long) As Long
Private Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
Public Sub AccessCloseButtonEnabled(pfEnabled As Boolean)
' Comments: Control the Access close button.
' Disabling it forces the user to exit within the application
' Params : pfEnabled TRUE enables the close button, FALSE disabled it
' Owner : Copyright (c) FMS, Inc.
' Source : Total Visual SourceBook
' Usage : Permission granted to subscribers of the FMS Newsletter
On Error Resume Next
Const clngMF_ByCommand As Long = &H0&
Const clngMF_Grayed As Long = &H1&
Const clngSC_Close As Long = &HF060&
Dim lngWindow As Long
Dim lngMenu As Long
Dim lngFlags As Long
lngWindow = Application.hWndAccessApp
lngMenu = GetSystemMenu(lngWindow, 0)
If pfEnabled Then
lngFlags = clngMF_ByCommand And Not clngMF_Grayed
Else
lngFlags = clngMF_ByCommand Or clngMF_Grayed
End If
Call EnableMenuItem(lngMenu, clngSC_Close, lngFlags)
End Sub
Translation: Error in the compilation of the functions. Syntax Error in a Visual Basic Module. Check the program, and then recompile it.
What do you think might have caused the problem?
The declarations aren't 64-bit compatible, and you're using longs instead of booleans for wRevert and the return of EnableMenuItem. You can try the following (needs VBA7 (Office 2010+) for LongPtr support):
Private Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hwnd As LongPtr, ByVal wRevert As Boolean) As LongPtr
Private Declare PtrSafe Function EnableMenuItem Lib "user32" (ByVal hMenu As LongPtr, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Boolean
I usually write scripts in the VBE of Excel because they all tend to involve Excel. This time I wrote a script which has nothing to do with Excel, so I want to make it an executable file.
Note:
- Below code is a part of the actual script
- I tested this part also separately in the VBE and it works
- I tried it now in Visual Studio 2015
Problem:
- The code returns the handle of lWindow, but always returns 0 voor lChild
Module Module1
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String,
ByVal lpWindowName As String) As Long
Declare Function GetWindow Lib "user32.dll" (
ByVal hwnd As Long,
ByVal wCmd As Long) As Long
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Const BM_CLICK = &HF5&
Sub Main()
Dim lWindow As Long
Dim lChild As Long
lWindow = FindWindow(vbNullString, "Untitled - Notepad")
Debug.Print(lWindow)
lChild = GetWindow(lWindow, GW_CHILD)
Debug.Print(lChild)
End Sub
End Module
Thanks.
I have an application where I do not want the user to be able to close the form. Okay, easy enough. Just set ControlBox = false for the form.
However, I would like to keep the application icon in the upper left corner of the form. Minor I know, but details mean something to me.
Setting the Controlbox = false also makes the application's icon go away in the upper left corner of the form. Is there a way around this??
Here is the code I used.
My VB.Net version of it.
Private Const CP_NOCLOSE_BUTTON As Integer = &H200
Protected Overrides ReadOnly Property CreateParams() As Windows.Forms.CreateParams
Get
Dim mdiCp As Windows.Forms.CreateParams = MyBase.CreateParams
mdiCp.ClassStyle = mdiCp.ClassStyle Or CP_NOCLOSE_BUTTON
Return mdiCp
End Get
End Property
I needed an option that would disable the close conditionally (like the standard MessageBox does for a YesNo question) so the accepted answer wouldn't work for me or possibly I failed to see how I could get it to work. I ended up with this
Private Const MF_BYPOSITION As Int32 = &H400
Private Const MF_REMOVE As Int32 = &H1000
Private Declare Auto Function GetSystemMenu Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal bRevert As Int32) As IntPtr
Private Declare Auto Function GetMenuItemCount Lib "user32.dll" (ByVal hMenu As IntPtr) As Int32
Private Declare Function DrawMenuBar Lib "user32.dll" (ByVal hwnd As IntPtr) As Boolean
Private Declare Auto Function RemoveMenu Lib "user32.dll" (ByVal hMenu As IntPtr, ByVal nPosition As Int32, ByVal wFlags As Int32) As Int32
Public Sub DisableCloseButton(ByVal hwnd As IntPtr)
Dim hMenu As IntPtr, n As Int32
hMenu = GetSystemMenu(hwnd, 0)
If Not hMenu.Equals(IntPtr.Zero) Then
n = GetMenuItemCount(hMenu)
If n > 0 Then
RemoveMenu(hMenu, n - 1, MF_BYPOSITION Or MF_REMOVE)
RemoveMenu(hMenu, n - 2, MF_BYPOSITION Or MF_REMOVE)
DrawMenuBar(hwnd)
End If
End If
End Sub
Call it via
DisableCloseButton(MyForm.Handle)
As I was using it for a custom message box, I didn't test how to re-enable.
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.
I am using this sample as a basis for a program I'm making. After approximately 618 keystrokes, the program throws this error:
CallbackOnCollectedDelegate was detected
Message: A callback was made on a garbage collected delegate of type 'KeyLogger!KeyLogger.CallBackFunction+DelegateCallBack::Invoke'. This may cause application crashes, corruption and data loss. When passing delegates to unmanaged code, they must be kept alive by the managed application until it is guaranteed that they will never be called.
The error is thrown most times the application is run, but not every time and not at the same keystroke count. From the error message, I think it sounds like the garbage collector is collecting the delegate, how can I prevent this?
The program I made is essentially a modified version of that vb.net project, but it does not actually store the keystrokes.
Thank you for your help!
Code within CallBack.vb:
Option Strict Off
Option Explicit On
Module CallBackFunction
'******************************************************************************************
' Sample for retrieving keystrokes by use of the "kbLog32.dll"
' (c) 2004 by Nadeem Afanah.
'******************************************************************************************
'CallBack function
Delegate Sub DelegateCallBack(ByVal msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer)
Sub CallBack(ByVal msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer)
'here we track only WM_CHAR and WM_KEYDOWN
If msg = WM_KEYDOWN Then
...
End If
End Sub
End Module
Code in Declarations.vb:
Option Strict Off
Option Explicit On
Module Declarations
'******************************************************************************************
' Sample for retrieving keystrokes by use of the "kbLog32.dll"
' (c) 2004 by Nadeem Afanah.
'******************************************************************************************
'******************************************************************************************
'DLL declarations
Public Declare Function StartLog Lib "kbLog32" (ByVal hWnd As Integer, ByVal lpFuncAddress As DelegateCallBack) As Integer
Public Declare Sub EndLog Lib "kbLog32" ()
'----------------------------------------------------------------------------------------
Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer
Declare Function FindWindow Lib "user32" Alias "FindWindowA"(ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA"(ByVal hWnd1 As Integer, ByVal hWnd2 As Integer, ByVal lpsz1 As String, ByVal lpsz2 As String) As Integer
'****************************************************************************************
' Keyboard messages
Public Const WM_KEYUP As Short = &H101s
Public Const WM_KEYDOWN As Short = &H100s
Public Const WM_CHAR As Short = &H102s
Public Const WM_SYSKEYDOWN As Short = &H104s
Public Const WM_SYSKEYUP As Short = &H105s
'SetWindowPos messages
Public Const SWP_NOSIZE As Short = &H1s
Public Const SWP_NOMOVE As Short = &H2s
Public Const HWND_TOPMOST As Short = -1
Public Const SWP_SHOWWINDOW As Short = &H40s
'******************************************************************************************
End Module
Look at the code in Form1.vb where it does this:
StartLog(nhWnd_text, AddressOf CallBack)
This is where it's saying, take the location of the Callback function an use it to hanle messages I receive regarding keyboard events.
Try something like this:
Friend Class Form1
Inherits System.Windows.Forms.Form
''Add this ----------------------------
<MarshalAs(UnmanagedType.FunctionPtr)> _
Private DelSub as New DelegateCallBack(AdressOf CallBack)
''-------------------------------------
''In the sub Sub Command1_Click
''Change this -------------------------
StartLog(nhWnd_text, AddressOf CallBack)
''To this -----------------------------
StartLog(nhWnd_text, DelSub)
''-------------------------------------
End Class
What we're doing here is creating a local "delegate sub" (think of it as a variable which points at a sub). We're pointing this at the Callback sub. We're then using this delegate sub instead of passing in a reference directly to the Callback sub.
The difference is that the .Net framework now knows that there is something pointing at that sub so won't garbage collect it (clear it from memory)
The MarshallAs bit is a little superfluous as that's the default marshalling but it simply means we're explicitly telling .Net that we're using the delegate to access unmanaged code (something outside the .Net framework)
Just for the record, I still had to download the code as it was actually the bit in Form1.vb that was relevant - But thanks for trying :)