/ Forside/ Teknologi / Udvikling / VB/Basic / Spørgsmål
Login
Glemt dit kodeord?
Brugernavn

Kodeord


Reklame
Top 10 brugere
VB/Basic
#NavnPoint
berpox 2425
pete 1435
CADmageren 1251
gibson 1230
Phylock 887
gandalf 836
AntonV 790
strarup 750
Benjamin... 700
10  tom.kise 610
Tjekke en aktiv proces?
Fra : crha
Vist : 704 gange
100 point
Dato : 08-08-05 00:40

Hejsa

Jeg har søgt hurtigt her på kandu og en masse på internettet, men har ikke fundet noget jeg helt har kunne bruge.
Jeg er igang med at udvikle et mini-program som skal kunne starte, lukke, genstarte ect. et program (en server). Da jeg skal lave en autostarter funktion hvis programmet går ned, skal jeg finde noget kode der fortæller om programmet kører.

Noget med at mit VB program tjekker om processen stadig kører, hvis ikke dette er tilfældet skal det starte programmet igen. Det er kun den del med at tjekke processen jeg mangler.

Jeg har fundet mange programmer derude med en liste over nuværende processer, men det er endnu ikke lykkedes mig at modificere den så den tjekker én bestemt proces bestemt af mig.

Et sidespørgsmål.. Er det muligt at gøre dette muligt over et netværk, så en person fra en anden computer kan starte, genstarte og lukke for serveren?

Jeg er lidt træt, så sig til hvis det er noget jeg har fomuleret dårligt =)

 
 
Kommentar
Fra : CADmageren


Dato : 08-08-05 08:30

Hej crha.

Jeg anbefale dig at downloade apiguiden - den bliver desværre ikke opdateret længere, men er guld værd.
http://www.mentalis.org/agnet/apiguide.shtml

Hvis det skal styres over netværket, findes der flere programmer til remote access - vi bruger et lille program som hedder dameware

/ Michael Christoffersen


Nedenstående er sakset fra ovenstående:
'Remark: 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 module

Public 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 Select

IsProcessRunning_Exit:

'Exit early to avoid error handler
Exit Function
Error_handler:
Err.Raise Err, Err.Source, "ProcessInfo", Error
Resume Next
End Function


Private Function getVersion() As Long

Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer

osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
getVersion = osinfo.dwPlatformId

End Function


Private Function StrZToStr(s As String) As String
StrZToStr = Left$(s, Len(s) - 1)
End Function



Public 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 = intElementCount

End 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



Kommentar
Fra : crha


Dato : 08-08-05 13:23

Takker for kommentaren, men det ser ud til at jeg ikke forstår at udnytte den.
Der sker intet når jeg afspiller koden, og prøver jeg at indsætte følgende i bunden af funktionen GetProcesses...

MsgBox lngReturn

...sker der det at den returnere tallet "1" hver gang, om så den valgte proces kører eller ej.
Kan du forklare mig hvordan jeg får dette til at virke? og måske er der endnu en lettere måde at gøre det på?

Kommentar
Fra : CADmageren


Dato : 08-08-05 13:45

Hej crha.


Find nedenstående linje i GetProcesses:
Debug.Print EXEName & "::" & CStr(pmc.WorkingSetSize / 1024)
Pt. skriver den bare til Immediate vinduet.

Ret funktionskaldet:
Public Function GetProcesses(ByVal EXEName As String) til
Public Function ProcesIsRunning(ByVal EXEName As String) as boolean.

Ret if then koden
If strProcName2 = EXEName Then ... End If til
If strProcName2 = EXEName Then ProcesIsRunning=True


Accepteret svar
Fra : CADmageren

Modtaget 100 point
Dato : 08-08-05 13:56

Public 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 ProcessIsRunning(ByVal EXEName As String) As Boolean
ProcessIsRunning = False

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
On Error GoTo Error_handler

booResult = False

EXEName = UCase$(Trim$(EXEName))
lngLength = Len(EXEName)
Select Case getVersion()
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
lngNumElements = lngCBSizeReturned / 4
For lngLoop = 1 To lngNumElements
DoEvents
lngHwndProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lngProcessIDs(lngLoop))

If lngHwndProcess <> 0 Then
lngReturn = EnumProcessModules(lngHwndProcess, lngModules(1), 200, lngCBSize2)
If lngReturn <> 0 Then
strModuleName = Space(MAX_PATH)
lngSize = 500
lngReturn = GetModuleFileNameExA(lngHwndProcess, lngModules(1), strModuleName, lngSize)
strProcessName = Left(strModuleName, lngReturn)
strProcessName = UCase$(Trim$(strProcessName))
strProcName2 = GetElement(Trim(Replace(strProcessName, Chr$(0), "")), "\", 0, 0, GetNumElements(Trim(Replace(strProcessName, Chr$(0), "")), "\") - 1)
If strProcName2 = EXEName Then ProcessIsRunning = True
End If
End If 'Close the handle to this process
lngReturn = CloseHandle(lngHwndProcess)
DoEvents
Next
End Select
IsProcessRunning_Exit:
Exit Function
Error_handler:
Err.Raise Err, Err.Source, "ProcessInfo", Error
Resume Next
End Function

Private Function getVersion() As Long

Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer

osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
getVersion = osinfo.dwPlatformId
End Function

Private Function StrZToStr(s As String) As String
StrZToStr = Left$(s, Len(s) - 1)
End Function

Public 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
strList = strList & strDelimiter
For lngCounter = 0 To lngColumn - 1
strList = Mid$(strList, InStr(strList, strDelimiter) + Len(strDelimiter), Len(strList))
If Len(strList) = 0 Then
GetElement = ""
Exit Function
End If
Next lngCounter
GetElement = Left$(strList, InStr(strList, strDelimiter) - 1)
End Function


Public Function GetNumElements(ByVal strList As String, ByVal strDelimiter As String) As Integer
Dim intElementCount As Integer
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
While InStr(strList, strDelimiter) > 0
intElementCount = intElementCount + 1
strList = Mid$(strList, InStr(strList, strDelimiter) + 1, Len(strList))
Wend
GetNumElements = intElementCount
End Function


Godkendelse af svar
Fra : crha


Dato : 08-08-05 16:38

Fantastisk, nu kører det søreme!

Tak for hjælpen.

Du har følgende muligheder
Eftersom du ikke er logget ind i systemet, kan du ikke skrive et indlæg til dette spørgsmål.

Hvis du ikke allerede er registreret, kan du gratis blive medlem, ved at trykke på "Bliv medlem" ude i menuen.
Søg
Reklame
Statistik
Spørgsmål : 177577
Tips : 31968
Nyheder : 719565
Indlæg : 6409071
Brugere : 218888

Månedens bedste
Årets bedste
Sidste års bedste