分类:
2008-09-09 16:35:34
Imports System.Runtime.InteropServices '引及Net框架中对底层操作支持的命名空间 Public Class clsDAMSMobileMarshal '我写的内存管理类 #Region "与内存有关的API声明" REM 以下是与内存有关的移动设备API Public Declare Function LocalAlloc Lib "coredll.dll" Alias "LocalAlloc" (ByVal wFlags As Int32, _ ByVal wBytes As Int32) As IntPtr Public Declare Function LocalFree Lib "coredll.dll" Alias "LocalFree" (ByVal hMem As Int32) As Int32 Public Declare Function LocalLock Lib "coredll.dll" Alias "LocalLock" (ByVal hMem As Int32) As Int32 Public Declare Function LocalReAlloc Lib "coredll.dll" Alias "LocalReAlloc" (ByVal hMem As IntPtr, _ ByVal wBytes As Int32, ByVal wFlags As Int32) As IntPtr #End Region #Region "API常量声明" Public Const LMEM_FIXED = 0 Public Const LMEM_MOVEABLE = &H2 Public Const LMEM_ZEROINIT = &H40 Public Const LPTR = LMEM_FIXED Or LMEM_ZEROINIT #End Region Public Shared Function fnAllocHLocal(ByVal ni_i32Size As Int32) As IntPtr '申请本地内存,返回一个指向该内存块的指针 Return LocalAlloc(LPTR, ni_i32Size) End Function Public Shared Function fnFreeHLocal(ByRef ni_pLocal As IntPtr) As Int32 REM 释放指定的内存块柄 Dim ti32FunctionReturnValue As Int32 If ni_pLocal.Equals(IntPtr.Zero) = False Then ti32FunctionReturnValue = (LocalFree(ni_pLocal.ToInt32)) If ti32FunctionReturnValue = 0 Then ni_pLocal = IntPtr.Zero End If End If Return (ti32FunctionReturnValue) End Function Public Shared Function fnReAllocHLocal(ByVal ni_pIn As IntPtr, ByVal ni_i32Size As Int32) As IntPtr '对指定的内存块重新定义大小 Return LocalReAlloc(ni_pIn, ni_i32Size, LMEM_MOVEABLE) End Function Public Shared Function fnStringToHLocalUni(ByVal ni_strIn As String) As IntPtr '将指定的字符串复制到一个内存块中,并返回该内存块的指针,这个指针必须使用fnFreeHLocal函数释放 Dim ti32StringBufLength As Int32 Dim tpTempA As IntPtr If Not (ni_strIn Is Nothing) Then If ni_strIn.Length = 0 Then Return IntPtr.Zero Else ti32StringBufLength = (ni_strIn.Length + 1) * 2 ' 包括最后一个中止字符 tpTempA = fnAllocHLocal(ti32StringBufLength) If tpTempA.Equals(IntPtr.Zero) = False Then '申请内存成功 Marshal.Copy(ni_strIn.ToCharArray, 0, tpTempA, ni_strIn.Length) Return tpTempA End If End If End If End Function End Class |
imports System.Runtime.InteropServices REM API常数声明------------------------- Public Const SW_SHOWNORMAL = 1 Public Const gcNORMAL_PRIORITY_CLASS = &H20 Public Const gcINFINITE = &HFFFF Public Const WAIT_TIMEOUT = &H102& #Region "Structure SHELLEXECUTEINFO" Structure SHELLEXECUTEINFO Public cbSize As Int32 Public fMask As Int32 Public hwnd As IntPtr Public lpVerb As IntPtr 'LPCTSTR,这种类型不能声明为string,只可以老老实实声明为Intptr Public lpFile As IntPtr 'LPCTSTR,这种类型不能声明为string,只可以老老实实声明为Intptr Public lpParameters As IntPtr 'LPCTSTR,这种类型不能声明为string,只可以老老实实声明为Intptr Public lpDirectory As IntPtr 'LPCTSTR,这种类型不能声明为string,只可以老老实实声明为Intptr Public nShow As Int32 Public hInstApp As IntPtr 'Optional members Public lpIDList As IntPtr 'LPVOID Public lpClass As IntPtr 'LPCTSTR Public hkeyClass As Int32 Public dwHotKey As Int32 Public hIcon As Int32 Public hProcess As IntPtr Public Sub Dispose() '在调用后释放结构中的内存块 clsDAMSMobileMarshal.fnFreeHLocal(Me.lpVerb) clsDAMSMobileMarshal.fnFreeHLocal(Me.lpFile) clsDAMSMobileMarshal.fnFreeHLocal(Me.lpParameters) clsDAMSMobileMarshal.fnFreeHLocal(Me.lpDirectory) End Sub End Structure #End Region #Region "Structure STARTUPINFO" Public Structure STARTUPINFO Public cb As Int32 Public lpReserved As IntPtr Public lpDesktop As IntPtr Public lpTitle As IntPtr Public dwX As Int32 Public dwY As Int32 Public dwXSize As Int32 Public dwYSize As Int32 Public dwXCountChars As Int32 Public dwYCountChars As Int32 Public dwFillAttribute As Int32 Public dwFlags As Int32 Public wShowWindow As Int16 Public cbReserved2 As Int16 Public lpReserved2 As Int32 Public hStdInput As Int32 Public hStdOutput As Int32 Public hStdError As Int32 End Structure #End Region #Region "Structure PROCESS_INFORMATION" Public Structure PROCESS_INFORMATION Public hProcess As IntPtr Public hThread As IntPtr Public dwProcessId As Int32 Public dwThreadId As Int32 End Structure #End Region REM api函数声明--------------------------------- #Region "Function CreateProcess" public Overloads Declare Function CreateProcess Lib "coredll.dll" (ByVal imageName As String, _ ByVal cmdLine As String, _ ByVal lpProcessAttributes As IntPtr, _ ByVal lpThreadAttributes As IntPtr, _ ByVal boolInheritHandles As Int32, _ ByVal dwCreationFlags As Int32, _ ByVal lpEnvironment As IntPtr, _ ByVal lpszCurrentDir As IntPtr, _ ByRef si As STARTUPINFO, _ ByRef pi As PROCESS_INFORMATION _ ) As Integer #End Region #Region "Function CloseHandle" Public Declare Function CloseHandle Lib "CoreDll.dll" (ByVal Handle As IntPtr) As Int32 #End Region #Region "Function WaitForSingleObjectEx" Public Declare Function WaitForSingleObjectEx Lib "coredll.dll" (ByVal hHandle As IntPtr, _ ByVal dwMilliseconds As Int32, _ ByVal bAlertable As Int32 _ ) As Int32 #End Region #Region "Function ShellExecuteEx" Public Declare Function ShellExecuteEx Lib "coredll.dll" (ByRef lpExecInfo As SHELLEXECUTEINFO) As Int32 #End Region |
Imports System.Runtime.InteropServices |
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim tudtShellExecuteInfo As New SHELLEXECUTEINFO Dim tstrExecutePath As String Dim tudtStartupInfo As STARTUPINFO Dim tudtProcessInfo As PROCESS_INFORMATION Dim tlngTempa As Int32 With tudtStartupInfo .cb = Marshal.SizeOf(GetType(STARTUPINFO)) End With With tudtShellExecuteInfo .cbSize = Marshal.SizeOf(GetType(SHELLEXECUTEINFO)) .lpFile = clsDAMSMobileMarshal.fnStringToHLocalUni("\\calc.exe") .lpParameters = IntPtr.Zero '不使用参数,如使用参数可按lpFile的方法申请字符串指针 End With tlngTempa = ShellExecuteEx(tudtShellExecuteInfo) '启动程序 tudtShellExecuteInfo.Dispose() If tlngTempa = 0 Then '使用shellexecuteex失败,试图使用createprocess再打开试试 tlngTempa = CreateProcess("\windows\calc.exe", "\windows\calc.exe", IntPtr.Zero, IntPtr.Zero, _ 0, 0, IntPtr.Zero, IntPtr.Zero, tudtStartupInfo, tudtProcessInfo) If tlngTempa <> 0 Then Call CloseHandle(tudtProcessInfo.hThread) Call CloseHandle(tudtProcessInfo.hProcess) End If End If End Sub |