Kali ini kita hanya akan membuat suatu program yang berfungsi untuk mengetahui alamat/path suatu file yang sedang berjalan berdasarkan Process ID (PID) file tersebut, jika lebih kreaatif tentu nanti dapat ditambahkan fungsi-fungsi "Protector" lainnya misalkan menutup/close file, mendapatkan sign/tanda crc32 file tersebut atau juga dapat menghapus file tersebut dari konputer kita. Langsung saja ini source codenya...
Masukkan source code ini pada form..
Private Sub CmdRefresh_Click() LblIndexListProses.Caption = 0 Update Timer1.Enabled = True End Sub Private Sub Command1_Click() FrmAbout.Show End Sub Private Sub Form_Load() Update End Sub Private Sub Form_Unload(Cancel As Integer) End End Sub Private Sub ListProsesAktif_Click() LstIDProcess.Selected(ListProsesAktif.ListIndex) = True LstIDProcess.TopIndex = ListProsesAktif.TopIndex LstIDProcess.ListIndex = ListProsesAktif.ListIndex LblFileProcess.Caption = " " & PathByPID(LstIDProcess.Text) Dim tell As Long tell = ListProsesAktif.ListIndex + 1 LblIndexListProses.Caption = tell If Timer1.Enabled = False Then LstPathFile.Selected(ListProsesAktif.ListIndex) = True LstPathFile.TopIndex = ListProsesAktif.TopIndex LstPathFile.ListIndex = ListProsesAktif.ListIndex End If End Sub Private Sub ListProsesAktif_Scroll() LstIDProcess.TopIndex = ListProsesAktif.TopIndex LstPathFile.TopIndex = ListProsesAktif.TopIndex End Sub Private Sub LstIDProcess_Click() On Error Resume Next ListProsesAktif.Selected(LstIDProcess.ListIndex) = True ListProsesAktif.TopIndex = LstIDProcess.TopIndex ListProsesAktif.ListIndex = LstIDProcess.ListIndex End Sub Private Sub LstIDProcess_Scroll() ListProsesAktif.TopIndex = LstIDProcess.TopIndex End Sub Private Sub LstPathFile_Click() LstIDProcess.Selected(LstPathFile.ListIndex) = True LstIDProcess.TopIndex = LstPathFile.TopIndex LstIDProcess.ListIndex = LstPathFile.ListIndex LstPathFile.ToolTipText = LstPathFile.Text End Sub Private Sub Timer1_Timer() If Second(Now) Mod 1 = 0 Then If LblIndexListProses.Caption = 0 Then ListProsesAktif.Selected(LblIndexListProses.Caption) = True LblIndexListProses.Caption = LblIndexListProses.Caption + 1 ' otomatis index terseleksi LstPathFile.AddItem PathByPID(LstIDProcess.Text) Else ListProsesAktif.Selected(LblIndexListProses.Caption - 1) = True LblIndexListProses.Caption = LblIndexListProses.Caption + 1 LstPathFile.AddItem PathByPID(LstIDProcess.Text) End If If ListProsesAktif.Selected(LstIDProcess.NewIndex) = True Then Timer1.Enabled = False LstPathFile.Selected(ListProsesAktif.ListIndex) = True End If End If End Sub
Masukkan code ini pada module
Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID 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 'Enum the path Public Declare Function CloseHandle Lib "kernel32.dll" (ByVal hHandle As Long) As Long Const MAX_PATH As Integer = 260 Const TH32CS_SNAPALL = (&H1 Or &H2 Or &H4 Or &H8) Public Const PROCESS_QUERY_INFORMATION As Long = &H400 Public Const PROCESS_VM_READ = &H10 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 GetModuleFileNameExA Lib "psapi.dll" ( _ ByVal hProcess As Long, _ ByVal hModule As Long, _ ByVal ModuleName As String, _ ByVal nSize As Long) As Long Public 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 * 260 End Type Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Public Function Update() 'On Error Resume Next Dim hSnapshot As Long, uProcess As PROCESSENTRY32, R As Long FrmMain.ListProsesAktif.Clear FrmMain.LstIDProcess.Clear FrmMain.LstPathFile.Clear hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&) uProcess.dwSize = Len(uProcess) R = Process32First(hSnapshot, uProcess) Do While R FrmMain.ListProsesAktif.AddItem Left$(uProcess.szExeFile, IIf(InStr(1, uProcess.szExeFile, Chr$(0)) > 0, InStr(1, uProcess.szExeFile, Chr$(0)) - 1, 0)) FrmMain.ListProsesAktif.ItemData(FrmMain.ListProsesAktif.NewIndex) = uProcess.th32ProcessID FrmMain.LstIDProcess.AddItem (uProcess.th32ProcessID) R = Process32Next(hSnapshot, uProcess) FrmMain.TxtSumProcess.Caption = FrmMain.ListProsesAktif.ListCount & " Win Process" Loop CloseHandle hSnapshot End Function Public Function PathByPID(pid As Long) As String 'Fungsi ini berfungsi untuk mendapatkan informasi tentang aplikasi yang sedang 'berjalan dengan menggunakan Process ID masing-masing aplikasi '---- 'Kode ini dapat dilihat di : 'http://support.microsoft.com/default.aspx?scid=kb;en-us;187913 On Error Resume Next Dim cbNeeded As Long Dim Modules(1 To 200) As Long Dim ret As Long Dim ModuleName As String Dim nSize As Long Dim hProcess As Long hProcess = OpenProcess(PROCESS_QUERY_INFORMATION _ Or PROCESS_VM_READ, 0, pid) If hProcess <> 0 Then ret = EnumProcessModules(hProcess, Modules(1), _ 200, cbNeeded) If ret <> 0 Then ModuleName = Space(MAX_PATH) nSize = 500 ret = GetModuleFileNameExA(hProcess, _ Modules(1), ModuleName, nSize) PathByPID = Left(ModuleName, ret) End If End If ret = CloseHandle(hProcess) If PathByPID = "" Then PathByPID = "FILE WINDOWS" End If If Left(PathByPID, 4) = "\??\" Then PathByPID = "FILE WINDOWS" End If If Left(PathByPID, 12) = "\SystemRoot\" Then PathByPID = "FILE WINDOWS" End If FrmMain.ListProsesAktif.Selected(ListProsesAktif.NewIndex) = True End Function
Semoga bermanfaat
Download PathWinProccess
0 komentar:
Posting Komentar