Langsung Ke Tutor Dan Sourcenya
••Siapkan 1 Buah Form
1 Buah Module
2 Buah Class Module
Name Form "FrmProccess"
Name Module "ModMem"
Name Class Module -"clsGetIcon"
-"clsScanProc"
••Form 1 Components
" • 1 Buah Timer (Interval = '1000')
• 3 Buah Command Button (Name = 'CmdTerminate, CmdRefresh, CmdExplore')
• 1 Buah ListView "Caranya Klik Menu Project Lalu Pilih Components Atau Ctrl+T >> Lalu Cari Microsoft Windows Common controls 6.0 (SP6) >> centang dan klik apply lalu ok"
• Beberapa Label Untuk Memory Status
Diantaranya
- Total Physical Memory (Name = "LabelName" Caption = "")
- Free Physical Memory (Name = "LabelName" Caption = "")
- Used Memory (Name = "LabelName" Caption = "")
- Free Memory (Name = "LabelName" Caption = "")
- Total Page File (Name = "LabelName" Caption = "")
- Free Page File (Name = "LabelName" Caption = "")
- Total Virtual Memory (Name = "LabelName" Caption = "")
- Free Virtual Memory (Name = "LabelName" Caption = "")
• Lalu Di Sisinya Sisipkan Lagi 8 Buah Label Tanpa Caption Dengan Name Label 1 sampai Label8
• 2 Buah Check
• Terakhir Buat Sebuah Menu
File (Name = "MnFile")
...Exit (Name = "MnExit")
Action (Name = "MnAct")
...End Proccess Selected (Name = "MnTerminate)
'#######••Lalu Coding Ini Di Form••#######'
'Watch this area here--^ ...it contains all the form objects that supports events
Dim WithEvents SCANPROC As ClsScanProc
'Take note of the declaration above!!!
Private Declare Function LockWindowUpdate Lib "user32.dll" (ByVal hwndLock As Long) As Long
Dim m_sProcess As String
Dim m_sTime As Single
Dim FILEICON As ClsGetIcon
'##################################################################################
Private Sub cmdrefresh_Click()
Call Check1_Click
End Sub
Private Sub Cmdterminate_Click()
PopupMenu MnAct
End Sub
Private Sub Cmdexplore_Click()
Shell "Explorer.exe " & Left(ListView1.SelectedItem.SubItems(1), _
Len(ListView1.SelectedItem.SubItems(1)) - Len(ListView1.SelectedItem)), _
vbNormalFocus
End Sub
Private Sub ListView1_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
If Button = 2 Then PopupMenu mnMenu
End Sub
Private Sub MnExit_Click()
Unload Me
End Sub
Private Sub MnTerminate_Click()
If MsgBox("Yakin Untuk Membunuh Proses terpilih ini ??", vbExclamation + vbYesNoCancel + vbDefaultButton2, "Terminate Process") = vbYes Then
If (SCANPROC.TerminateProcess(ListView1.SelectedItem.SubItems(2)) = True) Then
Call Check1_Click
End If
End If
End Sub
Private Sub SCANPROC_CurrentModule(Process As String, ID As Long, Module As String, File As String)
' Tips: You can perform checksum checks here indiviually for each file...
Dim lsv As ListItem
Set lsv = ListView1.ListItems.Add(, , Module)
With lsv
.ForeColor = RGB(0, 150, 0) ' Dark green
.SubItems(1) = File
.ListSubItems(1).ToolTipText = File
' .Selected = True
' .EnsureVisible
End With
End Sub
Private Sub SCANPROC_CurrentProcess(Name As String, File As String, ID As Long, Modules As Long)
' Tips: You can perform checksum checks here indiviually for each file...
Dim p_HasImage As Boolean
If (File <> "SYSTEM") Then
On Error Resume Next
ImageList1.ListImages(Name).Tag = "" 'Just to test if this item exists
If (Err.Number <> 0) Then
Err.Clear
ImageList1.ListImages.Add , Name, FILEICON.Icon(File, SmallIcon)
p_HasImage = (Err.Number = 0)
Else
p_HasImage = True
End If
End If
Dim lsv As ListItem
If (p_HasImage = True) Then
Set lsv = ListView1.ListItems.Add(, "#" & Name & ID, Name, , Name)
Else
Set lsv = ListView1.ListItems.Add(, "#" & Name & ID, Name)
End If
With lsv
.ForeColor = vbBlue
.SubItems(1) = File
.SubItems(2) = ID
.SubItems(3) = Modules
.ListSubItems(2).ForeColor = vbRed
.ListSubItems(1).ToolTipText = File
' .Selected = True
' .EnsureVisible
End With
If (m_sProcess <> "#" & Name & ID) Then
Modules = 0
End If
End Sub
Private Sub SCANPROC_DoneScanning(TotalProcess As Long)
Dim p_Elapsed As Single
p_Elapsed = Timer - m_sTime
LockWindowUpdate 0& ' Enable listview repaint
'Debug.Print "Total Number of Process Detected: " & TotalProcess & vbNewLine & "Total Scan Time: " & p_Elapsed & vbNewLine
NUMPROC = TotalProcess
End Sub
'##################################################################################
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
If (Check2.Value <> vbChecked) Then
'PopupMenu mnEx 'If Button = 2 Then PopupMenu mnEx
Exit Sub ' What for?
End If
Dim i As Long
i = Item.Index
If (m_sProcess = Item.Key) Then
m_sProcess = ""
Else
m_sProcess = Item.Key
End If
Call Check1_Click
On Error Resume Next
ListView1.ListItems(i).Selected = True
ListView1.SelectedItem.EnsureVisible
End Sub
Private Sub Check1_Click()
ListView1.ListItems.Clear
SCANPROC.SystemProcesses = (Check1.Value = vbChecked)
SCANPROC.ProcessModules = (Check2.Value = vbChecked)
m_sTime = Timer
LockWindowUpdate ListView1.hWnd ' Prevent listview repaints
SCANPROC.BeginScanning
End Sub
Private Sub Check2_Click()
If (Check2.Value = vbChecked) Then
Command2.Caption = "Refresh"
Else
Command2.Caption = "Refresh"
End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If (KeyAscii = vbKeyEscape) Then
SCANPROC.CancelScanning
Unload Me
End If
End Sub
Private Sub Form_Load()
Set SCANPROC = New ClsScanProc
Set FILEICON = New ClsGetIcon
Call Check1_Click
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set SCANPROC = Nothing
Set FILEICON = Nothing
End Sub
Private Sub Timer1_Timer()
Dim mem As MEMORYSTATUS
GlobalMemoryStatus mem
Dim tot, free
ModMem.getfreemem tot, free
Label1.Caption = Round(mem.dwTotalPhys / 1024 / 1024, 2) & " MB"
Label2.Caption = Round(mem.dwAvailPhys / 1024 / 1024, 2) & " MB"
Label3.Caption = Round((tot - free) / 1024 / 1024, 2) & " MB Used [" & Round(((tot - free) / tot) * 100, 2) & "%]"
Label8.Caption = Round(free / 1024 / 1024, 2) & " MB Free [" & Round((free / tot) * 100, 2) & "%]"
Label4.Caption = Round(mem.dwTotalPageFile / 1024 / 1024, 2)
Label5.Caption = Round(mem.dwAvailPageFile / 1024 / 1024, 2)
Label6.Caption = Round(mem.dwTotalVirtual / 1024 / 1024, 2)
Label7.Caption = Round(mem.dwAvailVirtual / 1024 / 1024, 2)
End Sub
'#######••Selesai Coding Form••#######
'######Sekarang Coding Di Module (ModMem)######
Option Explicit
Public Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Public 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
Public Function getfreemem(ByRef Total As Variant, ByRef free As Variant)
'Returns total as totlaphysicalmem(in KB)
'Returns free as freephysicalmem(in KB)
Dim mem As MEMORYSTATUS
GlobalMemoryStatus mem
free = mem.dwAvailPhys
Total = mem.dwTotalPhys
End Function
'######Selesai Disini Coding ModMem######
Nah Sekarang Tinggal Sisipkan Code Berikut Di Class Module
'###### Coding ClassModule (clsGetIcon)
' Modified API Declaration
Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Sub OleCreatePictureIndirect Lib "oleaut32.dll" (ByRef lpPictDesc As PictDesc, ByRef riid As Guid, ByVal fOwn As Long, ByRef lplpvObj As IPictureDisp)
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, ByRef psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As ESHGetFileInfoFlagConstants) As Long
' API Constants
Private Const ERRORAPI As Long = 0
Private Const MAX_PATH As Long = 260
' API Types
Private Type Guid
Data1 As Long
data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type PictDesc
cbSizeofStruct As Long
picType As Long
hImage As Long
xExt As Long
yExt As Long
End Type
Private Type SHFILEINFO
hIcon As Long ' : icon
iIcon As Long ' : icondex
dwAttributes As Long ' : SFGAO_ flags
szDisplayName As String * MAX_PATH ' : display name (or path)
szTypeName As String * 80 ' : type name
End Type
'User-Defined API Enum
Private Enum ESHGetFileInfoFlagConstants
SHGFI_ATTRIBUTES = &H800 ' get file attributes
SHGFI_DISPLAYNAME = &H200 ' get display name
SHGFI_EXETYPE = &H2000 ' get exe type
SHGFI_ICON = &H100 ' get icon handle and index
SHGFI_LARGEICON = &H0 ' get file's large icon
SHGFI_LINKOVERLAY = &H8000 ' add link overlay on the icon
SHGFI_OPENICON = &H2 ' get file's open icon
SHGFI_SELECTED = &H10000 ' blend icon with the system highlight color
SHGFI_SHELLICONSIZE = &H4 ' get shell-sized icon
SHGFI_SMALLICON = &H1 ' get file's small icon
SHGFI_SYSICONINDEX = &H4000 ' get icon index from system image list
SHGFI_TYPENAME = &H400 ' get file type description
SHGFI_USEFILEATTRIBUTES = &H10 ' use dwFileAttributes parameter
End Enum
Public Enum EFileIconTypes
LargeIcon = 0
SmallIcon = 1
End Enum
Public Enum EFileExeTypes
MSDosApp = 2 ' MS-DOS .EXE, .COM or .BAT file
NonExecutable = 0 ' Nonexecutable file or an error condition
Win32Console = 3 ' Win32 console application
WindowsApp = 1 ' Windows application
End Enum
' Variable Declarations
Private m_bOpenState As Boolean
Private m_bOverlay As Boolean
Private m_bSelected As Boolean
Private m_eIconType As EFileIconTypes
Private m_lHandle As Long
Private m_sFile As String
' //-- Properties --//
Public Property Get DisplayName(Optional File) As String
'Returns the display name of the specified file.
Dim p_Ret As Long
Dim p_SHFI As SHFILEINFO
If (IsMissing(File)) Then
File = m_sFile
End If
p_Ret = SHGetFileInfo(CStr(File), 0&, p_SHFI, Len(p_SHFI), SHGFI_DISPLAYNAME)
If (p_Ret <> ERRORAPI) Then
DisplayName = p_SHFI.szDisplayName
DisplayName = Left$(DisplayName, lstrlen(DisplayName))
End If
End Property
Public Property Get ExeType(Optional File) As EFileExeTypes
'Returns the display name of the specified file.
Dim p_Ret As Long
Dim p_SHFI As SHFILEINFO
If (IsMissing(File)) Then
File = m_sFile
End If
p_Ret = SHGetFileInfo(CStr(File), 0&, p_SHFI, Len(p_SHFI), SHGFI_EXETYPE)
If (p_Ret <> ERRORAPI) Then
If (HiWord(p_Ret) > 0) Then ' NE 0x00004E45 or PE 0x00005045
ExeType = WindowsApp
Else
Select Case LoWord(p_Ret)
Case 23117 ' MZ 0x00004D5A
ExeType = MSDosApp
Case 17744 ' PE 0x00005045
ExeType = Win32Console
End Select
End If
End If
End Property
Public Property Get File() As String
'Returns/sets the complete file path to be used.
File = m_sFile
End Property
Public Property Let File(Value As String)
m_sFile = Value
End Property
Public Property Get Handle() As Long
'Returns/sets the icon handle to be used by the IconEx property.
Handle = m_lHandle
End Property
Public Property Let Handle(Value As Long)
m_lHandle = Value
End Property
Public Property Get IconType() As EFileIconTypes
'Returns/sets the type of icon to retrieve.
IconType = m_eIconType
End Property
Public Property Let IconType(Value As EFileIconTypes)
m_eIconType = Value
End Property
Public Property Get Icon(Optional File, Optional IconType) As IPictureDisp
'Returns the icon of the specified file.
If (IsMissing(File)) Then
File = m_sFile
End If
If (IsMissing(IconType)) Then
IconType = m_eIconType
End If
Dim p_Flags As ESHGetFileInfoFlagConstants
Dim p_hIcon As Long
Dim p_Ret As Long
Dim p_SHFI As SHFILEINFO
If (m_eIconType = LargeIcon) Then
p_Flags = SHGFI_ICON Or SHGFI_LARGEICON
Else
p_Flags = SHGFI_ICON Or SHGFI_SMALLICON
End If
If (m_bOverlay) Then
p_Flags = p_Flags Or SHGFI_LINKOVERLAY
End If
If (m_bSelected) Then
p_Flags = p_Flags Or SHGFI_SELECTED
Else
p_Flags = p_Flags And Not SHGFI_SELECTED
End If
If (m_bOpenState) Then
p_Flags = p_Flags Or SHGFI_OPENICON
Else
p_Flags = p_Flags And Not SHGFI_OPENICON
End If
p_Ret = SHGetFileInfo(CStr(File), 0&, p_SHFI, Len(p_SHFI), p_Flags)
If (p_Ret <> ERRORAPI) Then
p_hIcon = p_SHFI.hIcon
If (p_hIcon) Then
Set Icon = IconEx(p_hIcon)
End If
End If
End Property
Public Property Get IconEx(Optional hIcon As Long) As IPictureDisp
'Returns the file's icon using the specified icon handle.
If (hIcon = 0) Then
hIcon = m_lHandle
If (hIcon = 0) Then
Exit Property
End If
End If
Dim p_Picture As IPictureDisp
Dim p_PicDesc As PictDesc
Dim p_Guid As Guid
p_PicDesc.cbSizeofStruct = Len(p_PicDesc)
p_PicDesc.picType = vbPicTypeIcon
p_PicDesc.hImage = hIcon
' IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
With p_Guid
.Data1 = &H7BF80980
.data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With
' From vbAccelerator... (http://www.vbaccelerator.com)
OleCreatePictureIndirect p_PicDesc, p_Guid, True, p_Picture
Set IconEx = p_Picture
End Property
Public Property Get LinkOverlay() As Boolean
'Returns/sets a value to determine if a linkoverlay icon is displayed on the icon.
LinkOverlay = m_bOverlay
End Property
Public Property Let LinkOverlay(Value As Boolean)
m_bOverlay = Value
End Property
Public Property Get OpenState() As Boolean
'Returns/sets a value to determine if the icon will be in open state. (Ex. Folders)
OpenState = m_bOpenState
End Property
Public Property Let OpenState(Value As Boolean)
m_bOpenState = Value
End Property
Public Property Get Selected() As Boolean
'Returns/sets a value to determine if the icon is in selected state.
Selected = m_bSelected
End Property
Public Property Let Selected(Value As Boolean)
m_bSelected = Value
End Property
Public Property Get TypeName(Optional File) As String
'Returns the type name of the specified file.
Dim p_Ret As Long
Dim p_SHFI As SHFILEINFO
If (IsMissing(File)) Then
File = m_sFile
End If
p_Ret = SHGetFileInfo(CStr(File), 0&, p_SHFI, Len(p_SHFI), SHGFI_TYPENAME)
If (p_Ret <> ERRORAPI) Then
TypeName = p_SHFI.szTypeName
TypeName = Left$(TypeName, lstrlen(TypeName))
End If
End Property
' //-- Private properties --//
Private Property Get HiWord(DWord As Long) As Long
HiWord = (DWord And &HFFFF0000) \ &H10000
End Property
Private Property Get LoWord(DWord As Long) As Long
If (DWord And &H8000&) Then
LoWord = DWord Or &HFFFF0000
Else
LoWord = DWord And &HFFFF&
End If
End Property
' Created by Noel A. Dacara | Copyright © 2003-2005 Davao City, Philippines
'######Selesai Disini######
'######Coding (clsScanProc)######
' API Declarations
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32.dll" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function EnumProcesses Lib "psapi.dll" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef lpcbNeeded As Long) As Long
Private Declare Function FormatMessage Lib "kernel32.dll" Alias "FormatMessageA" (ByVal dwFlags As Long, ByRef lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, ByRef Arguments As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long
Private Declare Function GetModuleBaseName Lib "psapi.dll" Alias "GetModuleBaseNameA" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpBaseName As String, ByVal nSize As Long) As Long
Private Declare Function GetModuleFileNameEx Lib "psapi.dll" Alias "GetModuleFileNameExA" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFilename As String, ByVal nSize As Long) As Long
Private Declare Function GetQueueStatus Lib "user32.dll" (ByVal fuFlags As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32.dll" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, ByRef TokenHandle As Long) As Long
Private Declare Function Process32First Lib "kernel32.dll" (ByVal hSnapshot As Long, ByRef lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32.dll" (ByVal hSnapshot As Long, ByRef lppe As PROCESSENTRY32) As Long
' Modified API Declaration
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, ByRef NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, ByVal PreviousState As Long, ByVal ReturnLength As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, ByRef lpLuid As LUID) As Long
Private Declare Function TerminateProcess32 Lib "kernel32.dll" Alias "TerminateProcess" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
' API Constants
Private Const ANYSIZE_ARRAY As Long = 1
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
Private Const MAX_DESCRIPTION As Long = 1024
Private Const MAX_MODULE_NAME32 As Long = 255
Private Const MAX_PATH As Long = 260
Private Const PROCESS_QUERY_INFORMATION As Long = (&H400)
Private Const PROCESS_VM_READ As Long = (&H10)
Private Const SE_DEBUG_NAME As String = "SeDebugPrivilege"
Private Const SE_PRIVILEGE_ENABLED As Long = &H2
Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Private Const SYNCHRONIZE As Long = &H100000
Private Const TH32CS_SNAPPROCESS As Long = &H2
Private Const TOKEN_ADJUST_PRIVILEGES As Long = &H20
Private Const TOKEN_QUERY As Long = &H8
Private Const PROCESS_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)
Private Const VER_PLATFORM_WIN32_NT As Long = 2
'GetQueueStatus Flag
Private Const QS_ALLEVENTS As Long = &HBF
' API Types
Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type
Private Type LUID
lowpart As Long
highpart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string for PSS usage
End Type
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
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
' Variable Declarations
Private m_bCancel As Boolean
Private m_bErrorOnFail As Boolean
Private m_bOldMethod As Boolean
Private m_bPaused As Boolean
Private m_bProcModules As Boolean
Private m_bScanning As Boolean
Private m_bSystemProc As Boolean
Private m_bTerminated As Boolean
Private m_lNumProcess As Long
Private m_lProcessID As Long
Private m_lWinPlatform As Long
' //-- Class Events --//
Public Event CurrentModule(Process As String, ID As Long, Module As String, File As String)
'Occurs everytime a process is scanned for modules.
Public Event CurrentProcess(Name As String, File As String, ID As Long, Modules As Long)
'Occurs everytime a process is scanned.
Public Event DoneScanning(TotalProcess As Long)
'Occures after scanning all processes.
#If False Then
' Trick to preserve casing of these variables when used in VB IDE
Private Process, Module, File, Name, Path, ID, Modules, TotalProcess
#End If
' //-- Properties --//
Public Property Get ErrorOnFail() As Boolean
'Returns/sets whether to raise an error if process termination fails.
ErrorOnFail = m_bErrorOnFail
End Property
Public Property Let ErrorOnFail(Value As Boolean)
m_bErrorOnFail = Value
End Property
Public Property Get ForceOldMethod() As Boolean
'Force to use the older method of enumerating processes for newer Windows systems.
ForceOldMethod = m_bOldMethod
End Property
Public Property Let ForceOldMethod(Value As Boolean)
m_bOldMethod = Value
End Property
Public Property Get ProcessModules() As Boolean
'Scan for modules(dll,ocx,etc..) used by a process other than its main executable.
ProcessModules = m_bProcModules
End Property
Public Property Let ProcessModules(Value As Boolean)
m_bProcModules = Value
End Property
Public Property Get ProcessTerminated() As Boolean
'Returns the boolean result for a process terminated in the class event.
ProcessTerminated = m_bTerminated
End Property
Public Property Get Scanning() As Boolean
'Returns True if class is currently on scanning state.
Scanning = m_bScanning
End Property
Public Property Get SystemProcesses() As Boolean
'Returns/sets whether to include scanning for system processes.
SystemProcesses = m_bSystemProc
End Property
Public Property Let SystemProcesses(Value As Boolean)
m_bSystemProc = Value
End Property
Public Property Get TotalProcesses() As Integer
'Returns the current or the total number of processes scanned.
TotalProcesses = m_lNumProcess
End Property
' //-- Procedures --//
Public Sub BeginScanning()
'Start scanning for running processes in the system.
If (m_bPaused) Then
ResumeScanning ' Resume scanning instead
Exit Sub
End If
If (m_bScanning) Then
Exit Sub ' avoid cascading scans
End If
m_bCancel = False
m_lNumProcess = 0
m_bScanning = True
ScanForProcesses ' scan the system for running processes
m_bScanning = False
m_lProcessID = -1
RaiseEvent DoneScanning(m_lNumProcess)
End Sub
Public Sub CancelScanning()
'Abort scanning for running processes.
m_bCancel = True
ResumeScanning ' Resume if scanning has been paused
End Sub
Public Sub PauseScanning()
'Temporarily stop scanning process.
If (m_bScanning) Then
m_bPaused = True
End If
End Sub
Public Sub ResumeScanning()
'Resume paused scanning process.
If (m_bPaused) Then
m_bPaused = False
End If
End Sub
Public Function TerminateProcess(Optional lProcessID As Long = -1) As Boolean
'Terminate a running process using the specified process ID.
If (lProcessID = -1) Then
lProcessID = m_lProcessID ' Get process ID of currently scanned process
' If process ID is not given, it will attempt to terminate the current process
If (lProcessID = -1) Then
Exit Function
End If
End If
Dim p_lProcess As Long
Dim p_lToken As Long
Dim p_tPrivileges As TOKEN_PRIVILEGES
' Windows NT/2000 requires special treatment to ensure that the
' calling process has enough privileges to perform the instruction.
If (m_lWinPlatform = VER_PLATFORM_WIN32_NT) Then
' Open token of the defined process
If (OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, p_lToken) = 0) Then
GoTo End_Function
End If
' Get LUID used to locally represent the specified privilege name
If (LookupPrivilegeValue("", SE_DEBUG_NAME, p_tPrivileges.Privileges(ANYSIZE_ARRAY).pLuid) = 0) Then
GoTo End_Function
End If
p_tPrivileges.PrivilegeCount = 1
p_tPrivileges.Privileges(ANYSIZE_ARRAY).Attributes = SE_PRIVILEGE_ENABLED
' Attempt to acquire debug privilege for the process
If (AdjustTokenPrivileges(p_lToken, 0&, p_tPrivileges, 0&, 0&, 0&) = 0) Then
GoTo End_Function
End If
End If
' Finally, open the defined process
p_lProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, lProcessID)
If (p_lProcess) Then
' Attempt to terminate the process
TerminateProcess = (TerminateProcess32(p_lProcess, 0&) <> 0)
CloseHandle p_lProcess
If (Not TerminateProcess) Then
If (m_bErrorOnFail) Then
Err.Raise Err.LastDllError, , ErrorDescription(Err.LastDllError)
End If
End If
If (GetQueueStatus(QS_ALLEVENTS)) Then ' check for events
DoEvents
End If
End If
If (m_lWinPlatform = VER_PLATFORM_WIN32_NT) Then
' Restore original privilege
p_tPrivileges.Privileges(ANYSIZE_ARRAY).Attributes = 0
AdjustTokenPrivileges p_lToken, 0&, p_tPrivileges, 0&, 0&, 0&
End_Function:
If (p_lToken) Then
CloseHandle p_lToken
End If
End If
End Function
' //-- Private Procedures --//
Private Sub DeepProcessScan(ID As Long, Name As String)
If (m_bCancel Or m_lWinPlatform <> VER_PLATFORM_WIN32_NT) Then
If (Not m_bCancel) Then
m_lNumProcess = m_lNumProcess + 1
RaiseEvent CurrentProcess(Name, "", ID, 1)
End If
Exit Sub ' Abort the whole scanning process
End If
Dim i As Long
Dim p_lModuleCount As Long
Dim p_lModules(1 To 1024) As Long
Dim p_lNeeded As Long
Dim p_lProcess As Long
Dim p_lRet As Long
Dim p_sBaseName As String
Dim p_sBuffer As String
Dim p_sProcessPath As String
p_lProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0&, ID)
If (p_lProcess) Then
p_lRet = EnumProcessModules(p_lProcess, p_lModules(1), 1024 * 4, p_lNeeded)
If (p_lRet) Then
p_lModuleCount = p_lNeeded \ 4
For i = 1 To p_lModuleCount
If (GetQueueStatus(QS_ALLEVENTS)) Then ' check for events
DoEvents ' processes system events
End If
If (m_bPaused) Then
m_bScanning = False
While (m_bPaused)
DoEvents ' Don't execute next instructions until resumed
Wend
m_bScanning = True
End If
If (m_bCancel) Then
Exit For ' attempt to abort the whole scanning process
End If
p_sBuffer = String$(MAX_MODULE_NAME32, 0)
p_lRet = GetModuleBaseName(p_lProcess, p_lModules(i), p_sBuffer, MAX_MODULE_NAME32)
If (p_lRet > 0) Then
p_sBaseName = Left$(p_sBuffer, p_lRet)
End If
p_sBuffer = String$(MAX_MODULE_NAME32, 0)
p_lRet = GetModuleFileNameEx(p_lProcess, p_lModules(i), p_sBuffer, MAX_MODULE_NAME32)
If (p_lRet > 0) Then
p_sProcessPath = Left$(p_sBuffer, p_lRet)
End If
ValidatePath p_sProcessPath
If (i = 1) Then
If (Len(p_sProcessPath) = 0) Then
' Consider as a system process if file path is empty
p_sProcessPath = "SYSTEM"
If (Not m_bSystemProc) Then
Exit For ' Excluding system processes
End If
End If
m_lNumProcess = m_lNumProcess + 1
RaiseEvent CurrentProcess(p_sBaseName, p_sProcessPath, ID, p_lModuleCount)
If (Not m_bProcModules) Or (p_lModuleCount = 0) Then
Exit For ' Dont scan preceding process modules
End If
Else
RaiseEvent CurrentModule(Name, ID, p_sBaseName, p_sProcessPath)
End If
Next
CloseHandle p_lProcess
Exit Sub
Else
If (Len(Name) = 0) And (ID) Then
Name = "System" ' Assume this is a system process
End If
End If
CloseHandle p_lProcess
End If
If (m_bSystemProc = True) Then
If (Len(Name) = 0) And (ID) Then
Name = "[System Process]" ' a.k.a "System Idle Process"
End If
m_lNumProcess = m_lNumProcess + 1
RaiseEvent CurrentProcess(Name, "SYSTEM", ID, 1)
End If
End Sub
Private Function ErrorDescription(nError As Long) As String
Dim p_lLen As Long
Dim p_sBuffer As String * MAX_DESCRIPTION
p_lLen = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, _
ByVal 0&, _
nError, _
0&, _
p_sBuffer, _
MAX_DESCRIPTION, _
0&)
If (p_lLen > 0) Then
ErrorDescription = Left$(p_sBuffer, p_lLen)
End If
End Function
Private Sub ScanForProcesses()
Dim p_eProcessEntry As PROCESSENTRY32
Dim p_lNeeded As Long
Dim p_lProcess As Long
Dim p_lProcesses() As Long
Dim p_lProcessID As Long
Dim p_lSnapshot As Long
Dim p_sExeFile As String
' Windows 2000/ME/XP or later
If (m_lWinPlatform = VER_PLATFORM_WIN32_NT) And (Not m_bOldMethod) Then
ReDim p_lProcesses(1 To 1024) As Long
If (EnumProcesses(p_lProcesses(1), 1024 * 4, p_lNeeded)) Then
p_lNeeded = p_lNeeded \ 4
For p_lProcess = 1 To p_lNeeded
If (m_bCancel) Then
Exit For
End If
DeepProcessScan p_lProcesses(p_lProcess), ""
Next
Exit Sub
Else
' Raise an error
Err.Raise Err.LastDllError, , ErrorDescription(Err.LastDllError)
' Then attempt to enumerate processes using the other way below
End If
End If
' Windows 95/98 (Old Method)
p_lSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
If (p_lSnapshot) Then
p_eProcessEntry.dwSize = Len(p_eProcessEntry)
p_lProcess = Process32First(p_lSnapshot, p_eProcessEntry)
Do While (p_lProcess) ' iterate through all processes
If (GetQueueStatus(QS_ALLEVENTS)) Then ' check for events
DoEvents ' processes system events
End If
If (m_bPaused) Then
m_bScanning = False
While (m_bPaused)
DoEvents ' Don't execute next instructions until resumed
Wend
m_bScanning = True
End If
If (m_bCancel) Then
Exit Do ' abort the whole scanning process
End If
p_lProcessID = p_eProcessEntry.th32ProcessID
m_lProcessID = p_lProcessID
p_sExeFile = p_eProcessEntry.szExeFile
p_sExeFile = Left$(p_sExeFile, lstrlen(p_sExeFile))
' We need to get process name from path, because process name
' from PROCESSENTRY32 type is not complete for long filenames.
DeepProcessScan p_lProcessID, p_sExeFile
Next_Process:
p_eProcessEntry.szExeFile = String$(MAX_PATH, 0)
p_lProcess = Process32Next(p_lSnapshot, p_eProcessEntry)
Loop
End If
End Sub
Private Sub ValidatePath(ByRef Path As String)
' UNC File names
If (InStr(1, Path, "\?\UNC\", vbTextCompare)) Then
Path = Replace$(Path, "\?\UNC\", "", 1, 1)
End If
' \\?\ tells Windows to turn off File parsing
If (InStr(1, Path, "\??\", vbTextCompare)) Then
Path = Replace$(Path, "\??\", "", 1, 1)
End If
' Only the first instances will be replaced
If (InStr(1, Path, "\SystemRoot\", vbTextCompare)) Then
Path = Replace$(Path, "\SystemRoot\", WindowsDirectory, 1, 1)
End If
End Sub
Private Function WindowsDirectory()
Dim p_lLen As Long
Dim p_sBuffer As String * MAX_PATH
p_lLen = GetWindowsDirectory(p_sBuffer, MAX_PATH)
If (p_lLen > 0) Then
WindowsDirectory = Left$(p_sBuffer, p_lLen)
End If
If (WindowsDirectory Like "*\") Then
' Just do nothing
Else
WindowsDirectory = WindowsDirectory & "\"
End If
End Function
Private Function WindowsPlatform() As Long
Dim p_tOSInfo As OSVERSIONINFO
p_tOSInfo.dwOSVersionInfoSize = Len(p_tOSInfo)
GetVersionEx p_tOSInfo
WindowsPlatform = p_tOSInfo.dwPlatformId
End Function
' //-- Class Procedures --//
Private Sub Class_Initialize()
' unless these properties are set, these would be their default values
m_bSystemProc = False
m_lProcessID = -1
m_lWinPlatform = WindowsPlatform
End Sub
Private Sub Class_Terminate()
If (m_bScanning Or m_bPaused) Then
CancelScanning
End If
End Sub
' Created by Noel A. Dacara | Copyright © 2003-2005 Davao City, Philippines
'######Selesai Disini######
Coba Jalankan Jika Berhasil Anda Sudah MEnjadi Programer
••Siapkan 1 Buah Form
1 Buah Module
2 Buah Class Module
Name Form "FrmProccess"
Name Module "ModMem"
Name Class Module -"clsGetIcon"
-"clsScanProc"
••Form 1 Components
" • 1 Buah Timer (Interval = '1000')
• 3 Buah Command Button (Name = 'CmdTerminate, CmdRefresh, CmdExplore')
• 1 Buah ListView "Caranya Klik Menu Project Lalu Pilih Components Atau Ctrl+T >> Lalu Cari Microsoft Windows Common controls 6.0 (SP6) >> centang dan klik apply lalu ok"
• Beberapa Label Untuk Memory Status
Diantaranya
- Total Physical Memory (Name = "LabelName" Caption = "")
- Free Physical Memory (Name = "LabelName" Caption = "")
- Used Memory (Name = "LabelName" Caption = "")
- Free Memory (Name = "LabelName" Caption = "")
- Total Page File (Name = "LabelName" Caption = "")
- Free Page File (Name = "LabelName" Caption = "")
- Total Virtual Memory (Name = "LabelName" Caption = "")
- Free Virtual Memory (Name = "LabelName" Caption = "")
• Lalu Di Sisinya Sisipkan Lagi 8 Buah Label Tanpa Caption Dengan Name Label 1 sampai Label8
• 2 Buah Check
• Terakhir Buat Sebuah Menu
File (Name = "MnFile")
...Exit (Name = "MnExit")
Action (Name = "MnAct")
...End Proccess Selected (Name = "MnTerminate)
'#######••Lalu Coding Ini Di Form••#######'
'Watch this area here--^ ...it contains all the form objects that supports events
Dim WithEvents SCANPROC As ClsScanProc
'Take note of the declaration above!!!
Private Declare Function LockWindowUpdate Lib "user32.dll" (ByVal hwndLock As Long) As Long
Dim m_sProcess As String
Dim m_sTime As Single
Dim FILEICON As ClsGetIcon
'##################################################################################
Private Sub cmdrefresh_Click()
Call Check1_Click
End Sub
Private Sub Cmdterminate_Click()
PopupMenu MnAct
End Sub
Private Sub Cmdexplore_Click()
Shell "Explorer.exe " & Left(ListView1.SelectedItem.SubItems(1), _
Len(ListView1.SelectedItem.SubItems(1)) - Len(ListView1.SelectedItem)), _
vbNormalFocus
End Sub
Private Sub ListView1_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
If Button = 2 Then PopupMenu mnMenu
End Sub
Private Sub MnExit_Click()
Unload Me
End Sub
Private Sub MnTerminate_Click()
If MsgBox("Yakin Untuk Membunuh Proses terpilih ini ??", vbExclamation + vbYesNoCancel + vbDefaultButton2, "Terminate Process") = vbYes Then
If (SCANPROC.TerminateProcess(ListView1.SelectedItem.SubItems(2)) = True) Then
Call Check1_Click
End If
End If
End Sub
Private Sub SCANPROC_CurrentModule(Process As String, ID As Long, Module As String, File As String)
' Tips: You can perform checksum checks here indiviually for each file...
Dim lsv As ListItem
Set lsv = ListView1.ListItems.Add(, , Module)
With lsv
.ForeColor = RGB(0, 150, 0) ' Dark green
.SubItems(1) = File
.ListSubItems(1).ToolTipText = File
' .Selected = True
' .EnsureVisible
End With
End Sub
Private Sub SCANPROC_CurrentProcess(Name As String, File As String, ID As Long, Modules As Long)
' Tips: You can perform checksum checks here indiviually for each file...
Dim p_HasImage As Boolean
If (File <> "SYSTEM") Then
On Error Resume Next
ImageList1.ListImages(Name).Tag = "" 'Just to test if this item exists
If (Err.Number <> 0) Then
Err.Clear
ImageList1.ListImages.Add , Name, FILEICON.Icon(File, SmallIcon)
p_HasImage = (Err.Number = 0)
Else
p_HasImage = True
End If
End If
Dim lsv As ListItem
If (p_HasImage = True) Then
Set lsv = ListView1.ListItems.Add(, "#" & Name & ID, Name, , Name)
Else
Set lsv = ListView1.ListItems.Add(, "#" & Name & ID, Name)
End If
With lsv
.ForeColor = vbBlue
.SubItems(1) = File
.SubItems(2) = ID
.SubItems(3) = Modules
.ListSubItems(2).ForeColor = vbRed
.ListSubItems(1).ToolTipText = File
' .Selected = True
' .EnsureVisible
End With
If (m_sProcess <> "#" & Name & ID) Then
Modules = 0
End If
End Sub
Private Sub SCANPROC_DoneScanning(TotalProcess As Long)
Dim p_Elapsed As Single
p_Elapsed = Timer - m_sTime
LockWindowUpdate 0& ' Enable listview repaint
'Debug.Print "Total Number of Process Detected: " & TotalProcess & vbNewLine & "Total Scan Time: " & p_Elapsed & vbNewLine
NUMPROC = TotalProcess
End Sub
'##################################################################################
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
If (Check2.Value <> vbChecked) Then
'PopupMenu mnEx 'If Button = 2 Then PopupMenu mnEx
Exit Sub ' What for?
End If
Dim i As Long
i = Item.Index
If (m_sProcess = Item.Key) Then
m_sProcess = ""
Else
m_sProcess = Item.Key
End If
Call Check1_Click
On Error Resume Next
ListView1.ListItems(i).Selected = True
ListView1.SelectedItem.EnsureVisible
End Sub
Private Sub Check1_Click()
ListView1.ListItems.Clear
SCANPROC.SystemProcesses = (Check1.Value = vbChecked)
SCANPROC.ProcessModules = (Check2.Value = vbChecked)
m_sTime = Timer
LockWindowUpdate ListView1.hWnd ' Prevent listview repaints
SCANPROC.BeginScanning
End Sub
Private Sub Check2_Click()
If (Check2.Value = vbChecked) Then
Command2.Caption = "Refresh"
Else
Command2.Caption = "Refresh"
End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If (KeyAscii = vbKeyEscape) Then
SCANPROC.CancelScanning
Unload Me
End If
End Sub
Private Sub Form_Load()
Set SCANPROC = New ClsScanProc
Set FILEICON = New ClsGetIcon
Call Check1_Click
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set SCANPROC = Nothing
Set FILEICON = Nothing
End Sub
Private Sub Timer1_Timer()
Dim mem As MEMORYSTATUS
GlobalMemoryStatus mem
Dim tot, free
ModMem.getfreemem tot, free
Label1.Caption = Round(mem.dwTotalPhys / 1024 / 1024, 2) & " MB"
Label2.Caption = Round(mem.dwAvailPhys / 1024 / 1024, 2) & " MB"
Label3.Caption = Round((tot - free) / 1024 / 1024, 2) & " MB Used [" & Round(((tot - free) / tot) * 100, 2) & "%]"
Label8.Caption = Round(free / 1024 / 1024, 2) & " MB Free [" & Round((free / tot) * 100, 2) & "%]"
Label4.Caption = Round(mem.dwTotalPageFile / 1024 / 1024, 2)
Label5.Caption = Round(mem.dwAvailPageFile / 1024 / 1024, 2)
Label6.Caption = Round(mem.dwTotalVirtual / 1024 / 1024, 2)
Label7.Caption = Round(mem.dwAvailVirtual / 1024 / 1024, 2)
End Sub
'#######••Selesai Coding Form••#######
'######Sekarang Coding Di Module (ModMem)######
Option Explicit
Public Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Public 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
Public Function getfreemem(ByRef Total As Variant, ByRef free As Variant)
'Returns total as totlaphysicalmem(in KB)
'Returns free as freephysicalmem(in KB)
Dim mem As MEMORYSTATUS
GlobalMemoryStatus mem
free = mem.dwAvailPhys
Total = mem.dwTotalPhys
End Function
'######Selesai Disini Coding ModMem######
Nah Sekarang Tinggal Sisipkan Code Berikut Di Class Module
'###### Coding ClassModule (clsGetIcon)
' Modified API Declaration
Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Sub OleCreatePictureIndirect Lib "oleaut32.dll" (ByRef lpPictDesc As PictDesc, ByRef riid As Guid, ByVal fOwn As Long, ByRef lplpvObj As IPictureDisp)
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, ByRef psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As ESHGetFileInfoFlagConstants) As Long
' API Constants
Private Const ERRORAPI As Long = 0
Private Const MAX_PATH As Long = 260
' API Types
Private Type Guid
Data1 As Long
data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type PictDesc
cbSizeofStruct As Long
picType As Long
hImage As Long
xExt As Long
yExt As Long
End Type
Private Type SHFILEINFO
hIcon As Long ' : icon
iIcon As Long ' : icondex
dwAttributes As Long ' : SFGAO_ flags
szDisplayName As String * MAX_PATH ' : display name (or path)
szTypeName As String * 80 ' : type name
End Type
'User-Defined API Enum
Private Enum ESHGetFileInfoFlagConstants
SHGFI_ATTRIBUTES = &H800 ' get file attributes
SHGFI_DISPLAYNAME = &H200 ' get display name
SHGFI_EXETYPE = &H2000 ' get exe type
SHGFI_ICON = &H100 ' get icon handle and index
SHGFI_LARGEICON = &H0 ' get file's large icon
SHGFI_LINKOVERLAY = &H8000 ' add link overlay on the icon
SHGFI_OPENICON = &H2 ' get file's open icon
SHGFI_SELECTED = &H10000 ' blend icon with the system highlight color
SHGFI_SHELLICONSIZE = &H4 ' get shell-sized icon
SHGFI_SMALLICON = &H1 ' get file's small icon
SHGFI_SYSICONINDEX = &H4000 ' get icon index from system image list
SHGFI_TYPENAME = &H400 ' get file type description
SHGFI_USEFILEATTRIBUTES = &H10 ' use dwFileAttributes parameter
End Enum
Public Enum EFileIconTypes
LargeIcon = 0
SmallIcon = 1
End Enum
Public Enum EFileExeTypes
MSDosApp = 2 ' MS-DOS .EXE, .COM or .BAT file
NonExecutable = 0 ' Nonexecutable file or an error condition
Win32Console = 3 ' Win32 console application
WindowsApp = 1 ' Windows application
End Enum
' Variable Declarations
Private m_bOpenState As Boolean
Private m_bOverlay As Boolean
Private m_bSelected As Boolean
Private m_eIconType As EFileIconTypes
Private m_lHandle As Long
Private m_sFile As String
' //-- Properties --//
Public Property Get DisplayName(Optional File) As String
'Returns the display name of the specified file.
Dim p_Ret As Long
Dim p_SHFI As SHFILEINFO
If (IsMissing(File)) Then
File = m_sFile
End If
p_Ret = SHGetFileInfo(CStr(File), 0&, p_SHFI, Len(p_SHFI), SHGFI_DISPLAYNAME)
If (p_Ret <> ERRORAPI) Then
DisplayName = p_SHFI.szDisplayName
DisplayName = Left$(DisplayName, lstrlen(DisplayName))
End If
End Property
Public Property Get ExeType(Optional File) As EFileExeTypes
'Returns the display name of the specified file.
Dim p_Ret As Long
Dim p_SHFI As SHFILEINFO
If (IsMissing(File)) Then
File = m_sFile
End If
p_Ret = SHGetFileInfo(CStr(File), 0&, p_SHFI, Len(p_SHFI), SHGFI_EXETYPE)
If (p_Ret <> ERRORAPI) Then
If (HiWord(p_Ret) > 0) Then ' NE 0x00004E45 or PE 0x00005045
ExeType = WindowsApp
Else
Select Case LoWord(p_Ret)
Case 23117 ' MZ 0x00004D5A
ExeType = MSDosApp
Case 17744 ' PE 0x00005045
ExeType = Win32Console
End Select
End If
End If
End Property
Public Property Get File() As String
'Returns/sets the complete file path to be used.
File = m_sFile
End Property
Public Property Let File(Value As String)
m_sFile = Value
End Property
Public Property Get Handle() As Long
'Returns/sets the icon handle to be used by the IconEx property.
Handle = m_lHandle
End Property
Public Property Let Handle(Value As Long)
m_lHandle = Value
End Property
Public Property Get IconType() As EFileIconTypes
'Returns/sets the type of icon to retrieve.
IconType = m_eIconType
End Property
Public Property Let IconType(Value As EFileIconTypes)
m_eIconType = Value
End Property
Public Property Get Icon(Optional File, Optional IconType) As IPictureDisp
'Returns the icon of the specified file.
If (IsMissing(File)) Then
File = m_sFile
End If
If (IsMissing(IconType)) Then
IconType = m_eIconType
End If
Dim p_Flags As ESHGetFileInfoFlagConstants
Dim p_hIcon As Long
Dim p_Ret As Long
Dim p_SHFI As SHFILEINFO
If (m_eIconType = LargeIcon) Then
p_Flags = SHGFI_ICON Or SHGFI_LARGEICON
Else
p_Flags = SHGFI_ICON Or SHGFI_SMALLICON
End If
If (m_bOverlay) Then
p_Flags = p_Flags Or SHGFI_LINKOVERLAY
End If
If (m_bSelected) Then
p_Flags = p_Flags Or SHGFI_SELECTED
Else
p_Flags = p_Flags And Not SHGFI_SELECTED
End If
If (m_bOpenState) Then
p_Flags = p_Flags Or SHGFI_OPENICON
Else
p_Flags = p_Flags And Not SHGFI_OPENICON
End If
p_Ret = SHGetFileInfo(CStr(File), 0&, p_SHFI, Len(p_SHFI), p_Flags)
If (p_Ret <> ERRORAPI) Then
p_hIcon = p_SHFI.hIcon
If (p_hIcon) Then
Set Icon = IconEx(p_hIcon)
End If
End If
End Property
Public Property Get IconEx(Optional hIcon As Long) As IPictureDisp
'Returns the file's icon using the specified icon handle.
If (hIcon = 0) Then
hIcon = m_lHandle
If (hIcon = 0) Then
Exit Property
End If
End If
Dim p_Picture As IPictureDisp
Dim p_PicDesc As PictDesc
Dim p_Guid As Guid
p_PicDesc.cbSizeofStruct = Len(p_PicDesc)
p_PicDesc.picType = vbPicTypeIcon
p_PicDesc.hImage = hIcon
' IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
With p_Guid
.Data1 = &H7BF80980
.data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With
' From vbAccelerator... (http://www.vbaccelerator.com)
OleCreatePictureIndirect p_PicDesc, p_Guid, True, p_Picture
Set IconEx = p_Picture
End Property
Public Property Get LinkOverlay() As Boolean
'Returns/sets a value to determine if a linkoverlay icon is displayed on the icon.
LinkOverlay = m_bOverlay
End Property
Public Property Let LinkOverlay(Value As Boolean)
m_bOverlay = Value
End Property
Public Property Get OpenState() As Boolean
'Returns/sets a value to determine if the icon will be in open state. (Ex. Folders)
OpenState = m_bOpenState
End Property
Public Property Let OpenState(Value As Boolean)
m_bOpenState = Value
End Property
Public Property Get Selected() As Boolean
'Returns/sets a value to determine if the icon is in selected state.
Selected = m_bSelected
End Property
Public Property Let Selected(Value As Boolean)
m_bSelected = Value
End Property
Public Property Get TypeName(Optional File) As String
'Returns the type name of the specified file.
Dim p_Ret As Long
Dim p_SHFI As SHFILEINFO
If (IsMissing(File)) Then
File = m_sFile
End If
p_Ret = SHGetFileInfo(CStr(File), 0&, p_SHFI, Len(p_SHFI), SHGFI_TYPENAME)
If (p_Ret <> ERRORAPI) Then
TypeName = p_SHFI.szTypeName
TypeName = Left$(TypeName, lstrlen(TypeName))
End If
End Property
' //-- Private properties --//
Private Property Get HiWord(DWord As Long) As Long
HiWord = (DWord And &HFFFF0000) \ &H10000
End Property
Private Property Get LoWord(DWord As Long) As Long
If (DWord And &H8000&) Then
LoWord = DWord Or &HFFFF0000
Else
LoWord = DWord And &HFFFF&
End If
End Property
' Created by Noel A. Dacara | Copyright © 2003-2005 Davao City, Philippines
'######Selesai Disini######
'######Coding (clsScanProc)######
' API Declarations
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32.dll" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function EnumProcesses Lib "psapi.dll" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef lpcbNeeded As Long) As Long
Private Declare Function FormatMessage Lib "kernel32.dll" Alias "FormatMessageA" (ByVal dwFlags As Long, ByRef lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, ByRef Arguments As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long
Private Declare Function GetModuleBaseName Lib "psapi.dll" Alias "GetModuleBaseNameA" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpBaseName As String, ByVal nSize As Long) As Long
Private Declare Function GetModuleFileNameEx Lib "psapi.dll" Alias "GetModuleFileNameExA" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFilename As String, ByVal nSize As Long) As Long
Private Declare Function GetQueueStatus Lib "user32.dll" (ByVal fuFlags As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32.dll" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, ByRef TokenHandle As Long) As Long
Private Declare Function Process32First Lib "kernel32.dll" (ByVal hSnapshot As Long, ByRef lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32.dll" (ByVal hSnapshot As Long, ByRef lppe As PROCESSENTRY32) As Long
' Modified API Declaration
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, ByRef NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, ByVal PreviousState As Long, ByVal ReturnLength As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, ByRef lpLuid As LUID) As Long
Private Declare Function TerminateProcess32 Lib "kernel32.dll" Alias "TerminateProcess" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
' API Constants
Private Const ANYSIZE_ARRAY As Long = 1
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
Private Const MAX_DESCRIPTION As Long = 1024
Private Const MAX_MODULE_NAME32 As Long = 255
Private Const MAX_PATH As Long = 260
Private Const PROCESS_QUERY_INFORMATION As Long = (&H400)
Private Const PROCESS_VM_READ As Long = (&H10)
Private Const SE_DEBUG_NAME As String = "SeDebugPrivilege"
Private Const SE_PRIVILEGE_ENABLED As Long = &H2
Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Private Const SYNCHRONIZE As Long = &H100000
Private Const TH32CS_SNAPPROCESS As Long = &H2
Private Const TOKEN_ADJUST_PRIVILEGES As Long = &H20
Private Const TOKEN_QUERY As Long = &H8
Private Const PROCESS_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)
Private Const VER_PLATFORM_WIN32_NT As Long = 2
'GetQueueStatus Flag
Private Const QS_ALLEVENTS As Long = &HBF
' API Types
Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type
Private Type LUID
lowpart As Long
highpart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string for PSS usage
End Type
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
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
' Variable Declarations
Private m_bCancel As Boolean
Private m_bErrorOnFail As Boolean
Private m_bOldMethod As Boolean
Private m_bPaused As Boolean
Private m_bProcModules As Boolean
Private m_bScanning As Boolean
Private m_bSystemProc As Boolean
Private m_bTerminated As Boolean
Private m_lNumProcess As Long
Private m_lProcessID As Long
Private m_lWinPlatform As Long
' //-- Class Events --//
Public Event CurrentModule(Process As String, ID As Long, Module As String, File As String)
'Occurs everytime a process is scanned for modules.
Public Event CurrentProcess(Name As String, File As String, ID As Long, Modules As Long)
'Occurs everytime a process is scanned.
Public Event DoneScanning(TotalProcess As Long)
'Occures after scanning all processes.
#If False Then
' Trick to preserve casing of these variables when used in VB IDE
Private Process, Module, File, Name, Path, ID, Modules, TotalProcess
#End If
' //-- Properties --//
Public Property Get ErrorOnFail() As Boolean
'Returns/sets whether to raise an error if process termination fails.
ErrorOnFail = m_bErrorOnFail
End Property
Public Property Let ErrorOnFail(Value As Boolean)
m_bErrorOnFail = Value
End Property
Public Property Get ForceOldMethod() As Boolean
'Force to use the older method of enumerating processes for newer Windows systems.
ForceOldMethod = m_bOldMethod
End Property
Public Property Let ForceOldMethod(Value As Boolean)
m_bOldMethod = Value
End Property
Public Property Get ProcessModules() As Boolean
'Scan for modules(dll,ocx,etc..) used by a process other than its main executable.
ProcessModules = m_bProcModules
End Property
Public Property Let ProcessModules(Value As Boolean)
m_bProcModules = Value
End Property
Public Property Get ProcessTerminated() As Boolean
'Returns the boolean result for a process terminated in the class event.
ProcessTerminated = m_bTerminated
End Property
Public Property Get Scanning() As Boolean
'Returns True if class is currently on scanning state.
Scanning = m_bScanning
End Property
Public Property Get SystemProcesses() As Boolean
'Returns/sets whether to include scanning for system processes.
SystemProcesses = m_bSystemProc
End Property
Public Property Let SystemProcesses(Value As Boolean)
m_bSystemProc = Value
End Property
Public Property Get TotalProcesses() As Integer
'Returns the current or the total number of processes scanned.
TotalProcesses = m_lNumProcess
End Property
' //-- Procedures --//
Public Sub BeginScanning()
'Start scanning for running processes in the system.
If (m_bPaused) Then
ResumeScanning ' Resume scanning instead
Exit Sub
End If
If (m_bScanning) Then
Exit Sub ' avoid cascading scans
End If
m_bCancel = False
m_lNumProcess = 0
m_bScanning = True
ScanForProcesses ' scan the system for running processes
m_bScanning = False
m_lProcessID = -1
RaiseEvent DoneScanning(m_lNumProcess)
End Sub
Public Sub CancelScanning()
'Abort scanning for running processes.
m_bCancel = True
ResumeScanning ' Resume if scanning has been paused
End Sub
Public Sub PauseScanning()
'Temporarily stop scanning process.
If (m_bScanning) Then
m_bPaused = True
End If
End Sub
Public Sub ResumeScanning()
'Resume paused scanning process.
If (m_bPaused) Then
m_bPaused = False
End If
End Sub
Public Function TerminateProcess(Optional lProcessID As Long = -1) As Boolean
'Terminate a running process using the specified process ID.
If (lProcessID = -1) Then
lProcessID = m_lProcessID ' Get process ID of currently scanned process
' If process ID is not given, it will attempt to terminate the current process
If (lProcessID = -1) Then
Exit Function
End If
End If
Dim p_lProcess As Long
Dim p_lToken As Long
Dim p_tPrivileges As TOKEN_PRIVILEGES
' Windows NT/2000 requires special treatment to ensure that the
' calling process has enough privileges to perform the instruction.
If (m_lWinPlatform = VER_PLATFORM_WIN32_NT) Then
' Open token of the defined process
If (OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, p_lToken) = 0) Then
GoTo End_Function
End If
' Get LUID used to locally represent the specified privilege name
If (LookupPrivilegeValue("", SE_DEBUG_NAME, p_tPrivileges.Privileges(ANYSIZE_ARRAY).pLuid) = 0) Then
GoTo End_Function
End If
p_tPrivileges.PrivilegeCount = 1
p_tPrivileges.Privileges(ANYSIZE_ARRAY).Attributes = SE_PRIVILEGE_ENABLED
' Attempt to acquire debug privilege for the process
If (AdjustTokenPrivileges(p_lToken, 0&, p_tPrivileges, 0&, 0&, 0&) = 0) Then
GoTo End_Function
End If
End If
' Finally, open the defined process
p_lProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, lProcessID)
If (p_lProcess) Then
' Attempt to terminate the process
TerminateProcess = (TerminateProcess32(p_lProcess, 0&) <> 0)
CloseHandle p_lProcess
If (Not TerminateProcess) Then
If (m_bErrorOnFail) Then
Err.Raise Err.LastDllError, , ErrorDescription(Err.LastDllError)
End If
End If
If (GetQueueStatus(QS_ALLEVENTS)) Then ' check for events
DoEvents
End If
End If
If (m_lWinPlatform = VER_PLATFORM_WIN32_NT) Then
' Restore original privilege
p_tPrivileges.Privileges(ANYSIZE_ARRAY).Attributes = 0
AdjustTokenPrivileges p_lToken, 0&, p_tPrivileges, 0&, 0&, 0&
End_Function:
If (p_lToken) Then
CloseHandle p_lToken
End If
End If
End Function
' //-- Private Procedures --//
Private Sub DeepProcessScan(ID As Long, Name As String)
If (m_bCancel Or m_lWinPlatform <> VER_PLATFORM_WIN32_NT) Then
If (Not m_bCancel) Then
m_lNumProcess = m_lNumProcess + 1
RaiseEvent CurrentProcess(Name, "", ID, 1)
End If
Exit Sub ' Abort the whole scanning process
End If
Dim i As Long
Dim p_lModuleCount As Long
Dim p_lModules(1 To 1024) As Long
Dim p_lNeeded As Long
Dim p_lProcess As Long
Dim p_lRet As Long
Dim p_sBaseName As String
Dim p_sBuffer As String
Dim p_sProcessPath As String
p_lProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0&, ID)
If (p_lProcess) Then
p_lRet = EnumProcessModules(p_lProcess, p_lModules(1), 1024 * 4, p_lNeeded)
If (p_lRet) Then
p_lModuleCount = p_lNeeded \ 4
For i = 1 To p_lModuleCount
If (GetQueueStatus(QS_ALLEVENTS)) Then ' check for events
DoEvents ' processes system events
End If
If (m_bPaused) Then
m_bScanning = False
While (m_bPaused)
DoEvents ' Don't execute next instructions until resumed
Wend
m_bScanning = True
End If
If (m_bCancel) Then
Exit For ' attempt to abort the whole scanning process
End If
p_sBuffer = String$(MAX_MODULE_NAME32, 0)
p_lRet = GetModuleBaseName(p_lProcess, p_lModules(i), p_sBuffer, MAX_MODULE_NAME32)
If (p_lRet > 0) Then
p_sBaseName = Left$(p_sBuffer, p_lRet)
End If
p_sBuffer = String$(MAX_MODULE_NAME32, 0)
p_lRet = GetModuleFileNameEx(p_lProcess, p_lModules(i), p_sBuffer, MAX_MODULE_NAME32)
If (p_lRet > 0) Then
p_sProcessPath = Left$(p_sBuffer, p_lRet)
End If
ValidatePath p_sProcessPath
If (i = 1) Then
If (Len(p_sProcessPath) = 0) Then
' Consider as a system process if file path is empty
p_sProcessPath = "SYSTEM"
If (Not m_bSystemProc) Then
Exit For ' Excluding system processes
End If
End If
m_lNumProcess = m_lNumProcess + 1
RaiseEvent CurrentProcess(p_sBaseName, p_sProcessPath, ID, p_lModuleCount)
If (Not m_bProcModules) Or (p_lModuleCount = 0) Then
Exit For ' Dont scan preceding process modules
End If
Else
RaiseEvent CurrentModule(Name, ID, p_sBaseName, p_sProcessPath)
End If
Next
CloseHandle p_lProcess
Exit Sub
Else
If (Len(Name) = 0) And (ID) Then
Name = "System" ' Assume this is a system process
End If
End If
CloseHandle p_lProcess
End If
If (m_bSystemProc = True) Then
If (Len(Name) = 0) And (ID) Then
Name = "[System Process]" ' a.k.a "System Idle Process"
End If
m_lNumProcess = m_lNumProcess + 1
RaiseEvent CurrentProcess(Name, "SYSTEM", ID, 1)
End If
End Sub
Private Function ErrorDescription(nError As Long) As String
Dim p_lLen As Long
Dim p_sBuffer As String * MAX_DESCRIPTION
p_lLen = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, _
ByVal 0&, _
nError, _
0&, _
p_sBuffer, _
MAX_DESCRIPTION, _
0&)
If (p_lLen > 0) Then
ErrorDescription = Left$(p_sBuffer, p_lLen)
End If
End Function
Private Sub ScanForProcesses()
Dim p_eProcessEntry As PROCESSENTRY32
Dim p_lNeeded As Long
Dim p_lProcess As Long
Dim p_lProcesses() As Long
Dim p_lProcessID As Long
Dim p_lSnapshot As Long
Dim p_sExeFile As String
' Windows 2000/ME/XP or later
If (m_lWinPlatform = VER_PLATFORM_WIN32_NT) And (Not m_bOldMethod) Then
ReDim p_lProcesses(1 To 1024) As Long
If (EnumProcesses(p_lProcesses(1), 1024 * 4, p_lNeeded)) Then
p_lNeeded = p_lNeeded \ 4
For p_lProcess = 1 To p_lNeeded
If (m_bCancel) Then
Exit For
End If
DeepProcessScan p_lProcesses(p_lProcess), ""
Next
Exit Sub
Else
' Raise an error
Err.Raise Err.LastDllError, , ErrorDescription(Err.LastDllError)
' Then attempt to enumerate processes using the other way below
End If
End If
' Windows 95/98 (Old Method)
p_lSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
If (p_lSnapshot) Then
p_eProcessEntry.dwSize = Len(p_eProcessEntry)
p_lProcess = Process32First(p_lSnapshot, p_eProcessEntry)
Do While (p_lProcess) ' iterate through all processes
If (GetQueueStatus(QS_ALLEVENTS)) Then ' check for events
DoEvents ' processes system events
End If
If (m_bPaused) Then
m_bScanning = False
While (m_bPaused)
DoEvents ' Don't execute next instructions until resumed
Wend
m_bScanning = True
End If
If (m_bCancel) Then
Exit Do ' abort the whole scanning process
End If
p_lProcessID = p_eProcessEntry.th32ProcessID
m_lProcessID = p_lProcessID
p_sExeFile = p_eProcessEntry.szExeFile
p_sExeFile = Left$(p_sExeFile, lstrlen(p_sExeFile))
' We need to get process name from path, because process name
' from PROCESSENTRY32 type is not complete for long filenames.
DeepProcessScan p_lProcessID, p_sExeFile
Next_Process:
p_eProcessEntry.szExeFile = String$(MAX_PATH, 0)
p_lProcess = Process32Next(p_lSnapshot, p_eProcessEntry)
Loop
End If
End Sub
Private Sub ValidatePath(ByRef Path As String)
' UNC File names
If (InStr(1, Path, "\?\UNC\", vbTextCompare)) Then
Path = Replace$(Path, "\?\UNC\", "", 1, 1)
End If
' \\?\ tells Windows to turn off File parsing
If (InStr(1, Path, "\??\", vbTextCompare)) Then
Path = Replace$(Path, "\??\", "", 1, 1)
End If
' Only the first instances will be replaced
If (InStr(1, Path, "\SystemRoot\", vbTextCompare)) Then
Path = Replace$(Path, "\SystemRoot\", WindowsDirectory, 1, 1)
End If
End Sub
Private Function WindowsDirectory()
Dim p_lLen As Long
Dim p_sBuffer As String * MAX_PATH
p_lLen = GetWindowsDirectory(p_sBuffer, MAX_PATH)
If (p_lLen > 0) Then
WindowsDirectory = Left$(p_sBuffer, p_lLen)
End If
If (WindowsDirectory Like "*\") Then
' Just do nothing
Else
WindowsDirectory = WindowsDirectory & "\"
End If
End Function
Private Function WindowsPlatform() As Long
Dim p_tOSInfo As OSVERSIONINFO
p_tOSInfo.dwOSVersionInfoSize = Len(p_tOSInfo)
GetVersionEx p_tOSInfo
WindowsPlatform = p_tOSInfo.dwPlatformId
End Function
' //-- Class Procedures --//
Private Sub Class_Initialize()
' unless these properties are set, these would be their default values
m_bSystemProc = False
m_lProcessID = -1
m_lWinPlatform = WindowsPlatform
End Sub
Private Sub Class_Terminate()
If (m_bScanning Or m_bPaused) Then
CancelScanning
End If
End Sub
' Created by Noel A. Dacara | Copyright © 2003-2005 Davao City, Philippines
'######Selesai Disini######
Coba Jalankan Jika Berhasil Anda Sudah MEnjadi Programer
This is dummy text. It is not meant to be read. Accordingly, it is difficult to figure out when to end it. But then, this is dummy text. It is not meant to be read. Period.
ConversionConversion EmoticonEmoticon