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.
Related
I'm trying to use a PrivateFontCollection for my application, so it can print a document with a specific font. note that i can not "install" the font as the Windows directory is admin protected.
The code I have works, in the sense that provided I close my application, and restart it, when i restart it, it will recognise that the font is there and can be used. But if I click the command button to install the font as a privatefontcollection, and then refresh my PrintDocument, it does not show it using the newly installed font. I have to close the app and open it, and then it does.
Public Shared Function AddFontResource(ByVal lpFileName As String) As Integer
End Function
<DllImport("user32.dll")>
Public Shared Function SendMessage(ByVal hWnd As Integer, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
End Function
<DllImport("kernel32.dll", SetLastError:=True)>
Shared Function WriteProfileString(ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Integer
End Function
<DllImport("user32.dll", SetLastError:=True)>
Public Shared Function SendMessageTimeout(ByVal hWnd As IntPtr,
ByVal msg As Integer,
ByVal wParam As IntPtr,
ByVal lParam As IntPtr,
ByVal flags As SendMessageTimeoutFlags,
ByVal timeout As Integer,
ByRef result As IntPtr) As IntPtr
End Function
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
Public Shared Function SendNotifyMessage(
ByVal hWnd As IntPtr,
ByVal msg As UInteger,
ByVal wParam As UIntPtr,
ByVal lParam As IntPtr
) As Boolean
End Function
<Flags()>
Public Enum SendMessageTimeoutFlags
SMTO_NORMAL = 0
SMTO_BLOCK = 1
SMTO_ABORTIFHUNG = 2
SMTO_NOTIMEOUTIFNOTHUNG = 8
End Enum
Private Sub RibbonButton1_Click(sender As Object, e As EventArgs) Handles RibbonButton1.Click
Try
If IsFontInstalled("Open Sans ExtraBold") = False Then
Dim Fonts_Source As String = Path.Combine(Application.StartupPath, "Resources\OpenSans-ExtraBold.ttf")
Dim Fonts_Install As String = My.Computer.FileSystem.CombinePath(Environment.GetFolderPath(Environment.SpecialFolder.Fonts), "OpenSans-ExtraBold.ttf")
Dim Ret As Integer
Dim Res As Integer
Dim FontPath As String
Const WM_FONTCHANGE As Integer = &H1D
Const HWND_BROADCAST As Integer = &HFFFF
FontPath = Fonts_Install.ToString
Ret = AddFontResource(Fonts_Source.ToString)
Res = SendMessageTimeout(HWND_BROADCAST, WM_FONTCHANGE, IntPtr.Zero, IntPtr.Zero,
SendMessageTimeoutFlags.SMTO_ABORTIFHUNG Or
SendMessageTimeoutFlags.SMTO_NOTIMEOUTIFNOTHUNG,
5000, IntPtr.Zero)
Ret = WriteProfileString("Fonts", Path.GetFileName(FontPath) & " (TrueType)", FontPath.ToString)
End If
Catch ex As Exception
MsgBox("Error: " & ex.Message)
End Try
End Sub
This next subroutine is the one that draws the document. I have a function to check if the font is installed, and if its not then the an alternative font is used.
Dim TitleFont As New Font("Segoe UI Black", Font48Pt, FontStyle.Bold)
If IsFontInstalled("Open Sans ExtraBold") = True Then TitleFont = New Font("Open Sans ExtraBold", Font48Pt)
If Title <> "Everyday" Then
'TITLE TEXT DRAWN
Dim TitleRect As RectangleF = New RectangleF()
TitleRect.Location = New Point(20, 25)
TitleRect.Size = New Size(DrawWidth, CInt(e.Graphics.MeasureString(Title, TitleFont, DrawWidth, CenterAlignment).Height))
e.Graphics.DrawString(Title, TitleFont, ForeColourBrush, TitleRect, CenterAlignment)
End If
the function that checks if the font is installed.
Public Function IsFontInstalled(ByVal FontName As String) As Boolean
Using TestFont As Font = New Font(FontName, 10)
Return CBool(String.Compare(FontName, TestFont.Name, StringComparison.InvariantCultureIgnoreCase) = 0)
End Using
End Function
this function above could be the problem as it returns false. mind you if I close the app and restart it, then this same function will then detect the privatefontcollection and return true, and I can successfully print my document with my font.
I did try adding the install font subroutine, to the very start of my app. then raising a flag if a font was installed and then tried to call the Application.Restart() method, so that while the splash screen was up it could install the font, then immediately restart the app, which of course would then latch onto the installed font, but this method just left the app in a loop of opening and closing.
I made some research, but I can't find something really "interesting". I tried my best to find any kind of documentation or questions that are closest to my case as following:
How to find main window title name of application
how to get the window title of a process
How to get the Title Bar Text by its Process Id
getting the name of a process
How do I get list of Process Names running
Check to see if process is running
How To Get Process Owner ID
How to get the title/name of the last active window?
Get Process ID from Window Title
and also
Process.GetProcessesByName Method
The code I am using to open the process window
Private Async Function ParentMethod() As Task
Dim filePath As String = Await Task.Run(
Function()
Return Directory.EnumerateFiles(My.Settings.Cartellasalvataggio, titolo & ".mp3",
SearchOption.AllDirectories).FirstOrDefault()
End Function)
If Not String.IsNullOrEmpty(filePath) Then
LinkLabel1.Text = "File exist already"
LinkLabel1.Visible = True
PictureBox7.Visible = True
Else
MsgBox("it doesn't exist")
End If
End Function
and the helper class
Imports System.IO
Imports System.Runtime.InteropServices
Public Class NativeMethods
<DllImport("shell32.dll", SetLastError:=True)>
Private Shared Function SHOpenFolderAndSelectItems(
pidlFolder As IntPtr, cidl As UInteger,
<[In], MarshalAs(UnmanagedType.LPArray)> apidl As IntPtr(),
dwFlags As UInteger) As Integer
End Function
<DllImport("shell32.dll", SetLastError:=True)>
Private Shared Sub SHParseDisplayName(
<MarshalAs(UnmanagedType.LPWStr)> name As String,
bindingContext As IntPtr, <Out> ByRef pidl As IntPtr,
sfgaoIn As UInteger, <Out> ByRef psfgaoOut As UInteger)
End Sub
Public Shared Sub OpenFolderAndSelectFile(filePath As String)
Dim dirPath As String = Path.GetDirectoryName(filePath)
Dim fileName As String = Path.GetFileName(filePath)
OpenFolderAndSelectFile(dirPath, fileName)
End Sub
Public Shared Sub OpenFolderAndSelectFile(dirPath As String, fileName As String)
Dim nativeFolder As IntPtr
Dim psfgaoOut As UInteger
SHParseDisplayName(dirPath, IntPtr.Zero, nativeFolder, 0, psfgaoOut)
If nativeFolder = IntPtr.Zero Then
' Log error, can't find folder
Return
End If
Dim nativeFile As IntPtr
SHParseDisplayName(Path.Combine(dirPath, fileName),
IntPtr.Zero, nativeFile, 0, psfgaoOut)
Dim fileArray As IntPtr()
If nativeFile = IntPtr.Zero Then
' Open the folder without the file selected if we can't find the file
fileArray = New IntPtr(-1) {}
Else
fileArray = New IntPtr() {nativeFile}
End If
SHOpenFolderAndSelectItems(nativeFolder, CUInt(fileArray.Length), fileArray, 0)
Marshal.FreeCoTaskMem(nativeFolder)
If nativeFile <> IntPtr.Zero Then
Marshal.FreeCoTaskMem(nativeFile)
End If
End Sub
End Class
then calling it with
NativeMethods.OpenFolderAndSelectFile(filepath,filename & "extension"))
Since I am opening the process this way and NOT with Process class, almost all of them are not suitable to be considered for my case as many of them refer to notepad, while I think the explorer window title and ID changes for every file ( obviously), while "notepad" process, stay "notepad".
I also tried BringToFront, but this latter moves a control in front of other controls, but in this case Explorer is not a control, right?
The least I want to do is to
Get a list of active windows & their process names
as It will waste memory and time usage for no reason as I will need to "filter" process to find my process.
Hope we can find a solution to this, Thanks in advance.
Mattia
This is the solution to it using FindWindowW e SetWindowPos Api.
It is showing Explorer folder on top of top most form.
<DllImport("user32.dll", EntryPoint:="FindWindowW")>
Public Shared Function FindWindowW(<MarshalAs(UnmanagedType.LPTStr)> ByVal lpClassName As String, <MarshalAs(UnmanagedType.LPTStr)> ByVal lpWindowName As String) As IntPtr
End Function
<DllImport("user32.dll")>
Shared Function SetWindowPos(ByVal hWnd As IntPtr, ByVal hWndInsertAfter As IntPtr, ByVal X As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal uFlags As UInteger) As Boolean
End Function
Shared ReadOnly HWND_TOPMOST As IntPtr = New IntPtr(-1)
Const SWP_NOSIZE As UInt32 = &H1
Const SWP_NOMOVE As UInt32 = &H2
Const SWP_SHOWWINDOW As UInt32 = &H40
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Dim inptr = FindWindowW("CabinetWClass", Nothing)
SetWindowPos(inptr, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW)
End Sub
I am new to VB.Net. I came from vb6 and VBA so I'm still learning. I am trying to clear the memory space for when I retrieve text using my GetWinTxt() function. I am not sure if I am properly releasing the memory space or not. I have researched MSDN and a multitude of other sites including this one trying to learn about this and I find it somewhat confusing. This function will be used a lot and i don't want a memory leak. It seems to be working fine as there isn't any error codes but can someone with more knowledge please tell me if I'm doing this right? Also should I be using Marshal.DestroyStructure() before I use Marshal.FreeHGlobal()? And if so how would I use that in my code below?
Option Explicit On
Imports System.Runtime.InteropServices
Declare Auto Function SendMessage Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
Shared Function FindWindow(ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
End Function
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
Shared Function FindWindowEx(ByVal parentHandle As IntPtr, ByVal childAfter As IntPtr, ByVal lclassName As String, ByVal windowTitle As String) As IntPtr
End Function
Friend Const WM_GETTEXT = &HD
Friend Const WM_GETTEXTLENGTH = &HE
Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
Dim Hwnd As IntPtr = FindWindow(Nothing, "Untitled - Notepad") 'notepad parent win
Dim Handle As IntPtr = FindWindowEx(Hwnd, IntPtr.Zero, "Edit", Nothing) 'notepad edit area
MsgBox(Lf.GetWinTxt(Handle))'Lf is my class name
End Sub
Friend Function GetWinTxt(hwnd As IntPtr) As String
Dim TextLen As Integer = SendMessage(hwnd, WM_GETTEXTLENGTH, 0, 0) + 1
Dim WinHandle As IntPtr = Marshal.AllocHGlobal(TextLen)
Call SendMessage(hwnd, WM_GETTEXT, TextLen, WinHandle)
Dim txt As String = Marshal.PtrToStringUni(WinHandle)
GetWinTxt = txt
Dim ByteString(TextLen) As Byte ' the next 3 lines are what i'm not sure if i'm doing it right or not
Marshal.Copy(WinHandle, ByteString, 0, TextLen)
Marshal.FreeHGlobal(txt)
End Function
EDITED FINAL CODE:
Public Function GetWinTxt(hwnd As IntPtr) As String
Dim TextLen As IntPtr = SendMessage(hwnd, WM_GETTEXTLENGTH, 0, 0) + 1
Dim f As Integer = TextLen
Winhandle = Marshal.AllocHGlobal(f)
Call SendMessage(hwnd, WM_GETTEXT, f, Winhandle)
Dim txt As String = Marshal.PtrToStringUni(Winhandle)
Return txt
Try
Dim ByteString(f) As Byte
Marshal.Copy(Winhandle, ByteString, 0, f)
Marshal.FreeHGlobal(Winhandle)
Catch ex As Exception
Return ""
Debug.Print(ex.Message)
End Try
End Function
The answer is no, unless you call method like Marshal. StructureToPtr().
You should use the counterpart of whatever method you used to allocate it.
Marshal. Destroy Structure will free all substructures that specify unmanaged memory block points to. But you don't have any structure in it.
In addition, you call Dim WinHandle As IntPtr = Marshal.AllocHGlobal(TextLen) Allocates memory from the unmanaged memory of the process to WinHandle, then free anther one, Marshal.FreeHGlobal(txt). This will cause memory leaks.
try to change it to Marshal.FreeHGlobal(WinHandle).
I've recreated some of the OpenNetCF components like PowerManagement and DeviceStatusMonitor. But since they never raised any events I suspected that something was wrong. My first thought was to check the P2PMessageQueue which they both depends on. And then BAM, the CreateMsgQueue returns IntPtr.Zero. Checking for the last Win32Error gives me an error code of value -2147467259 (minus).
Is this just another generic error code that doesn't provide any hints?
Any help would be appreciated.
(FYI: WinCE 5.0, CF 2.0)
Public Class Form1
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Try
Dim lpName As String = "MyQueue"
Dim lpOptions As MSGQUEUEOPTIONS = New MSGQUEUEOPTIONS()
Dim hMsgQ As IntPtr = IntPtr.Zero
lpOptions.bReadAccess = True
lpOptions.dwMaxMessages = 0
lpOptions.cbMaxMessage = &H1000
lpOptions.dwFlags = MSGQUEUE_ALLOW_BROKEN
lpOptions.dwSize = Marshal.SizeOf(lpOptions)
hMsgQ = CreateMsgQueue(lpName, lpOptions)
If (hMsgQ = IntPtr.Zero) Then
Throw New Win32Exception(Marshal.GetLastWin32Error())
Else
CloseMsgQueue(hMsgQ)
End If
Catch ex As Win32Exception
MessageBox.Show(String.Format(String.Format("Win32Exception: {0}", ex.ErrorCode)))
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Sub
<DllImport("coredll.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
Private Shared Function CloseMsgQueue(ByVal hMsgQ As IntPtr) As Boolean
End Function
<DllImport("coredll.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
Private Shared Function CreateMsgQueue(<MarshalAs(UnmanagedType.LPWStr)> ByVal lpName As String, ByVal lpOptions As MSGQUEUEOPTIONS) As IntPtr
End Function
<StructLayout(LayoutKind.Sequential)> _
Private Structure MSGQUEUEOPTIONS
Public dwSize As Integer
Public dwFlags As Integer
Public dwMaxMessages As Integer
Public cbMaxMessage As Integer
Public bReadAccess As Boolean
End Structure
Private Const MSGQUEUE_ALLOW_BROKEN As Integer = 2
Private Const MSGQUEUE_NOPRECOMMIT As Integer = 1
Private Const MSGQUEUE_MSGALERT As Integer = 1
End Class
The lpOptions parameter is declared incorrectly. You declare it as ByVal but it should be ByRef.
That said, -2147467259 is a bit of an oddity. That's not a Win32 error code. That's a COM HRESULT. Specifically it's 0x80004005. Which is the COM wrapper around the Win32 ERROR_ACCESS_DENIED. Not sure where you get a COM HRESULT from in this code mind you, but it would appear that you don't have sufficient rights for what you are attempting.
I am trying to write text to Win32 resources, but I have failed with it.
Here it is after writing the text:
And here is how it should look like:
Here's my code:
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
WriteResourceStr(Target.Text, "hello")
End Sub
#Region "Second"
<DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Unicode)> _
Private Shared Function UpdateResource(ByVal hUpdate As IntPtr, ByVal lpType As String, ByVal lpName As String, ByVal wLanguage As UShort, ByVal lpData As IntPtr, ByVal cbData As UInteger) As Boolean
End Function
<DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Unicode)> _
Private Shared Function BeginUpdateResource(ByVal pFileName As String, <MarshalAs(UnmanagedType.Bool)> ByVal bDeleteExistingResources As Boolean) As IntPtr
End Function
<DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Unicode)> _
Private Shared Function EndUpdateResource(ByVal hUpdate As IntPtr, ByVal fDiscard As Boolean) As Boolean
End Function
Public Function WriteResourceStr(ByVal filename As String, ByVal bytes As String) As Boolean
Try
Dim handle As IntPtr = BeginUpdateResource(filename, False)
Dim file1 As String = bytes
Dim fileptr As IntPtr = ToPtr(file1)
Dim res As Boolean = UpdateResource(handle, "RCData", "CONFIG", 1, fileptr, System.Convert.ToUInt16(file1.Length))
EndUpdateResource(handle, False)
Catch ex As Exception
Return False
End Try
Return True
End Function
Private Function ToPtr(ByVal data As Object) As IntPtr
Dim h As GCHandle = GCHandle.Alloc(data, GCHandleType.Pinned)
Dim ptr As IntPtr
Try
ptr = h.AddrOfPinnedObject()
Finally
h.Free()
End Try
Return ptr
End Function
#End Region
So seems like it doesn't write ANSI, but in Unicode. How to change that?
Hopefully somebody replies.
The simplest way to get this is to just overload UpdateResource and let Windows make the Unicode to ANSI conversion for you:
<DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Ansi)> _
Private Shared Function UpdateResource(ByVal hUpdate As IntPtr, _
ByVal lpType As String, ByVal lpName As String, ByVal wLanguage As UShort,
ByVal lpData As String, ByVal cbData As Integer) As Boolean
End Function
Note the changed lpData type and the changed CharSet. The call now simply becomes:
Dim handle As IntPtr = BeginUpdateResource(filename, False)
If handle = IntPtr.Zero Then Throw New Win32Exception
Dim res As Boolean = UpdateResource(handle, "RCData", "CONFIG", 1, _
bytes, bytes.Length)
If Not EndUpdateResource(handle, False) Then Throw New Win32Exception
I'll have to restate the nonsensical nature of the call. RCData is a numbered resource type and not a string. Using a language ID of 1 makes little sense, that's Arabic so you wouldn't expect a Latin string in the resource. Whatever app reads this resource is unlikely to find it back.
Doing this correctly would require an overload that declares lpType as IntPtr so you can pass CType(10, IntPtr) for the RT_RCData resource type. The ToPtr() function is extremely evil, it returns a dangling pointer that will cause random data corruption. Just let the pinvoke marshaller generate the pointer by declaring the lpData argument as Byte(). You'd then use Encoding.GetBytes() to use the proper ANSI conversion. Thus:
<DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Unicode)> _
Private Shared Function UpdateResource(ByVal hUpdate As IntPtr, _
ByVal lpType As IntPtr, ByVal lpName As String, ByVal wLanguage As UShort,
ByVal lpData As Byte(), ByVal cbData As Integer) As Boolean
End Function
With an additional overload required if lpName is a numbered instead of a named resource, use IntPtr.