Load Animasi Gif Ke Form Vb6

HUUFT… .
sekian lama cari-cari di internet gimana caranya ngeload gambar beranimasi gif ke dalam form vb6 akhirnya ketemu juga neh caranya… hehehehe
Dan bagusnya lagi bisa tampil transparent meskipun menggunakan background image pada formnya… Waahhh leganya…. Heehehe
CONTOH/BUKTI :

Uda deh langsung aja yah…
Pertama kita perlu tambahan library untuk ngeload gambar gif ke form kita.
Library itu namanya adalah GIFviewer.ocx.
Nah file tersebut bisa di unduh.Linkers Me link ini ada eror coba ja edit jika pro

Oke setelah selesai download library tersebut, selanjutnya adalah meregister library tersebut.
Caranya adalah klik start->run->cmd.

Setelah tampil layar command prompt ketik regsvr32 gifviewer.ocx setelah register berhasil buka vb.
Pada bagian kosong toolbox
klik kanan->components, kemudian cari componen dengan nama welchGifViewer. Oke tinggal pake aja deh….

Jika di kompi loe keluar gini

d komp ane muncul :

kalo dgan cara begitu tidak bisa , coba dgan cara ini ..

pertama2 , tekan Ctrl+T pada Visual basic [Add Componen]
SS:

Truz Klik Browse ..
Lalu Pilih Componen Yg mau Ditambahkan ..
SS:

Resized to 99% (was 458 x 425) - Click image to enlarge

jika sudah di salahkan Tekan Apply ..

Hasil :
SS:


udah deh , selesai ..
gampang kan ??

Untuk Selanjutnya , tinggal Load Picture :
SS :



semoga membantu .. 

ATAU KYK GINI 

gini gan biar sucses
-Buka ke L0cal dick©
-lalu lalu cari Documents and Settings
-kemudi'an cari nama Komputer lo Mis[wexley]
lalu copy library yg td ke situ
ingat nama library harus sama untuk d regristrasi 

Oke semoga bermanfaat…

THANK TO : "WWW.CHETYA.C''C"""

CREDIT BY : MBAH GO*G*E

-=-==-=-=-===-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-==-=-=-

BATAS NEGARA INDONESIA-==-SAMBUNGAN POST YANG DI ATAS

cekidot langsung keinti sari aja gan .. gan ane masi bingung ni cara bikin AUTO INJECTOR TRANSPARANT ANIMATION ..

NA langkah" di bawah udah gw turutin semua ..
selesai ya selesai .. tp gag ada gambar nya gak ada teks bergerak nya gag ada animasi nya .. gag ada inject nama dll nya ,,
na bagi agan" yang udah mengerti tentang pembuatan nya tolong share ke ane ya ..
kalo bisa berbentuk [VIDEO] biar ane paham gan .. oke :)

"Maaf sebelum nya gan ane gak bisa cara Spoiler gimana heh

 

 

bahan² yang di siapkan :
1.VB6
2.gifviewer.ocx
3.file gift animasi menurut selera masing²

disini akan di jelaskan cara membuat auto injector transparant animasi yg basic code nya saya ambil dan saya edit dari gesp 1.3 , contoh dapat dilihat pada trainer² yg pernah saya bikin...to the point

Buka VB6 kalian
pada form 1 kasih timer beri nama timer1 >>> interval 25
rubah borderstyle menjadi none(0)
rubah Moveable menjadi false
isikan codding sbb dimana codding ini berfungsi sebagai pengextract file dll dan gifviewer.ocx ke dalam directory yg kalian inginkan Spoiler:
Option Explicit

Private Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "USER32" ( _
ByVal hwnd As Long, _
ByVal crKey As Long, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Sub Form_Load()
Me.BackColor = vbCyan
SetWindowLong Me.hwnd, GWL_EXSTYLE, GetWindowLong(Me.hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED
SetLayeredWindowAttributes Me.hwnd, vbCyan, 0&, LWA_COLORKEY
Dim dPath As String
On Error Resume Next
dPath = "C:\WINDOWS\system32"
If Dir$(dPath) = "" Then
'MkDir dPath
End If


CreateFileFromRessource 101, "C:\WINDOWS\system32\blazetorm.dll"
CreateFileFromRessource 102, "C:\WINDOWS\system32\GIFviewer.ocx"
End Sub
Private Sub Timer1_Timer()
Form2.Show
Unload Me
End Sub




buat 6 buah module, antara lain

CreateFileFromResource Spoiler: Public Sub CreateFileFromRessource(ByVal ID As Integer, _
ByVal FileName As String)

Dim DataArray() As Byte
Dim Handle As Integer

DataArray = LoadResData(ID, "CUSTOM")
Handle = FreeFile
Open FileName For Binary As #Handle
Put #Handle, , DataArray
Close #Handle
Erase DataArray

End Sub




ModBrowser Spoiler: Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Public Sub OpenURL(situs As String, sourceHWND As Long)
Call ShellExecute(sourceHWND, vbNullString, situs, vbNullString, vbNullString, 1)
End Sub



ModCDialog Spoiler: Option Explicit

'Common Dialog
Private Type OPENFILENAME
lStructSize As Long
hWndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Public Const OFN_READONLY = &H1
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_SHOWHELP = &H10
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOLONGNAMES = &H40000 ' force no long names for 4.x modules
Public Const OFN_EXPLORER = &H80000 ' new look commdlg
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_LONGNAMES = &H200000 ' force long names for 3.x modules
Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREWARN = 0

Private Declare Function GetOpenFileName Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "COMDLG32.DLL" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

'Browse Folder Declarations
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260
Public Const BIF_STATUSTEXT = &H4&
Public Const BIF_DONTGOBELOWDOMAIN = 2
Public Const WM_USER = &H400
Public Const BFFM_INITIALIZED = 1
Public Const BFFM_SELCHANGED = 2
Public Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Public Const BFFM_SETSELECTION = (WM_USER + 102)

Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Function OpenDialog(Form1 As Form, Filter As String, Title As String, InitDir As String) As String
Dim ofn As OPENFILENAME
Dim A As Long
Dim theTemp As String

ofn.lStructSize = Len(ofn)
ofn.hWndOwner = Form1.hwnd
ofn.hInstance = App.hInstance
If Right$(Filter, 1) <> "|" Then Filter = Filter + "|"
For A = 1 To Len(Filter)
If Mid$(Filter, A, 1) = "|" Then Mid$(Filter, A, 1) = Chr$(0)
Next
ofn.lpstrFilter = Filter
ofn.lpstrFile = Space$(254)
ofn.nMaxFile = 255
ofn.lpstrFileTitle = Space$(254)
ofn.nMaxFileTitle = 255
ofn.lpstrInitialDir = InitDir
ofn.lpstrTitle = Title
ofn.Flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST
A = GetOpenFileName(ofn)

If (A) Then
theTemp = Trim$(ofn.lpstrFile)
If Asc(Right$(theTemp, 1)) = 0 Then theTemp = Left$(theTemp, Len(theTemp) - 1)
OpenDialog = theTemp
Else
OpenDialog = ""
End If
End Function

Public Function BrowseForFolder(hWndOwner As Long, sPrompt As String) As String
'**************************************
' Name: Win95DirectoryPrompt
' Description:Prompting the User for a D
' irectory in Win95. Windows' common dialo
' gs are great if you want the user to sel
' ect a file, but what if you want them to
' select a directory? Call the following f
' unction, which relies on Win32's new SHB
' rowseForFolder function:
' By: Found on the World Wide Web
Dim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo


With udtBI
.hWndOwner = hWndOwner
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = BIF_RETURNONLYFSDIRS
End With
lpIDList = SHBrowseForFolder(udtBI)


If lpIDList Then
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
iNull = InStr(sPath, vbNullChar)


If iNull Then
sPath = Left$(sPath, iNull - 1)
End If
End If
If InStr(LCase$(sPath), "\nethood") > 0 Then
MsgBox "The item that you selected is a folder shortcut, not a folder.", vbCritical, "Browse Folders"
BrowseForFolder = ""
Else
BrowseForFolder = sPath
End If
End Function



ModInjector Spoiler: Option Explicit

Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal fAllocType As Long, flProtect As Long) As Long
Public Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function CreateRemoteThread Lib "kernel32" (ByVal ProcessHandle As Long, lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Any, ByVal lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Public Function InjectDll(DllPath As String, ProsH As Long)
Dim DLLVirtLoc As Long, DllLength, Inject As Long, LibAddress As Long
Dim CreateThread As Long, ThreadID As Long
Dim Bla As VbMsgBoxResult

g_loadlibary:
LibAddress = GetProcAddress(GetModuleHandle("kernel32.dll"), "LoadLibraryA")
If LibAddress = 0 Then
Bla = MsgBox("Can't find LoadLibrary API from kernel32.dll", vbYesNo, "ERROR")
If Bla = vbYes Then
GoTo g_loadlibary
Else
Exit Function
End If
End If

g_virutalallocex:
DllLength = Len(DllPath)
DLLVirtLoc = VirtualAllocEx(ProsH, 0, DllLength, &H1000, ByVal &H4)
If DLLVirtLoc = 0 Then
Bla = MsgBox("VirtualAllocEx API failed! - try again?", vbYesNo, "ERROR")
If Bla = vbYes Then
GoTo g_virutalallocex
Else
Exit Function
End If
End If

g_writepmemory:
Inject = WriteProcessMemory(ProsH, ByVal DLLVirtLoc, ByVal DllPath, DllLength, vbNull)
If Inject = 0 Then
Bla = MsgBox("Failed to Write DLL to Process! - try again?", vbYesNo, "ERROR")
If Bla = vbYes Then
GoTo g_writepmemory
Else
Exit Function
End If
End If

g_creatthread:
CreateThread = CreateRemoteThread(ProsH, ByVal 0, 0, ByVal LibAddress, ByVal DLLVirtLoc, 0, ThreadID)
If CreateThread = 0 Then
Bla = MsgBox("Failed to Create Thead! - try again?", vbYesNo, "ERROR")
If Bla = vbYes Then
GoTo g_creatthread
Else
Exit Function
End If
End If
End Function

Public Sub InjectExecute(ByVal sFlDLL As String)
Dim lProcInject As Long
lProcInject = OpenProcess(PROCESS_ALL_ACCESS, 0, IdTargetOne)
If lProcInject > "0" Then
Call InjectDll(sFlDLL, lProcInject)
End If
Call CloseHandle(lProcInject)
End Sub



modMain Spoiler: Option Explicit

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Type POINTAPI
X As Long
Y As Long
End Type

Public Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long

Public Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Private Declare Function SetLayeredWindowAttributes Lib "USER32" ( _
ByVal hwnd As Long, _
ByVal crKey As Long, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long) As Long

Private Declare Function GetWindowRect Lib "USER32" ( _
ByVal hwnd As Long, _
lpRect As RECT) As Long

Private Declare Function ClientToScreen Lib "USER32" ( _
ByVal hwnd As Long, _
lpPoint As POINTAPI) As Long

Private Declare Function GetWindow Lib "USER32" ( _
ByVal hwnd As Long, _
ByVal wCmd As Long) As Long

Public Const GWL_STYLE = (-16)
Public Const WS_SYSMENU = &H80000
Public Const WS_MINIMIZEBOX = &H20000

Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000

Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2

Private Const GW_HWNDNEXT = 2

Public Sub SetTrans(oForm As Form, Optional bytAlpha As Byte = 255, Optional lColor As Long = 0)
Dim lStyle As Long
lStyle = GetWindowLong(oForm.hwnd, GWL_EXSTYLE)
If Not (lStyle And WS_EX_LAYERED) = WS_EX_LAYERED Then _
SetWindowLong oForm.hwnd, GWL_EXSTYLE, lStyle Or WS_EX_LAYERED
SetLayeredWindowAttributes oForm.hwnd, lColor, bytAlpha, LWA_COLORKEY Or LWA_ALPHA
End Sub

Public Function IsOverCtl(oForm As Form, ByVal X As Long, ByVal Y As Long) As Boolean
Dim ctl As Control, lhWnd As Long, r As RECT, pt As POINTAPI

pt.X = X: pt.Y = Y
ClientToScreen oForm.hwnd, pt

For Each ctl In oForm.Controls
On Error GoTo ErrHandler
On Error GoTo 0
If lhWnd Then
GetWindowRect ctl.hwnd, r
IsOverCtl = (pt.X >= r.Left And pt.X <= r.Right And pt.Y >= r.Top And pt.Y <= r.Bottom)
If IsOverCtl Then Exit Function
End If
Next ctl
Exit Function
ErrHandler:
lhWnd = 0
Resume Next
End Function

Public Function GetNextWindow(ByVal lhWnd As Long) As Long
GetNextWindow = GetWindow(lhWnd, GW_HWNDNEXT)
End Function



ModProcess Spoiler: Option Explicit

Public Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal Classname As String, ByVal WindowName As String) As Long
Public Declare Function PostMessage Lib "USER32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function Process32First Lib _
"kernel32" (ByVal hSnapShot As Long, _
uProcess As PROCESSENTRY32) As Long
Public Declare Function Process32Next Lib _
"kernel32" (ByVal hSnapShot As Long, _
uProcess As PROCESSENTRY32) As Long
Public Declare Function CloseHandle Lib _
"kernel32" (ByVal hObject As Long) As Long

Public FileTargetOne As String
Public FileTargetTwo As String
Public sFlDLL As String

Public IdTargetOne As Long
Private IdTargetTwo As Long

Private Const TH32CS_SNAPHEAPLIST = &H1
Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPTHREAD = &H4
Private Const TH32CS_SNAPMODULE = &H8
Private Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or _
TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Private Const MAX_PATH = 260
Public Const PROCESS_ALL_ACCESS = &H1F0FFF

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 MODULEENTRY32
dwSize As Long
th32ModuleID As Long
th32ProcessID As Long
GlblcntUsage As Long
ProccntUsage As Long
modBaseAddr As Long
modBaseSize As Long
hModule As Long
szModule As String * 256
szExePath As String * 260
End Type

Private Type THREADENTRY32
dwSize As Long
cntUsage As Long
th32ThreadID As Long
th32OwnerProcessID As Long
tpBasePri As Long
tpDeltaPri As Long
dwFlags As Long
End Type

Private Const THREAD_SUSPEND_RESUME = &H2
Private Declare Function OpenThread Lib _
"kernel32.dll" (ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Boolean, _
ByVal dwThreadId As Long) As Long
Private Declare Function ResumeThread Lib _
"kernel32.dll" (ByVal hThread As Long) As Long
Private Declare Function SuspendThread Lib _
"kernel32.dll" (ByVal hThread As Long) As Long
Private hThread As Long

Private Declare Function CreateToolhelp32Snapshot Lib _
"kernel32" (ByVal lFlags As Long, _
ByVal lProcessID As Long) As Long

Private Declare Function Module32First Lib _
"kernel32" (ByVal hSnapShot As Long, _
uProcess As MODULEENTRY32) As Long
Private Declare Function lstrlen Lib _
"kernel32" Alias "lstrlenA" ( _
ByVal lpString As String) As Long
Private Declare Function GetFileTitle Lib _
"COMDLG32.DLL" Alias "GetFileTitleA" ( _
ByVal lpszFile As String, _
ByVal lpszTitle As String, _
ByVal cbBuf As Integer) As Integer

Private Declare Function Thread32First Lib _
"kernel32.dll" (ByVal hSnapShot As Long, _
ByRef lpte As THREADENTRY32) As Boolean
Private Declare Function Thread32Next Lib _
"kernel32.dll" (ByVal hSnapShot As Long, _
ByRef lpte As THREADENTRY32) As Boolean

Public 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 Function NTProcessList() As Long
On Error Resume Next
Dim FileName As String, ExePath As String
Dim hProcSnap As Long, hModuleSnap As Long, _
lProc As Long
Dim uProcess As PROCESSENTRY32, _
uModule As MODULEENTRY32
Dim intLVW As Integer
hProcSnap = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
uProcess.dwSize = Len(uProcess)
lProc = Process32First(hProcSnap, uProcess)
Do While lProc
If uProcess.th32ProcessID <> 0 Then
hModuleSnap = CreateToolhelp32Snapshot(TH32CS_SNAPALL, uProcess.th32ProcessID)
uModule.dwSize = Len(uModule)
Module32First hModuleSnap, uModule
If hModuleSnap > 0 Then
ExePath = StripNulls(uModule.szExePath)
FileName = GetFName(ExePath)
If FileTargetOne = FileName Then IdTargetOne = uProcess.th32ProcessID
If FileTargetTwo = FileName Then IdTargetTwo = uProcess.th32ProcessID
End If
End If
lProc = Process32Next(hProcSnap, uProcess)
Loop
Call CloseHandle(hProcSnap)
Call CloseHandle(lProc)
End Function

Function StripNulls(ByVal sStr As String) As String
StripNulls = Left$(sStr, lstrlen(sStr))
End Function

Public Function GetFName(fn) As String
Dim f%, n%
GetFName = fn
f% = InStr(fn, "\")
Do While f%
n% = f%
f% = InStr(n% + 1, fn, "\")
Loop
If n% > 0 Then GetFName = Mid$(fn, n% + 1)
End Function


Private Function Thread32Enum(ByRef Thread() As THREADENTRY32, _
ByVal lProcessID As Long) As Long
On Error Resume Next
ReDim Thread(0)
Dim THREADENTRY32 As THREADENTRY32
Dim hThreadSnap As Long
Dim lThread As Long
hThreadSnap = CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, lProcessID)
THREADENTRY32.dwSize = Len(THREADENTRY32)
If Thread32First(hThreadSnap, THREADENTRY32) = False Then
Thread32Enum = -1
Exit Function
Else
ReDim Thread(lThread)
Thread(lThread) = THREADENTRY32
End If
Do
If Thread32Next(hThreadSnap, THREADENTRY32) = False Then
Exit Do
Else
lThread = lThread + 1
ReDim Preserve Thread(lThread)
Thread(lThread) = THREADENTRY32
End If
Loop
Thread32Enum = lThread
Call CloseHandle(hThreadSnap)
End Function

Public Function SetSuspendResumeThread(SuspendNow As Boolean) As Long
Dim Thread() As THREADENTRY32, hPID As Long, hThread As Long, i As Long
hPID = IdTargetOne
Thread32Enum Thread(), hPID
For i = 0 To UBound(Thread)
If Thread(i).th32OwnerProcessID = hPID Then
hThread = OpenThread(THREAD_SUSPEND_RESUME, False, (Thread(i).th32ThreadID))
If SuspendNow = True Then
SetSuspendResumeThread = SuspendThread(hThread)
Else
SetSuspendResumeThread = ResumeThread(hThread)
End If
End If
Next i
Call CloseHandle(hThread)
End Function

Public Function TerminateTargetOne() As Long
Dim hPID As Long
hPID = OpenProcess(PROCESS_ALL_ACCESS, 0, IdTargetOne)
TerminateTargetOne = TerminateProcess(hPID, 0)
Call CloseHandle(hPID)
End Function

Public Function TerminateTargetTwo() As Long
Dim hPID As Long
hPID = OpenProcess(PROCESS_ALL_ACCESS, 0, IdTargetTwo)
TerminateTargetTwo = TerminateProcess(hPID, 0)
Call CloseHandle(hPID)
End Function





kemudian buat 1 buah form lagi
rubah borderstyle menjadi none(0)
rubah Moveable menjadi false
beri 2 buah timer berinama Timer1 dan Timer 2
masukkan component WindowsMediaPlayer untuk pemutar lagu beri nama WindowsMediaPlayer1 pada url isikan "http://www42.indowebster.com/1b6a46dc3753c6aac564f24bb3f3d271.mp3" tanpa tanda petik
isikan codding sbb : Spoiler: Option Explicit
Private Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "USER32" ( _
ByVal hwnd As Long, _
ByVal crKey As Long, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private winHwnd As Long
Private resmue As String
Private bSuspend As Boolean
Private Sub Timer1_Timer()
winHwnd = FindWindow(vbNullString, "HSUpdate")
If winHwnd <> 0 Then
NTProcessList
SetSuspendResumeThread True
bSuspend = True
MoveToTop
Timer1.Enabled = False
Else
Timer1.Enabled = True
bSuspend = False
End If
End Sub
Private Sub Form_Load()
Dim currentTop As Long
Dim TargetTop As Long
Dim currentLeft As Long
Dim TargetLeft As Long

Dim i As Long
currentTop = Me.Top
TargetTop = (Screen.Height - Height) / 1

For i = currentTop To TargetTop Step 50
Me.Top = i
Next i

currentLeft = Me.Left
TargetLeft = (Screen.Width - Me.Width) - 100

For i = currentLeft To TargetLeft Step 50
Me.Left = i
Next i
WindowsMediaPlayer1.URL = "http://www42.indowebster.com/1b6a46dc3753c6aac564f24bb3f3d271.mp3"
Me.BackColor = vbCyan
SetWindowLong Me.hwnd, GWL_EXSTYLE, GetWindowLong(Me.hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED
SetLayeredWindowAttributes Me.hwnd, vbCyan, 0&, LWA_COLORKEY
bSuspend = False
Timer2.Interval = 20
Timer2.Enabled = True
FileTargetOne = "PointBlank.exe"
FileTargetTwo = "HSUpdate.exe"
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Screen.MousePointer = vbDefault
End Sub
Private Sub Form_Unload(Cancel As Integer)
If bSuspend = True Then SetSuspendResumeThread False
End
End Sub
Private Sub Timer2_Timer()
Me.Top = (Screen.Height - Height) / -50
Timer2.Enabled = False
Timer1.Enabled = True
Timer1.Interval = 20
End Sub
Sub SlideWindow(frmSlide As Form, iSpeed As Integer)
While frmSlide.Top - frmSlide.Height < Screen.Height
DoEvents
frmSlide.Top = frmSlide.Top + iSpeed
Wend
End Sub
Private Sub MoveToTop()
Dim currentTop As Long
Dim TargetTop As Long
Dim currentLeft As Long
Dim TargetLeft As Long
InjectExecute "C:\WINDOWS\system32\blazetorm.dll"
resmue = "yes"
Unload Me
End Sub
Private Sub Pause(ms)
Dim secs
Dim g
secs = ms / 1000
g = Timer
Do While Timer - g < secs
DoEvents
Loop

End Sub