I need an application with a feature that user should be able to set time of computer automatic shutdown (closing all opened applications) in visual basic 6.
I just need to know is this doable? if yes, what specific topics should I search? honestly, never did system programs in vb just m a db programmer that too of a primitive nature. (so gurus, thanks for understanding ;)
Option Explicit
Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Const EWX_FORCE = 4
Public Const EWX_LOGOFF = 0
Public Const EWX_REBOOT = 2
Public Const EWX_SHUTDOWN = 1
Public Sub Main()
Dim Res As Long
MsgBox ("Your System Will Now Shutdown")
Res = ExitWindowsEx(EWX_SHUTDOWN, 0)
End Sub
source
this does the job as required by you.
Related
WinRestore,% hwnd([1])
i have found in many programming language the use of hwnd. after searching on google it comes out to be handle. I didnt got more information on this. how programmer knows the value to put in, eg.
Const LB_GETTEXTLEN = &H18A
Const LB_GETTEXT = &H189
Const LB_GETCOUNT = &H18B
&h18a how he known, how will he use this?
this is the example program
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
Const LB_GETTEXTLEN = &H18A
Const LB_GETTEXT = &H189
Const LB_GETCOUNT = &H18B
Private Function GetListItems(ByVal hList As Long) As Variant
Dim i As Long, nCount As Long, lItemLength As Long
Dim sItem() As String
nCount = SendMessage(hList, LB_GETCOUNT, 0, ByVal 0&)
For i = 0 To nCount - 1
lItemLength = SendMessage(hList, LB_GETTEXTLEN, i, ByVal 0&)
ReDim Preserve sItem(i)
sItem(i) = String(lItemLength, 0)
Call SendMessage(hList, LB_GETTEXT, i, ByVal sItem(i))
Next i
GetListItems = sItem
End Function
there are many such examples in all different languages but concept will be the same. so i want to learn it. what does it mean and how to use it.
another example from ahk
Gui,2:+hwndhwnd
hwnd(2,hwnd)
Those are all window messages that you can find information about on the MSDN Documentation by googling them. See below links:
LB_GETTEXTLEN
LB_GETTEXT
LB_GETCOUNT
You can find them and other related messages by checking the documentation for the native List Box control.
As for the numbers they're hexadecimal numbers which are (usually) mentioned in the documentation. But since these aren't you'll have to google them and check other websites/forums, or find their values on your own by experimenting with them in C or C++ .
In VB hexadecimal numbers are represented by prepending the number with &H, whereas in C, C++, C# or alike they're prepended with 0x.
In a forms editor each window/control has a hwnd property. For windows not created by your forms package you use the API calls FindWindow (easiest but not reliable) or EnumWindows. Also GetForegroundWindow and GetDesktopWindow.
To find out the value of constants you download the C header files as part of the Windows SDK https://developer.microsoft.com/en-us/windows/downloads/windows-10-sdk. It also has the documentation for all these API calls. This is online documentation listing all the windows' functions https://msdn.microsoft.com/en-us/library/windows/desktop/ms633505(v=vs.85).aspx.
All.
I'm attempting to develop a 'sidebar' application with vb6, which I want to behave like windows Vista's gadget sidebar or Google Desktop sidebar, in the respect that other windows could not maximize over it.
I'm aware that chances of this happening are probably very little, but I'm asking just in case.
Currently, I've got a form that has multiple controls, and runs a function on load which makes itself the exact height of the screen, minus the taskbar, and it's 'left' location is set by a timer to be 'screen.width - me.width', so it will start at full height on the far right of the screen, and cannot be moved. Code for the height is as follows, if it is necessary.
Declare Function GetUserNameA Lib "advapi32.dll" (ByVal lpBuffer As String, nSize As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare Function SetLayeredWindowAttributes Lib "user32" ( _
ByVal hwnd As Long, _
ByVal crKey As Long, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long) As Long
Public Const GWL_STYLE = (-16)
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_LAYERED = &H80000
Public Const LWA_COLORKEY = &H1
Public Const LWA_ALPHA = &H2
Private Const ABM_GETTASKBARPOS = &H5
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type APPBARDATA
cbSize As Long
hwnd As Long
uCallbackMessage As Long
uEdge As Long
rc As RECT
lParam As Long
End Type
Private Declare Function SHAppBarMessage Lib "shell32.dll" (ByVal dwMessage As Long, pData As APPBARDATA) As Long
Function Fixheight()
Dim ABD As APPBARDATA
SHAppBarMessage ABM_GETTASKBARPOS, ABD
Form1.Height = Screen.Height - ((ABD.rc.Bottom - ABD.rc.Top) * 12)
If Form1.Height <= 600 Then
Form1.Height = Screen.Height
End If
End Function
To be clear, I do not want an 'always on top' function. I already have that, and it's driving me insane, as the form has to me closed or minimized in order to maximize, minimize of close another program (i.e. chrome, word, etc) behind it. This form must instead not allow other programs to maximize over it, so that if for example, the user maximized Chrome, chrome would maximize minus form1.width.
I doubt that this is possible because as far as I'm concerned, that would mean taking control of chrome, and essentially making it's maximize function as
me.height = screen.height - ((ABD.rc.Bottom - ABD.rc.Top) * 12)
me.width = screen.width - form1.width
which isn't possible.
Anyway, hopefully someone out there can help. As I said, I seriously doubt the possibility of having this work, but if so, all the better.
Thanks in advance!
Thanks to Ken White, I googled SHAppBarMessage and found the following website, offering a downloadable source with the very feature I needed. I just have to implement it now!!
Very glad I asked! Thank you!
Edit: Found this spanish website, which while needed some help from Google Translate, is more suited to my needs. Just need to figure out how to make it work on the Right Hand Side! Thanks again!
I have an application that needs to be a single-instance app across all user sessions on a Windows PC. My research thus far has centered around using a mutex to accomplish this, but I am having an issue that I am not sure is really an issue, this is really a best-practice question I believe.
Here's the code first of all:
Private Const AppVer = "Global\UNIQUENAME" ' This is not what i am using but the name is unique
Public Sub Main()
Dim mutexValue As Long
mutexValue = CreateMutex(ByVal 0&, 1, AppVer)
If (Err.LastDllError = ERROR_ALREADY_EXISTS) Then
SaveTitle$ = App.Title
App.Title = "... duplicate instance."
MsgBox "A duplicate instance of this program exists."
CloseHandle mutexValue
Exit Sub
End If
' Else keep on truckin'
Now, based on this article I believe I understand that by passing the NULL pointer to the CreateMutex function as I am above I'm basically assigning whatever security descriptor is associated with the currently logged in user.
If that means what I think it does (I may need more guidance here) that tells me that other users who log in will not be able to "see" the mutex created under the original user's session, nor will they be able to create a mutex with the same name.
Now, emperical evidence seems to back this up. I used a message box to pop the "LastDLLError" I was receiving, and when another user attempted to launch the application (while it was already running under another user account) I would receive an ERROR_ACCESS_DENIED code. I am OK with testing against this along with the ERROR_ALREADY_EXISTS code and just exiting on either/or. However, this feels sort of hackish and I'm wondering if someone can suggest an alternative. The "right" thing to do seems to be to pass the proper pointer to the CreateMutex function such that any user has the proper permissions to view any existing mutexes (mutices?), but I'm not so sure this is possible without the currently logged in user being an admin (which is unacceptible). Any assistance/guidance is greatly appreciated. Thanks in advance!
You don't need admin priveleges to set security on you own mutexes. Here is a simple demo app that basicly gives Everyone/Full control to the mutex.
Option Explicit
Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Private Const SYNCHRONIZE As Long = &H100000
Private Const MUTANT_QUERY_STATE As Long = &H1
Private Const MUTANT_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or MUTANT_QUERY_STATE)
Private Const SECURITY_DESCRIPTOR_REVISION As Long = 1
Private Const DACL_SECURITY_INFORMATION As Long = 4
Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (lpMutexAttributes As Any, ByVal bInitialOwner As Long, ByVal lpName As String) As Long
Private Declare Function OpenMutex Lib "kernel32" Alias "OpenMutexA" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal lpName As String) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function InitializeSecurityDescriptor Lib "advapi32.dll" (pSecurityDescriptor As Any, ByVal dwRevision As Long) As Long
Private Declare Function SetSecurityDescriptorDacl Lib "advapi32.dll" (pSecurityDescriptor As Any, ByVal bDaclPresent As Long, pDacl As Any, ByVal bDaclDefaulted As Long) As Long
Private Declare Function SetKernelObjectSecurity Lib "advapi32.dll" (ByVal Handle As Long, ByVal SecurityInformation As Long, pSecurityDescriptor As SECURITY_DESCRIPTOR) As Long
Private Type SECURITY_DESCRIPTOR
Revision As Byte
Sbz1 As Byte
Control As Long
Owner As Long
Group As Long
pSacl As Long
pDacl As Long
End Type
Private Const MUTEX_NAME As String = "Global\20b70e57-1c2e-4de9-99e5-20f3961e6812"
Private m_hCurrentMutex As Long
Private Sub Form_Load()
Dim hMutex As Long
Dim uSec As SECURITY_DESCRIPTOR
hMutex = OpenMutex(MUTANT_ALL_ACCESS, 0, MUTEX_NAME)
If hMutex <> 0 Then
Call CloseHandle(hMutex)
MsgBox "Already running", vbExclamation
Unload Me
Exit Sub
End If
m_hCurrentMutex = CreateMutex(ByVal 0&, 1, MUTEX_NAME)
Call InitializeSecurityDescriptor(uSec, SECURITY_DESCRIPTOR_REVISION)
Call SetSecurityDescriptorDacl(uSec, 1, ByVal 0, 0)
Call SetKernelObjectSecurity(m_hCurrentMutex, DACL_SECURITY_INFORMATION, uSec)
End Sub
Private Sub Form_Unload(Cancel As Integer)
If m_hCurrentMutex <> 0 Then
Call CloseHandle(m_hCurrentMutex)
m_hCurrentMutex = 0
End If
End Sub
I was looking for a similar solution in VB6 late last year. At the time I was unable to find any examples of VB6 apps communicating across the user boundary, so I had to write my own.
See: Interprocess Communication via Semaphores
You can use the class to create and check for a global semaphore which will tell you if your app is already running under any user. I didn't look at the Mutex APIs but their usage is very similar. The GetSecurityDescriptor function is what you'll want to transpose if you've already got some Mutex code written.
I think your instincts are exactly right. I don't know any reason why it wouldn't be safe to infer from ERROR_ACCESS_DENIED that some other process has the mutex, so effectively it's the same as ERROR_ALREADY_EXISTS (in this context.) But at the same time, it doesn't feel quite right.
As you suggest, setting a proper security descriptor is indeed the right way to do it. MSDN says that granting MUTEX_ALL_ACCESS privileges increases the risk that the user will have to be an admin, and I think you do need MUTEX_ALL_ACCESS. But in my experience it works fine for non-admins.
Your question intrigued me enough do a quick test. That means I have some source code, and so here it is:
int wmain(int argc, wchar_t* argv[])
{
ACL *existing_dacl = NULL;
ACL *new_dacl = NULL;
PSECURITY_DESCRIPTOR security_descriptor = NULL;
bool owner = false;
HANDLE mutex = CreateMutex(NULL,FALSE,L"Global\\blah");
if(mutex == NULL)
wprintf(L"CreateMutex failed: 0x%08x\r\n",GetLastError());
if(GetLastError() == ERROR_ALREADY_EXISTS)
wprintf(L"Got handle to existing mutex\r\n");
else
{
wprintf(L"Created new mutex\r\n");
owner = true;
}
if(owner)
{
// Get the DACL on the mutex
HRESULT hr = GetSecurityInfo(mutex,SE_KERNEL_OBJECT,
DACL_SECURITY_INFORMATION,NULL,NULL,
&existing_dacl,NULL,
&security_descriptor);
if(hr != S_OK)
wprintf(L"GetSecurityInfo failed: 0x%08x\r\n",hr);
// Add an ACE to the ACL
EXPLICIT_ACCESSW ace;
memset(&ace,0,sizeof(ace));
ace.grfAccessPermissions = MUTEX_ALL_ACCESS;
ace.grfAccessMode = GRANT_ACCESS;
ace.grfInheritance = NO_INHERITANCE;
ace.Trustee.pMultipleTrustee = NULL;
ace.Trustee.MultipleTrusteeOperation = NO_MULTIPLE_TRUSTEE;
ace.Trustee.TrusteeForm = TRUSTEE_IS_NAME;
ace.Trustee.TrusteeType = TRUSTEE_IS_WELL_KNOWN_GROUP;
ace.Trustee.ptstrName = L"EVERYONE";
hr = SetEntriesInAcl(1,&ace,existing_dacl,&new_dacl);
if(hr != S_OK)
wprintf(L"SetEntriesInAcl failed: 0x%08x\r\n",hr);
// Set the modified DACL on the mutex
hr = SetSecurityInfo(mutex,SE_KERNEL_OBJECT,
DACL_SECURITY_INFORMATION,NULL,NULL,new_dacl,NULL);
if(hr != S_OK)
wprintf(L"SetSecurityInfo failed: 0x%08x\r\n",hr);
else
wprintf(L"Changed ACL\r\n");
LocalFree(existing_dacl);
LocalFree(new_dacl);
LocalFree(security_descriptor);
}
wprintf(L"Press any key...");
_getch();
CloseHandle(mutex);
return 0;
}
I'm attempting to make my own instant messenger and want the user to go into idle/away mode if the computer hasn't been used in so long. Does anyone have a great idea on how to do this?
Here's how I implemented this functionality a few years ago. Function fnIdleTime will tell you how many seconds it has been since the user touched the mouse or keyboard.
Public Declare Function timeGetTime Lib "WINMM.DLL" () As Long
Private Type LASTINPUTINFO
cbSize As Long
dwTime As Long
End Type
Public Declare Function GetLastInputInfo Lib "user32.dll" (plii As LASTINPUTINFO) As Long
Public Function fnIdleTime() As Long
Dim lii As LASTINPUTINFO
lii.cbSize = Len(lii)
If (GetLastInputInfo(lii) > 0) Then
fnIdleTime = (timeGetTime - lii.dwTime) \ 1000
End If
End Function
I am testing an application that checks if a file exists across a network. In my testing, I am purposefully pulling the network plug so the file will not be found. The problem is this causes my app to go unresponsive for at least 15 seconds. I have used both the FileExists() and GetAttr() functions in VB6. Does anyone know how to fix this problem? (No, I can't stop using VB6)
Thanks,
Charlie
Unfortunately, VB doesn't make this easy, but luckily the Win32 API does, and it's quite simple to call Win32 functions from within VB.
For the LAN/WAN, you can use a combination of the following Win32 API calls to tell you whether the remote connection exists without having to deal with a network time-out:
Private Declare Function WNetGetConnection Lib "mpr.dll" Alias _
"WNetGetConnectionA" (ByVal lpszLocalName As String, _
ByVal lpszRemoteName As String, ByRef cbRemoteName As Long) As Long
Private Declare Function PathIsNetworkPath Lib "shlwapi.dll" Alias _
"PathIsNetworkPathA" (ByVal pszPath As String) As Long
Private Declare Function PathIsUNC Lib "shlwapi.dll" Alias "PathIsUNCA" _
(ByVal pszPath As String) As Long
For the Internet, you can use the Win32 API call:
Private Declare Function InternetGetConnectedState Lib "wininet.dll" _
(ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long
Const INTERNET_CONNECTION_MODEM = 1
Const INTERNET_CONNECTION_LAN = 2
Const INTERNET_CONNECTION_PROXY = 4
Const INTERNET_CONNECTION_MODEM_BUSY = 8
This VB site has more discussion on path oriented functions you can call in the Win32 API through VB.
use this too
Dim FlSize as long
flsize=filelen("yourfilepath")
if err.number=53 then msgbox("file not found")
if err.number=78 then msgbox("Path Does no Exist")
I'm not sure you can handle this much more gracefully - if the network is having problems it can take a while for timeouts to indicate that the problem is severe enough that things aren't working.
If VB6 supports threading (I honestly don't recall) you could spin the file open into a background thread, and have the UI allow the user to cancel it (or perform other operations if that makes sense), but that introduces a pretty significant amount of additional complexity.
VB6 has some networking functions that can test to see if the network is connected. You should be able to add in under 'References' the 'NetCon 1.0 Type Library'. This adds for you the NETCONLib. Once implemented, you should be able to test for network connectivity first, then test for the FileExists and GetAttr.
Let me know if this helps!
VB is inherently single threaded, but you can divert work to a COM component to do an asynchronous file check and flag an event when it is done. This way the UI thread stays at responsive at least. Trouble is - this is all theory, I don't know such a component.
But wait! Google just turned up this: Visual Basic 6 Asynchronous File I/O Using the .NET Framework. Does that help, maybe?
Also, they have something similar over at CodeProject: Asynchronous processing - Basics and a walkthrough with VB6/ VB.NET
this code only used for check connection (maybe can help you) for one of your problems :
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef dwFlags As Long, ByVal dwReserved As Long) As Long
Private Const CONNECT_LAN As Long = &H2
Private Const CONNECT_MODEM As Long = &H1
Private Const CONNECT_PROXY As Long = &H4
Private Const CONNECT_OFFLINE As Long = &H20
Private Const CONNECT_CONFIGURED As Long = &H40
Public Function checknet() As Boolean
Dim Msg As String
If IsWebConnected(Msg) Then
checknet = True
Else
If (Msg = "LAN") Or (Msg = "Offline") Or (Msg = "Configured") Or (Msg = "Proxy") Then
checknet = False
End If
End If
End Function
Private Function IsWebConnected(Optional ByRef ConnType As String) As Boolean
Dim dwFlags As Long
Dim WebTest As Boolean
ConnType = ""
WebTest = InternetGetConnectedState(dwFlags, 0&)
Select Case WebTest
Case dwFlags And CONNECT_LAN: ConnType = "LAN"
Case dwFlags And CONNECT_MODEM: ConnType = "Modem"
Case dwFlags And CONNECT_PROXY: ConnType = "Proxy"
Case dwFlags And CONNECT_OFFLINE: ConnType = "Offline"
Case dwFlags And CONNECT_CONFIGURED: ConnType = "Configured"
Case dwFlags And CONNECT_RAS: ConnType = "Remote"
End Select
IsWebConnected = WebTest
End Function
in your event :
If checknet = False Then
...
else
...
end if
I agree with Will. Something like this is simple to handle with Script.FileSystemObject:
Dim objFSO As New FileSystemObject
If objFSO.FileExists("C:\path\to\your_file.txt") Then
' Do some stuff with the file
Else
' File isn't here...be nice to the user.
EndIf
Accessing files over a network can cause these hangs.
It's been a while, but I remember multi-threading in VB6 being relatively painful to implement. A quick solution would be to have a small .exe (perhaps also coded in VB) that can handle this. You could use DDE for inter-app communication or the ever so easy but kludgey file-based pipe, by which I mean a file that both apps will mutually read/write to handle inter-app communication. Of course, using file-based pipes, depending on the details of this scenario, may simply exaggerate the File I/O lag.
If there's a reasonable degree with which you can predict where the user will be selecting files from, you may consider preemptively caching a directory listing and reading that rather than the file directly - assuming the directory contents aren't expected to change frequently. Note: getting a directory listing over a network will cause the same lag issues as individual file I/O over a network. Keep that in mind.