General information
Category:
Internet applications
Title:
Code translation in VFP
this VB code detect internet explorer and close it.
please translate it from VB to VFP.
thank you
MODULE
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize 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 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 strModuleName 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
Private Declare Function ProcessFirst _
Lib "kernel32" Alias "Process32First" (ByVal hSnapshot _
As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" _
Alias "Process32Next" (ByVal hSnapshot As Long, _
uProcess As PROCESSENTRY32) As Long
Private Declare Function CreateToolhelpSnapshot _
Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal _
lFlags As Long, lProcessID As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject 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
Public Const PROCESS_QUERY_INFORMATION = 1024
Public Const PROCESS_VM_READ = 16
Private Const MAX_PATH = 260
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
'STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public Const TH32CS_SNAPPROCESS = &H2&
Public Const hNull = 0
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szexeFile As String * 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 Enum ePlatform
eWin95_98 = 1
eWinNT = 2
End Enum
Public gDBType As String
'Code wrote by Serge DYMKOV.
Public Function IsApplicationRunning(pEXEName As String) As Boolean
On Error Resume Next
Select Case getVersion()
Case eWin95_98
Dim lProc As Long, strName As String
Dim hSnap As Long, proc As PROCESSENTRY32
hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If hSnap = hNull Then Exit Function
proc.dwSize = Len(proc)
' Iterate through the processes
lProc = Process32First(hSnap, proc)
Do While lProc
strName = StrZToStr(proc.szexeFile)
If InStr(UCase(strName), UCase(pEXEName)) Then
IsApplicationRunning = True
Exit Function
End If
lProc = Process32Next(hSnap, proc)
Loop
Case eWinNT
Dim Result As String
Result = MsgBox("The KillApp function doesn't work on Windows NT", vbExclamation, "Windows NT")
End Select
End Function
Function StrZToStr(pString As String) As String
StrZToStr = Left$(pString, Len(pString) - 1)
End Function
Public Function getVersion() As ePlatform
Dim osinfo As OSVERSIONINFO
Dim lRetVal As Integer
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
lRetVal = GetVersionExA(osinfo)
getVersion = osinfo.dwPlatformId
End Function
'Code wrote by Matthew GATES
Public Function KillApp(myName As String) As Boolean
Const PROCESS_ALL_ACCESS = 0
Const PROCESS_TERMINATE = 1
Dim uProcess As PROCESSENTRY32
Dim rProcessFound As Long
Dim hSnapshot As Long
Dim szExename As String
Dim exitCode As Long
Dim myProcess As Long
Dim AppKill As Boolean
Dim appCount As Integer
Dim i As Integer
On Local Error GoTo Finish
appCount = 0
Const TH32CS_SNAPPROCESS As Long = 2&
uProcess.dwSize = Len(uProcess)
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
rProcessFound = ProcessFirst(hSnapshot, uProcess)
Do While rProcessFound
i = InStr(1, uProcess.szexeFile, Chr(0))
szExename = LCase$(Left$(uProcess.szexeFile, i - 1))
If Right$(szExename, Len(myName)) = LCase$(myName) Then
KillApp = True
appCount = appCount + 1
myProcess = OpenProcess(PROCESS_TERMINATE, False, uProcess.th32ProcessID)
AppKill = TerminateProcess(myProcess, exitCode)
Call CloseHandle(myProcess)
End If
rProcessFound = ProcessNext(hSnapshot, uProcess)
Loop
Call CloseHandle(hSnapshot)
Finish:
End Function
'BUTTON
Private Sub Command1_Click()
Dim App As String
App = "C:\Program Files\Internet Explorer\iexplore.exe"
If IsApplicationRunning(App) Then
Call KillApp(App)
Else
MsgBox "Le logiciel n'est pas lancé !"
End If
End Sub
Next
Reply
View the map of this thread
View the map of this thread starting from this message only
View all messages of this thread
View all messages of this thread starting from this message only