I hope this question doesn't exist yet, because I already searched and couldn't find it... I have a function that scans the windows processes, and it worked very well, but I started to receive an error "An item with the same key", but the error is not caused all the time, Below is my function that is causing the error
Private Function enumWindowsInternal(ByVal hWnd As IntPtr, ByVal lParam As Integer) As Boolean
Try
If hWnd <> hShellWindow Then
Dim windowPid As UInt32
If Not IsWindowVisible(hWnd) Then
Return True
End If
Dim length As Integer = GetWindowTextLength(hWnd)
If length = 0 Then
Return True
End If
GetWindowThreadProcessId(hWnd, windowPid)
If windowPid <> currentProcessID Then
Return True
End If
Dim stringBuilder As New StringBuilder(length)
GetWindowText(hWnd, stringBuilder, length + 1)
dictWindows.Add(hWnd, stringBuilder.ToString)
End If
Return True
Catch ex As Exception
writeExeption(ex)
End Try
Return False
End Function
I have already reviewed my code, but I still haven't found the solution....
Related
While following this i ran into a problem.
<DllImport("advapi32.dll", SetLastError:=True)> _
Private Shared Function OpenProcessToken(ByVal ProcessHandle As IntPtr, ByVal DesiredAccess As Integer, ByRef TokenHandle As IntPtr) As Boolean
End Function
<DllImport("advapi32.dll", SetLastError:=True)> _
Private Shared Function GetTokenInformation(TokenHandle As IntPtr, TokenInformationClass As TOKEN_INFORMATION_CLASS, TokenInformation As IntPtr, TokenInformationLength As UInteger, ByRef ReturnLength As UInteger) As Boolean
End Function
<DllImport("advapi32.dll", SetLastError:=True)> _
Private Shared Function IsValidSid(SID As Byte()) As Boolean
End Function
For Each p As Process In Process.GetProcesses
Dim processHandle As IntPtr = OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, p.Id)
If Not processHandle = Nothing Then
Dim tokenhandle As IntPtr = Nothing
Dim bool As Boolean = OpenProcessToken(processHandle, TOKEN_READ, tokenhandle)
If bool = False Then
Dim win32error As String = New Win32Exception(Marshal.GetLastWin32Error).Message
MessageBox.Show(win32error)
Else
Dim sidlength As UInteger = Nothing
Dim SIDbyte As Byte() = Nothing
Dim somebool As Boolean = GetTokenInformation(tokenhandle, TOKEN_INFORMATION_CLASS.TokenUser, Nothing, 0, sidlength)
If Not somebool Then
Dim win32error As String = New Win32Exception(Marshal.GetLastWin32Error).Message
MessageBox.Show(win32error)
''RETURNS "The data area passed to a system call is too small" error.
End If
ReDim SIDbyte(35) '' I hardcoded '35' because it's what i'm getting with sidlength.
somebool = GetTokenInformation(tokenhandle, TOKEN_INFORMATION_CLASS.TokenUser, SIDbyte, SIDbyte.Length, sidlength)
''RETURNS TRUE THE SECOND TIME.
If Not somebool Then
Dim win32error As String = New Win32Exception(Marshal.GetLastWin32Error).Message
MessageBox.Show(win32error)
End If
If IsValidSid(SIDbyte) Then
MessageBox.Show("Valid")
Else
MessageBox.Show("Not Valid")
End If
''RETURNS INVALID SID. (FAILS)
The first call to GetTokenInformation fails as it's supposed to i guess... returning "sidlength" with value of 36.
Second call succeeds and SID Byte() gets populated, but the call to "IsValidSID" Returns false... and i can't figure out why, if the SIDbytes are populated successfully, what's the problem?
Hello I have this code working to get current url on Chrome, but only get active tab url. I need to get url from all open tabs using UI Automation.
My working code:
Function GetChromeUrl(ByVal proc As Process) As String
If proc.MainWindowHandle = IntPtr.Zero Then
Return Nothing
End If
Dim element As System.Windows.Automation.AutomationElement = AutomationElement.FromHandle(proc.MainWindowHandle)
If element Is Nothing Then
Return Nothing
End If
Dim edit As System.Windows.Automation.AutomationElement = element.FindFirst(TreeScope.Children, New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.Edit))
Return (edit.GetCurrentPattern(ValuePattern.Pattern)).Current.Value.ToString
End Function
and call it using this code in Form Load event:
For Each proc As Process In Process.GetProcessesByName("chrome")
MsgBox(proc.MainWindowTitle + " " + GetChromeUrl(proc))
Next
you better try this way
Imports NDde.Client 'import the NDde library for firefox
Imports System.Runtime.InteropServices
'For Chrome
Private Const WM_GETTEXTLENGTH As Integer = &He
Private Const WM_GETTEXT As Integer = &Hd
<DllImport("user32.dll")> _
Private Shared Function SendMessage(hWnd As IntPtr, Msg As UInteger, wParam As Integer, lParam As Integer) As Integer
End Function
<DllImport("user32.dll")> _
Private Shared Function SendMessage(hWnd As IntPtr, Msg As UInteger, wParam As Integer, lParam As StringBuilder) As Integer
End Function
<DllImport("user32.dll", SetLastError := True)> _
Private Shared Function FindWindowEx(parentHandle As IntPtr, childAfter As IntPtr, className As String, windowTitle As String) As IntPtr
End Function
Public Shared Function getChromeUrl(winHandle As IntPtr) As String
Dim browserUrl As String = Nothing
Dim urlHandle As IntPtr = FindWindowEx(winHandle, IntPtr.Zero, "Chrome_AutocompleteEditView", Nothing)
Const nChars As Integer = 256
Dim Buff As New StringBuilder(nChars)
Dim length As Integer = SendMessage(urlHandle, WM_GETTEXTLENGTH, 0, 0)
If length > 0 Then
SendMessage(urlHandle, WM_GETTEXT, nChars, Buff)
browserUrl = Buff.ToString()
Return browserUrl
Else
Return browserUrl
End If
End Function
Public shared Function GetChromeHandle() As Intptr
Dim ChromeHandle As IntPtr = Nothing
Dim Allpro() As Process = Process.GetProcesses();
For Each pro As Process in Allpro
if pro.ProcessName = "chrome"
ChromeHandle = pro.MainWindowHandle
Exit For
End if
Next
Return ChromeHandle
End Function
'USAGE FOR CHROME
Dim CHandle As IntPtr = GetChromeHandle()
If Not CHandle,Equals(Intptr.Zero)
Dim url As String = getChromeUrl(CHandle)
End If
Source and read more
EDIT :
i found my own way and it worked for me
Dim appAs String = "chrome"
Dim proc As System.Diagnostics.Process = GetBrowser(app)
...
Private Function GetBrowser(ByVal appName) As System.Diagnostics.Process
Dim pList() As System.Diagnostics.Process =
System.Diagnostics.Process.GetProcessesByName(app)
For Each proc As System.Diagnostics.Process In pList
If proc.ProcessName = appThen
Return proc
End If
Next
Return Nothing
End Function
usage :
If proc IsNot Nothing Then
Dim browserName as string = "Google Chrome"
Dim className as String = "Edit"
Dim s As String =
GetCurrentUrl(proc.MainWindowHandle, browserName, className, ComboBox1)
If s <> "" Then
Msgbox.show(s)
ComboBox1.SelectedIndex = 0 'Window list
Else
End If
Else
Label1.Text = browserName & " is not available"
end If
hope it helps :))))
When i am Running this Block of code it runs, however when i try to change the running process memory address's string value to somethinhg else it give me an error:
"System.IndexoutofRangeException Index was outside the Bounds of the Array"
These are the Functions:
<DllImport("kernel32.dll", SetLastError:=True)> _
Public Shared Function WriteProcessMemory(ByVal hProcess As IntPtr, ByVal lpBaseAddress As IntPtr, ByVal lpBuffer As Byte(), ByVal nSize As System.UInt32, <Out()> ByRef lpNumberOfBytesWritten As Int32) As Boolean
End Function
Public Shared Function StrToByteArray(ByVal str As String) As Byte()
Dim encoding As New System.Text.ASCIIEncoding()
Return encoding.GetBytes(str)
End Function
Public Shared Function Poke(ByVal proc As Process, ByVal target As Integer, ByVal data As Byte()) As Boolean
Return WriteProcessMemory(proc.Handle, New IntPtr(target), data, data.Length, 0)
End Function
This is the button which executes the changed memory address value string.
Private Sub saveButton_Click(sender As Object, e As EventArgs) Handles saveButton.Click
Try
Dim p As Process() = Process.GetProcessesByName(AppName.Text)
Dim Written As Boolean = False
Written = Poke(p(0), &HB8FDCC, StrToByteArray(TxtVal.Text))
If Written = True Then
MsgBox("WriteProcessMemory Sucess!", MsgBoxStyle.OkOnly, "Poke Memory Status")
ElseIf Written = False Then
MsgBox("WriteProcessMemory Failed!", MsgBoxStyle.OkOnly, "Poke Memory Status")
End If
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub
End Class
Do not add the extension of program/application in the name of Process,
in your case, for Chrome
AppName.Text must be "Chrome" instead of "Chrome.exe",
Good Luck.
I have the following code as part of my control. SetReaderMode function creates the structure and calls the function explained here, http://msdn.microsoft.com/en-us/library/bb775599(VS.85).aspx
When I run this code, i get the error
Attempted to read or write protected memory. This is often an indication that other memory is corrupt.
I'm not sure what the issue may be. What am I doing wrong?
<DllImport("Comctl32.dll", EntryPoint:="#383", _
CallingConvention:=CallingConvention.StdCall)> _
Private Shared Sub DoReaderMode(prmi As READERMODEINFO)
End Sub
<StructLayout(LayoutKind.Sequential)>
Private Structure READERMODEINFO
Dim cbSize As UInt32
Dim hwnd As IntPtr
Dim fFlags As UInt32
Dim prc As IntPtr
Dim pfnScroll As ReaderScrollCallbackDelegate
Dim fFlags2 As TranslateDispatchCallbackDelegate
Dim lParam As IntPtr
End Structure
Private Sub SetReaderMode()
Dim Info As New READERMODEINFO
Info.hwnd = Me.Handle
Info.fFlags = 0
Info.prc = IntPtr.Zero
Info.pfnScroll = New ReaderScrollCallbackDelegate(AddressOf ReaderScrollCallback)
Info.fFlags2 = New TranslateDispatchCallbackDelegate(AddressOf TranslateDispatchCallback)
Info.lParam = IntPtr.Zero
Info.cbSize = Marshal.SizeOf(Info)
DoReaderMode(Info)
End Sub
Private Delegate Function ReaderScrollCallbackDelegate(ByVal prmi As READERMODEINFO, dx As Integer, dy As Integer) As Boolean
Private Delegate Function TranslateDispatchCallbackDelegate(lpmsg As IntPtr) As Boolean
<AllowReversePInvokeCalls()>
Private Function TranslateDispatchCallback(lpmsg As IntPtr) As Boolean
Return True
End Function
<AllowReversePInvokeCalls()>
Private Function ReaderScrollCallback(ByVal prmi As READERMODEINFO, dx As Int32, dy As Int32) As Boolean
Return True
End Function
Is not an easy nut to crack. Assuming the callback are correct in term of signature/calling convention, a problem can be that since the carbage collector collect Info at the end of the function SetReaderMode, the callback address becames invalid. So try to declare Info as a member variable. If the error remain callback signature has something wrong, but as I said, not so easy to see the error at a glance.
I've figured it out. After reviewing the documentation more closely, I've added a ByRef to the DoReaderMode definition and to the ReaderScrollCallback definition, since the arguments where defined as pointers to structures, not just structures. I also added some other code to pass the rectangle in the ReaderModeInfo structure.
Below is the working code. Interestingly, the documentation states that you click to exit ReaderMode, however when testing it looks like you have to hold the button down and release to exit.
<DllImport("Comctl32.dll", EntryPoint:="#383", _
CallingConvention:=CallingConvention.StdCall)> _
Private Shared Sub DoReaderMode(ByRef prmi As READERMODEINFO)
End Sub
<StructLayout(LayoutKind.Sequential)>
Private Structure READERMODEINFO
Dim cbSize As UInt32
Dim hwnd As IntPtr
Dim fFlags As UInt32
Dim prc As IntPtr
Dim pfnScroll As ReaderScrollCallbackDelegate
Dim fFlags2 As TranslateDispatchCallbackDelegate
Dim lParam As IntPtr
End Structure
Private Sub SetReaderMode()
Dim SetReaderModeInfo As READERMODEINFO
Dim rect As New Interop.RECT(Me.Width / 2 - 20, Me.Height / 2 - 20, Me.Width / 2 + 20, Me.Height / 2 + 20)
Dim pnt As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(rect))
Marshal.StructureToPtr(rect, pnt, True)
SetReaderModeInfo = New READERMODEINFO
SetReaderModeInfo.hwnd = Me.Handle
SetReaderModeInfo.fFlags = 1
SetReaderModeInfo.prc = pnt
SetReaderModeInfo.pfnScroll = New ReaderScrollCallbackDelegate(AddressOf ReaderScrollCallback)
SetReaderModeInfo.fFlags2 = New TranslateDispatchCallbackDelegate(AddressOf TranslateDispatchCallback)
SetReaderModeInfo.lParam = IntPtr.Zero
SetReaderModeInfo.cbSize = Marshal.SizeOf(SetReaderModeInfo)
DoReaderMode(SetReaderModeInfo)
Marshal.FreeHGlobal(pnt)
End Sub
Private Delegate Function ReaderScrollCallbackDelegate(ByRef prmi As READERMODEINFO, dx As Integer, dy As Integer) As Boolean
Private Delegate Function TranslateDispatchCallbackDelegate(ByRef lpmsg As Interop.MSG) As Boolean
Private Function TranslateDispatchCallback(ByRef lpmsg As Interop.MSG) As Boolean
Return False
End Function
Private Function ReaderScrollCallback(ByRef prmi As READERMODEINFO, dx As Int32, dy As Int32) As Boolean
Return True
End Function
I have a excel file place on server.
I am using a application which written by VB.NET to open file in read only mode.
User 1 open file in read only mode.
How can user 2 detect that file is open or not status?
Thanks,
An
You need to test the file Read Only as ReadWrite will fail if the file is ReadOnly status.
Below are some methods. Not sure where I got them all from except the last one by Randy Birch.
Speed tests favour FileIsOpen3 and FileIsOpen4.
Function FileIsOpen1(ByVal pathfile As String) As Boolean
Dim ff As Integer
If System.IO.File.Exists(pathfile) Then
Try
ff = FreeFile()
Microsoft.VisualBasic.FileOpen(ff, pathfile, OpenMode.Binary, OpenAccess.Read, OpenShare.LockReadWrite)
Return False
Catch
Return True
Finally
FileClose(ff)
End Try
Return True
End If
End Function
Function FileIsOpen2(ByVal pathfile As String) As Boolean
Dim stream As FileStream = Nothing
Dim fi As FileInfo = Nothing
If System.IO.File.Exists(pathfile) Then
Try
fi = New System.IO.FileInfo(pathfile)
stream = fi.Open(FileMode.Open, FileAccess.Read, FileShare.None)
Return True
Catch generatedExceptionName As IOException
Return False
Finally
If stream IsNot Nothing Then
stream.Close()
End If
fi = Nothing
End Try
Return True
End If
End Function
Private Function FileIsOpen3(ByVal pathfile As String) As Boolean
Try
Dim fs As IO.FileStream = IO.File.Open(pathfile, IO.FileMode.Open, IO.FileAccess.Read, IO.FileShare.None)
fs.Close()
fs.Dispose()
fs = Nothing
Return False
Catch ex As IO.IOException ' File open
Return True
Catch ex As Exception ' Unknown error
Return True
End Try
End Function
Private Declare Function CreateFile Lib "kernel32" _
Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hFile As Long) As Long
' Method
Shared Function FileIsOpen4(ByVal pathfile As String) As Boolean
' Is File In Use ©1996-2009 Randy Birch
' http://vbnet.mvps.org/index.html?code/fileapi/createfile_inuse.htm
Const GENERIC_READ As Long = &H80000000
Const INVALID_HANDLE_VALUE As Long = -1
Const OPEN_EXISTING As Long = 3
Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Dim hFile As Long
If System.IO.File.Exists(pathfile) Then
Try
' note that FILE_ATTRIBUTE_NORMAL (&H80) has a different value than VB's constant vbNormal (0)!
hFile = CreateFile(pathfile, GENERIC_READ, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0&)
' this will evaluate to either -1 (File in use) or 0 (File free)
Return hFile = INVALID_HANDLE_VALUE
Catch ex As Exception
MessageBox.Show(ex.ToString)
Finally
CloseHandle(hFile)
End Try
Else
Return True
End If
End Function
The second user can try to open the file in read-write mode to know if the file is being used.