Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Temmuz 2010 Salı

Windows Görev Yöneticisi [Windows Task Manager]


'UserForm1

'A) Windows XP® Office 2003® Normal Referance List

'Description: Visual Basic For Applications, FullPath: C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE
'Description: OLE Automation, FullPath: C:\WINDOWS\system32\stdole2.tlb
'Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'Description: Microsoft Forms 2.0 Object Library, FullPath: C:\WINDOWS\system32\FM20.DLL

'B) UserForm a eklenecek (Tools) araçlar

'Image1, Label1, Label2, CommandButton1
'Label3, Label4, Label5, Label6
'ListBox1

Private Sorgu As Variant
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD®] Windows Görev Yöneticisi [Windows Task Manager] "
Call EkranDüzenle
Call Preses_Listesi_Düzenle

End Sub
Private Sub CommandButton1_Click()

On Error Resume Next
Sorgu = MsgBox(ListBox1.List(ListBox1.ListIndex) & vbCrLf & "İşleme devam etmek istiyor musunuz?", vbQuestion + vbYesNo, "[PBİD®] Windows Görev Yöneticisi [Task Manager] Liste Yönetimi")
If Sorgu = vbYes Then KillProcessById ListBox1.List(ListBox1.ListIndex, 1)
Call Preses_Listesi_Düzenle

End Sub
Private Sub EkranDüzenle()

On Error Resume Next
With Me

.Height = 318
.Width = 436
.BackColor = vbWhite
'.Picture = LoadPicture("C:\...\*.bmp")
.Picture = Resim(URL1)
.PictureAlignment = fmPictureAlignmentTopLeft
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
With Image1

.BackStyle = fmBackStyleTransparent
.BorderColor = &HFF0000
.BorderStyle = fmBorderStyleSingle
.Top = 6
.Left = 6
.Height = 24
.Width = 24
'.Picture = LoadPicture("C:\...\PBİD.ico")
.Picture = Resim(URL2)

End With
With Label1

.Caption = " " & "Mustafa ULUSARAÇ"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Left = 30
.Top = 6
.Height = 12
.Width = 270
.Font.Bold = True
.ForeColor = &HFF0000

End With
With Label2

.Caption = " " & "01ulusarac@superonline.com"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Left = 30
.Top = 18
.Height = 12
.Width = 270
.Font.Bold = True
.ForeColor = &HFF0000

End With
With Label3

.Caption = " " & "Program Adı"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.Left = 6
.Top = 36
.Height = 12
.Width = 204
.Font.Bold = True
.ForeColor = &H808000

End With
With Label4

.Caption = " " & "ProcessID"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.Left = 210
.Top = 36
.Height = 12
.Width = 66
.Font.Bold = True
.ForeColor = &H808000

End With
With Label5

.Caption = " " & "Threads"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.Left = 276
.Top = 36
.Height = 12
.Width = 66
.Font.Bold = True
.ForeColor = &H808000

End With
With Label6

.Caption = " " & "ParentProcessID"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.Left = 342
.Top = 36
.Height = 12
.Width = 84
.Font.Bold = True
.ForeColor = &H808000

End With
With ListBox1

.Left = 6
.Top = 48
.Height = 239.25
.Width = 419.25
.SpecialEffect = fmSpecialEffectEtched
.BackColor = vbWhite
.MultiSelect = fmMultiSelectSingle
.ForeColor = &H808000
.ColumnCount = 4
.ColumnWidths = "204;66;66;84"

End With
With CommandButton1

.Top = 6
.Width = 114
.Left = 312
.Height = 24
.Caption = "Seçilmili Programı Kapat"
.Font.Bold = True
.ForeColor = &H808000

End With

End With

End Sub

'Module1


'Option explicit
'Load Picture API's
Public Declare Function CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As Long, lpCLSID As Any) As Long
Public Declare Function OleLoadPicturePath Lib "oleaut32" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As Any, ByRef ppvRet As Any) As Long
Public IPic(15) As Byte
Public Const ClsID As Variant = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}" 'It may take a few seconds, please wait.
Public URL As String
Public Const URL1 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S7rn6KHVfNI/AAAAAAAACRs/fxVMg9YGzb4/s1600/VectorBackround.jpg" 'Microsoft Office Excel® Kod Kılavuzu [UserFormBackround]
Public Const URL2 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S78EbvJyhRI/AAAAAAAACS0/txbOQ1qubg8/s1600/PB%C4%B0D_jpg.jpg" 'Microsoft Office Excel® Kod Kılavuzu [PBİD Icon]
'Task Maneger API's
Public Declare Function RegisterServiceProcess Lib "kernel32" (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As Long
Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Const MAX_PATH& = 260
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
Private Prosesler As PROCESSENTRY32 'uProcess
Private Const PROCESS_ALL_ACCESS = 0
Private BulunanProses As Long
Private Anİçindeki As Long 'hSnapshot
Private UygulamaAdıBoyu As String
Private KapanmaKodları As Long 'exitCode
Private SeçilenProses As Long
Private APPSilmek As Boolean
Private UygulamaSayısı As Integer
Private BakılanProses&
Private i As Integer
Private No As Double
Sub FormAç() 'Open UserForm

On Error Resume Next
UserForm1.Show 0

End Sub
Public Function Resim(URL) As Picture 'Picture load frome web address...

On Error Resume Next
CLSIDFromString StrPtr(ClsID), IPic(0)
OleLoadPicturePath StrPtr(URL), 0&, 0&, 0&, IPic(0), Resim

End Function
Public Function Preses_Listesi_Düzenle()

On Local Error GoTo Hata
UygulamaSayısı = 0
Const TH32CS_SNAPPROCESS As Long = 2&
Prosesler.dwSize = Len(Prosesler)
Anİçindeki = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
BulunanProses = ProcessFirst(Anİçindeki, Prosesler)
UserForm1.ListBox1.Clear
No = 0
Do While BulunanProses

i = VBA.InStr(1, Prosesler.szexeFile, Chr(0))
UygulamaAdıBoyu = VBA.Left$(Prosesler.szexeFile, i - 1)
UserForm1.ListBox1.AddItem (UygulamaAdıBoyu)
UserForm1.ListBox1.List(No, 1) = (Prosesler.th32ProcessID)
UserForm1.ListBox1.List(No, 2) = (Prosesler.cntThreads)
UserForm1.ListBox1.List(No, 3) = (Prosesler.th32ParentProcessID)
No = No + 1
If VBA.Right$(UygulamaAdıBoyu, VBA.Len(myName)) = VBA.LCase$(myName) Then

Preses_Listesi_Düzenle = True
UygulamaSayısı = UygulamaSayısı + 1
SeçilenProses = OpenProcess(PROCESS_ALL_ACCESS, False, Prosesler.th32ProcessID) APPSilmek = TerminateProcess(SeçilenProses, KapanmaKodları)
Call CloseHandle(SeçilenProses)

End If
BulunanProses = ProcessNext(Anİçindeki, Prosesler)

Loop
Call CloseHandle(Anİçindeki)
Hata:

End Function
Public Sub ProsesKapatıcı(ProcessID As Long)

BakılanProses& = OpenProcess(1&, -1&, ProcessID)
TerminateProcess BakılanProses&, 0&

End Sub

Hiç yorum yok:

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul