用VB编写一个程序。~点击运行了~。可以关闭防火墙。如果在XP 关闭XP的默认防火墙。怎么实现?
解决方案 »
- vb调用excel绘制折线图
- 初学者 望高手解答一下
- 在机械行业用VB主要做些什么?这东西上手快吗?
- ActiveReport数据行高的问题?能不能用编程控制数据行高,而不是采用设计出来的行高,因为数据字符是不确定的?
- 为什么在vb里运行出错会,而编译出来以后就不会?
- Access VBA 关于日期问题的求助
- 请问VB中data控件findfirst 方法的使用
- 请,vb版的朋友看个简单问题
- 如何使用“字节数组”?
- To:吴文智,请发一个vsflexgrid给我好不好?[email protected];[email protected]
- 一点小问题,分不多。
- ActiveReports里面的如何强制分页,就是detail下field里的值显示一个固定的行数后强制分页,不必整张纸!(高手请进!)急!
'----------------Sample1
Private Declare Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long)
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Sub Form_Load()
'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail: [email protected]
'end this process
ExitProcess GetExitCodeProcess(GetCurrentProcess, 0)
End Sub
'Re: If you're using VB4 or VB5, you should first uncomment
' the Replace function (on the end of the code)'In a form
Private Sub Form_Load()
'Code submitted by Roger Taylor
'enumerate all the different explorer.exe processes
GetProcesses "explorer.exe"
End Sub'In a modulePublic Declare Function GetProcessMemoryInfo Lib "PSAPI.DLL" (ByVal hProcess As Long, ppsmemCounters As PROCESS_MEMORY_COUNTERS, ByVal cb As Long) As Long
Public Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function CloseHandle Lib "Kernel32.dll" (ByVal Handle As Long) As Long
Public Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Public Declare Function EnumProcesses Lib "PSAPI.DLL" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Public Declare Function GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Public Declare Function EnumProcessModules Lib "PSAPI.DLL" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Public Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Public Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)Public Const PROCESS_QUERY_INFORMATION = 1024
Public Const PROCESS_VM_READ = 16
Public Const MAX_PATH = 260
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public Const TH32CS_SNAPPROCESS = &H2&
Public Const hNull = 0
Public Const WIN95_System_Found = 1
Public Const WINNT_System_Found = 2
Public Const Default_Log_Size = 10000000
Public Const Default_Log_Days = 0
Public Const SPECIFIC_RIGHTS_ALL = &HFFFF
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
Type PROCESS_MEMORY_COUNTERS
cb As Long
PageFaultCount As Long
PeakWorkingSetSize As Long
WorkingSetSize As Long
QuotaPeakPagedPoolUsage As Long
QuotaPagedPoolUsage As Long
QuotaPeakNonPagedPoolUsage As Long
QuotaNonPagedPoolUsage As Long
PagefileUsage As Long
PeakPagefileUsage As Long
End Type
Public Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long ' This process
th32DefaultHeapID As Long
th32ModuleID As Long ' Associated exe
cntThreads As Long
th32ParentProcessID As Long ' This process's parent process
pcPriClassBase As Long ' Base priority of process threads
dwFlags As Long
szExeFile As String * 260 ' MAX_PATH
End Type
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long '1 = Windows 95.
'2 = Windows NT
szCSDVersion As String * 128
End Type
Public Function GetProcesses(ByVal EXEName As String) Dim booResult As Boolean
Dim lngLength As Long
Dim lngProcessID As Long
Dim strProcessName As String
Dim lngSnapHwnd As Long
Dim udtProcEntry As PROCESSENTRY32
Dim lngCBSize As Long 'Specifies the size, In bytes, of the lpidProcess array
Dim lngCBSizeReturned As Long 'Receives the number of bytes returned
Dim lngNumElements As Long
Dim lngProcessIDs() As Long
Dim lngCBSize2 As Long
Dim lngModules(1 To 200) As Long
Dim lngReturn As Long
Dim strModuleName As String
Dim lngSize As Long
Dim lngHwndProcess As Long
Dim lngLoop As Long
Dim b As Long
Dim c As Long
Dim e As Long
Dim d As Long
Dim pmc As PROCESS_MEMORY_COUNTERS
Dim lret As Long
Dim strProcName2 As String
Dim strProcName As String 'Turn on Error handler
On Error GoTo Error_handler booResult = False EXEName = UCase$(Trim$(EXEName))
lngLength = Len(EXEName) 'ProcessInfo.bolRunning = False Select Case getVersion()
'I'm not bothered about windows 95/98 becasue this class probably wont be used on it anyway.
Case WIN95_System_Found 'Windows 95/98 Case WINNT_System_Found 'Windows NT lngCBSize = 8 ' Really needs To be 16, but Loop will increment prior to calling API
lngCBSizeReturned = 96 Do While lngCBSize <= lngCBSizeReturned
DoEvents
'Increment Size
lngCBSize = lngCBSize * 2
'Allocate Memory for Array
ReDim lngProcessIDs(lngCBSize / 4) As Long
'Get Process ID's
lngReturn = EnumProcesses(lngProcessIDs(1), lngCBSize, lngCBSizeReturned)
Loop 'Count number of processes returned
lngNumElements = lngCBSizeReturned / 4
'Loop thru each process For lngLoop = 1 To lngNumElements
DoEvents 'Get a handle to the Process and Open
lngHwndProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lngProcessIDs(lngLoop)) If lngHwndProcess <> 0 Then
'Get an array of the module handles for the specified process
lngReturn = EnumProcessModules(lngHwndProcess, lngModules(1), 200, lngCBSize2) 'If the Module Array is retrieved, Get the ModuleFileName
If lngReturn <> 0 Then 'Buffer with spaces first to allocate memory for byte array
strModuleName = Space(MAX_PATH) 'Must be set prior to calling API
lngSize = 500 'Get Process Name
lngReturn = GetModuleFileNameExA(lngHwndProcess, lngModules(1), strModuleName, lngSize) 'Remove trailing spaces
strProcessName = Left(strModuleName, lngReturn) 'Check for Matching Upper case result
strProcessName = UCase$(Trim$(strProcessName)) strProcName2 = GetElement(Trim(Replace(strProcessName, Chr$(0), "")), "\", 0, 0, GetNumElements(Trim(Replace(strProcessName, Chr$(0), "")), "\") - 1) If strProcName2 = EXEName Then 'Get the Site of the Memory Structure
pmc.cb = LenB(pmc) lret = GetProcessMemoryInfo(lngHwndProcess, pmc, pmc.cb) Debug.Print EXEName & "::" & CStr(pmc.WorkingSetSize / 1024) End If
End If
End If
'Close the handle to this process
lngReturn = CloseHandle(lngHwndProcess)
DoEvents
Next End SelectIsProcessRunning_Exit:'Exit early to avoid error handler
Exit Function
Error_handler:
Err.Raise Err, Err.Source, "ProcessInfo", Error
Resume Next
End Function
'未完
Dim retvalue As Integer osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
getVersion = osinfo.dwPlatformIdEnd Function
Private Function StrZToStr(s As String) As String
StrZToStr = Left$(s, Len(s) - 1)
End FunctionPublic Function GetElement(ByVal strList As String, ByVal strDelimiter As String, ByVal lngNumColumns As Long, ByVal lngRow As Long, ByVal lngColumn As Long) As String Dim lngCounter As Long ' Append delimiter text to the end of the list as a terminator.
strList = strList & strDelimiter ' Calculate the offset for the item required based on the number of columns the list
' 'strList' has i.e. 'lngNumColumns' and from which row the element is to be
' selected i.e. 'lngRow'.
lngColumn = IIf(lngRow = 0, lngColumn, (lngRow * lngNumColumns) + lngColumn) ' Search for the 'lngColumn' item from the list 'strList'.
For lngCounter = 0 To lngColumn - 1 ' Remove each item from the list.
strList = Mid$(strList, InStr(strList, strDelimiter) + Len(strDelimiter), Len(strList)) ' If list becomes empty before 'lngColumn' is found then just
' return an empty string.
If Len(strList) = 0 Then
GetElement = ""
Exit Function
End If Next lngCounter ' Return the sought list element.
GetElement = Left$(strList, InStr(strList, strDelimiter) - 1)End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Function GetNumElements (ByVal strList As String,
' ByVal strDelimiter As String)
' As Integer
'
' strList = The element list.
' strDelimiter = The delimiter by which the elements in
' 'strList' are seperated.
'
' The function returns an integer which is the count of the
' number of elements in 'strList'.
'
' Author: Roger Taylor
'
' Date:26/12/1998
'
' Additional Information:
'
' Revision History:
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Public Function GetNumElements(ByVal strList As String, ByVal strDelimiter As String) As Integer Dim intElementCount As Integer ' If no elements in the list 'strList' then just return 0.
If Len(strList) = 0 Then
GetNumElements = 0
Exit Function
End If ' Append delimiter text to the end of the list as a terminator.
strList = strList & strDelimiter ' Count the number of elements in 'strlist'
While InStr(strList, strDelimiter) > 0
intElementCount = intElementCount + 1
strList = Mid$(strList, InStr(strList, strDelimiter) + 1, Len(strList))
Wend ' Return the number of elements in 'strList'.
GetNumElements = intElementCountEnd Function
'If you're using VB4 or VB5, uncomment the following function:
'Function Replace(sInput As String, WhatToReplace As String, ReplaceWith As String) As String
'Dim Ret As Long
'Replace = sInput
'Ret = -Len(ReplaceWith) + 1
'Do
'Ret = InStr(Ret + Len(ReplaceWith), Replace, WhatToReplace, vbTextCompare)
'If Ret = 0 Then Exit Do
'Replace = Left$(Replace, Ret - 1) + ReplaceWith + Right$(Replace, Len(Replace) - Ret - Len(WhatToReplace) + 1)
'Loop
'End Function
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Const PROCESS_TERMINATE = &H1''用于结束外部进程,hCloseWnd 是要结束的程序的主窗口的 HWND
Public Function TerminateProcessByHWND(ByVal hCloseWnd As Long) As Boolean
Dim hProcessID As Long
Dim hProcess As Long
On Error GoTo PROC_EXIT
If hCloseWnd = 0 Then GoTo PROC_EXIT
If GetWindowThreadProcessId(hCloseWnd, hProcessID) = 0 Then GoTo PROC_EXIT
hProcess = OpenProcess(PROCESS_TERMINATE, False, hProcessID)
If hProcess = 0 Then GoTo PROC_EXIT
If TerminateProcess(hProcess, 0&) = 0 Then GoTo PROC_EXIT
TerminateProcessByHWND = True
PROC_EXIT:
If Err.Number <> 0 Then
Debug.Print Err.Description
Err.Clear
End If
End Function
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Const PROCESS_TERMINATE = &H1
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End TypePrivate Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End TypePrivate Declare Function dcWaitForSingleObject Lib "kernel32" Alias "WaitForSingleObject" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As LongPrivate Declare Function dcCreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal _
lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As _
PROCESS_INFORMATION) As LongPrivate Declare Function dcCloseHandle Lib "kernel32" Alias "CloseHandle" (ByVal hObject As Long) As LongPrivate Declare Function dcGetExitCodeProcess Lib "kernel32" Alias "GetExitCodeProcess" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function dcTerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As LongPrivate Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Const WAIT_TIMEOUT As Long = &H102''用于结束外部进程,hCloseWnd 是要结束的程序的主窗口的 HWND
Public Function TerminateProcessByHWND(ByVal hCloseWnd As Long) As Boolean
'Dim hProcessID As Long
'Dim hProcess As Long
'On Error GoTo PROC_EXIT
'If hCloseWnd = 0 Then GoTo PROC_EXIT
'If GetWindowThreadProcessId(hCloseWnd, hProcessID) = 0 Then GoTo PROC_EXIT
'hProcess = OpenProcess(PROCESS_TERMINATE, False, hProcessID)
'If hProcess = 0 Then GoTo PROC_EXIT
If TerminateProcess(hCloseWnd, 0&) = 0 Then GoTo PROC_EXIT
TerminateProcessByHWND = True
PROC_EXIT:
If Err.Number <> 0 Then
Debug.Print Err.Description
Err.Clear
End If
End Function
Public Function ExecCmd(cmdline$) As Long
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ret As Long
Dim enAllFail As Long
On Error GoTo errExit
' Initialize the STARTUPINFO structure:
start.cb = Len(start)
' Start the shelled application:
ret = dcCreateProcess(0&, cmdline$, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
' Wait for the shelled application to finish:
'ret = dcWaitForSingleObject(proc.hProcess, INFINITE)
'If ret = WAIT_TIMEOUT Then
'After 15 min program may be hung?
' Call dcTerminateProcess(proc.hProcess, enAllFail)
'End If
'Call dcGetExitCodeProcess(proc.hProcess, ret&)
'Call dcCloseHandle(proc.hProcess)
'ExecCmd = ret&
ExecCmd = proc.hProcess
Exit Function
errExit:
'Error handler here
End Function
Private Sub Command1_Click()
Dim h As Long
h = ExecCmd("notepad.exe")
Dim s As Double
s = Timer
Do
DoEvents
Loop While Timer - s < 5
TerminateProcessByHWND h
End Sub