1: Private Const KEY_READ = &H20000 Or &H1& Or &H8& Or
2: &H10&
3: Private Const KEY_WRITE = &H20000 Or &H2& Or
4: &H4&
5: Public Const HKCU = &H80000001
6: Public Const HKLM =
7: &H80000002
8: Private Const REG_SZ = 1
9: Private Const REG_DWORD =
10: 4
11: Private Const ERROR_SUCCESS = 0&
12: Private Declare Function
13: RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hkey As Long, ByVal
14: lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult
15: As Long) As Long
16: Private Declare Function RegSetValueEx Lib "advapi32.dll"
17: Alias "RegSetValueExA" (ByVal hkey As Long, ByVal lpValueName As String, ByVal
18: Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As
19: Long
20: Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias
21: "RegQueryValueExA" (ByVal hkey As Long, ByVal lpValueName As String, ByVal
22: lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As
23: Long
24: Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As
25: Long) As Long
26: Const MAX_PATH& = 260
27: Private Declare Function
28: TerminateProcess _
29: Lib "kernel32" (ByVal ApphProcess As
30: Long, _
31: ByVal uExitCode As Long) As Long
32: Private
33: Declare Function OpenProcess Lib _
34: "kernel32" (ByVal
35: dwDesiredAccess As Long, _
36: ByVal blnheritHandle As Long,
37: _
38: ByVal dwAppProcessId As Long) As Long
39: Private Declare
40: Function ProcessFirst _
41: Lib "kernel32" Alias
42: "Process32First" _
43: (ByVal hSnapshot As Long,
44: _
45: uProcess As PROCESSENTRY32) As Long
46: Private Declare
47: Function ProcessNext _
48: Lib "kernel32" Alias
49: "Process32Next" _
50: (ByVal hSnapshot As Long,
51: _
52: uProcess As PROCESSENTRY32) As Long
53: Private Declare
54: Function CreateToolhelpSnapshot _
55: Lib "kernel32" Alias
56: "CreateToolhelp32Snapshot" _
57: (ByVal lFlags As Long,
58: _
59: lProcessID As Long) As Long
60: Private Declare Function
61: CloseHandle _
62: Lib "kernel32" (ByVal hObject As Long) As
63: Long
64: Private Type LUID
65: lowpart As Long
66: highpart As Long
67: End
68: Type
69: Private Type TOKEN_PRIVILEGES
70: PrivilegeCount As
71: Long
72: LuidUDT As LUID
73: Attributes As
74: Long
75: End Type
76: Const TOKEN_ADJUST_PRIVILEGES = &H20
77: Const
78: TOKEN_QUERY = &H8
79: Const SE_PRIVILEGE_ENABLED = &H2
80: Const
81: PROCESS_ALL_ACCESS = &H1F0FFF
82: Private Declare Function GetVersion Lib
83: "kernel32" () As Long
84: Private Declare Function GetCurrentProcess
85: _
86: Lib "kernel32" () As Long
87: Private Declare Function
88: OpenProcessToken _
89: Lib "advapi32" (ByVal ProcessHandle As
90: Long, _
91: ByVal DesiredAccess As Long,
92: _
93: TokenHandle As Long) As Long
94: Private Declare Function
95: LookupPrivilegeValue _
96: Lib "advapi32" Alias
97: "LookupPrivilegeValueA" _
98: (ByVal lpSystemName As String,
99: _
100: ByVal lpName As String, _
101: lpLuid
102: As LUID) As Long
103: Private Declare Function AdjustTokenPrivileges
104: _
105: Lib "advapi32" (ByVal TokenHandle As Long,
106: _
107: ByVal DisableAllPrivileges As Long,
108: _
109: NewState As TOKEN_PRIVILEGES, _
110:
111: ByVal BufferLength As Long, _
112: PreviousState As Any,
113: _
114: ReturnLength As Any) As Long
115: Private Type
116: PROCESSENTRY32
117: dwSize As Long
118: cntUsage As
119: Long
120: th32ProcessID As Long
121: th32DefaultHeapID As
122: Long
123: th32ModuleID As Long
124: cntThreads As
125: Long
126: th32ParentProcessID As Long
127: pcPriClassBase
128: As Long
129: dwFlags As Long
130: szexeFile As String *
131: MAX_PATH
132: End Type
133:
134: Public Function KillApp(myName As String) As Boolean
135: Const
136: TH32CS_SNAPPROCESS As Long = 2&
137: Const PROCESS_ALL_ACCESS =
138: 0
139: Dim uProcess As PROCESSENTRY32
140: Dim rProcessFound As
141: Long
142: Dim hSnapshot As Long
143: Dim szExename As String
144:
145: Dim exitCode As Long
146: Dim myProcess As Long
147: Dim AppKill As
148: Boolean
149: Dim appCount As Integer
150: Dim i As Integer
151:
152: On Local Error GoTo Finish
153: appCount = 0
154: uProcess.dwSize =
155: Len(uProcess)
156: hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS,
157: 0&)
158: rProcessFound = ProcessFirst(hSnapshot, uProcess)
159: Do
160: While rProcessFound
161: i = InStr(1,
162: uProcess.szexeFile, Chr(0))
163: szExename =
164: LCase$(Left$(uProcess.szexeFile, i - 1))
165:
166: If Right$(szExename, Len(myName)) = LCase$(myName)
167: Then
168: KillApp =
169: True
170: appCount =
171: appCount + 1
172:
173: myProcess = OpenProcess(PROCESS_ALL_ACCESS, False,
174: _
175:
176: uProcess.th32ProcessID)
177:
178: If KillProcess(uProcess.th32ProcessID, 0)
179: Then
180:
181: 'Tidak ada process yang di
182: stop
183: End
184: If
185: End If
186: rProcessFound
187: = ProcessNext(hSnapshot, uProcess)
188: Loop
189: Call
190: CloseHandle(hSnapshot)
191: Exit Function
192: Finish:
193: MsgBox
194: "Error!"
195: End Function
196:
197: Function KillProcess(ByVal hProcessID As Long, Optional ByVal
198: _
199:
200: exitCode As Long) As Boolean
201: Dim hToken As
202: Long
203: Dim hProcess As Long
204: Dim tp As
205: TOKEN_PRIVILEGES
206: If GetVersion() >= 0
207: Then
208: If
209: OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or
210: _
211:
212: TOKEN_QUERY, hToken) = 0
213: Then
214: GoTo
215: CleanUp
216: End
217: If
218: If LookupPrivilegeValue("",
219: "SeDebugPrivilege", tp.LuidUDT) = 0
220: Then
221: GoTo
222: CleanUp
223: End
224: If
225: tp.PrivilegeCount =
226: 1
227: tp.Attributes =
228: SE_PRIVILEGE_ENABLED
229: If
230: AdjustTokenPrivileges(hToken, False, tp, 0, ByVal 0&,
231: _
232: ByVal 0&)
233: = 0 Then
234:
235: GoTo CleanUp
236: End
237: If
238: End If
239: hProcess =
240: OpenProcess(PROCESS_ALL_ACCESS, 0, hProcessID)
241: If hProcess
242: Then
243: KillProcess =
244: (TerminateProcess(hProcess, exitCode) <>
245: 0)
246: CloseHandle
247: hProcess
248: End If
249: If GetVersion()
250: >= 0 Then
251: tp.Attributes =
252: 0
253: AdjustTokenPrivileges hToken,
254: False, tp, 0, ByVal 0&, ByVal
255: 0&
256: CleanUp:
257: If hToken Then
258: CloseHandle hToken
259: End If
260: End Function
261:
262: Public Function BuatDword(ByVal hkey As Long, ByVal alamat As String, ByVal
263: nama As String, ByVal nilai As Long) As Boolean
264: Dim Handle
265: As Long
266: Dim hasil As Long
267: hasil =
268: RegOpenKeyEx(hkey, alamat, 0, KEY_WRITE, Handle)
269: If hasil
270: <> ERROR_SUCCESS Then
271:
272: BuatDword = False
273:
274: Else
275: BuatDword =
276: True
277: End If
278: RegSetValueEx Handle,
279: nama, 0&, REG_DWORD, nilai, 4&
280: RegCloseKey
281: Handle
282: End Function
283:
284: Public Function BuatString(ByVal hkey As Long, ByVal alamat As String,
285: ByVal nama As String, ByVal nilai As String) As Boolean
286:
287: Dim Handle As Long
288: Dim hasil As Long
289:
290: hasil = RegOpenKeyEx(hkey, alamat, 0, KEY_WRITE, Handle)
291:
292: If hasil <> ERROR_SUCCESS
293: Then
294: BuatString =
295: False
296: Else
297:
298: BuatString = True
299: End If
300:
301: RegSetValueEx Handle, nama, 0, REG_SZ, ByVal nilai,
302: Len(nilai)
303: RegCloseKey Handle
304: End Function
305:
306: Public Function AmbilDword(ByVal hkey As Long, ByVal alamat As String,
307: nama As String) As Long
308: On Error Resume
309: Next
310: Dim Handle As Long
311: RegOpenKeyEx
312: hkey, alamat, 0, KEY_READ, Handle
313: AmbilDword =
314: RegQueryValue(Handle, nama)
315: RegCloseKey Handle
316: End
317: Function
318:
319: Public Function AmbilString(ByVal hkey As Long, ByVal alamat As String,
320: ByVal nama As String) As String
321: On Error Resume
322: Next
323: Dim Handle As Long
324: RegOpenKeyEx
325: hkey, alamat, 0, KEY_READ, Handle
326: AmbilString =
327: RegQueryValue(Handle, nama)
328: RegCloseKey Handle
329: End
330: Function
331:
332: Private Function RegQueryValue(ByVal hkey As Long, ByVal strValueName As
333: String) As String
334: Dim hasil As Long
335:
336: Dim Jenis As Long
337: Dim Buffer As
338: String
339: Dim Ukuran As Long
340: hasil =
341: RegQueryValueEx(hkey, strValueName, 0, Jenis, ByVal 0,
342: Ukuran)
343: If hasil = 0
344: Then
345: If Jenis = REG_SZ
346: Then
347:
348: Buffer = String(Ukuran,
349: Chr$(0))
350:
351: hasil = RegQueryValueEx(hkey, strValueName, 0, 0, ByVal Buffer,
352: Ukuran)
353: If
354: hasil = 0 Then RegQueryValue = Left$(Buffer, InStr(1, Buffer, Chr$(0)) -
355: 1)
356: ElseIf Jenis = REG_DWORD
357: Then
358: Dim
359: strdata As
360: Integer
361:
362: hasil = RegQueryValueEx(hkey, strValueName, 0, 0, strdata,
363: Ukuran)
364: If
365: hasil = 0 Then RegQueryValue =
366: strdata
367: End
368: If
369: End If
370: End Function