Tanpa basa-basi langsung menuju cara pembuatan :
1. Jalankan program VB 6.0 >> buat new project >> pilih standar.exe
2. Klik Menu Project >> Components (CTRL+T) >> tandai/centang Microsoft Common Dialog Control 6.0 dan Microsoft Multimedia Control 6.0 >> Microsoft HTML Library, Microsoft Internet Control, Microsoft Windows Common Control 6.0 >> OK
3. Pada form1 tambahkan 2 buah label, 7 commandbutton, 1 CommonDialog, Windows MediaPlayer, 2 ListBox >> desain tataletaknya
>> Ganti Propertis
Nama Control
|
Propertis
|
Setting
|
Lebel 1
|
Caption
|
MepNet_SV
|
Lebel 2
|
Caption
BorderStyle
|
(kosongkan)
1-FixedSingle
|
Command1
|
Caption
|
Open
|
Command2
|
Caption
|
Add
|
Command3
|
Caption
Visible
|
Add File
False
|
Command4
|
Caption
Visible
|
Add Folder
False
|
Command5
|
Caption
|
Exit
|
Command6
|
Caption
|
Scan
|
Command7
|
Caption
|
Network
|
CommondDialog
|
CancelError
Filter
|
True
*.mp3
|
Windows MediaPlayer
|
EjectEnabled
EjectVisible
PauseEnabled
PauseVisible
PlayEnabled
PlayVisible
StopEnabled
StopVisible
|
True
True
True
True
True
True
True
True
|
List1
|
Caption
|
(kosongkan)
|
List2
|
Caption
|
(kosongkan)
|
4. Buat Form2 ( form untuk Menambahkan File ) >> Tutup Form1 >> Buka Menu Project dan Pilih Add Form >> Berikan komponen berikut pada Form2 , 1 buah DriveListBox, 1 Buah DirListBox, 1 Buah FileListBox, 2 Buah CommandButton >> atur tataletaknya
>> Ganti Properties
Nama Control
|
Propertis
|
Setting
|
Command1
|
Caption
|
Add File
|
Command2
|
Caption
|
Close
|
5. Buat Form3 (untuk menambahkan Folder) >> tutup form2 >> Buka Menu Project dan Pilih Add Form >> Berikan komponen berikut pada Form3 , 1 buah DriveListBox, 1 Buah DirListBox, 2 Buah CommandButton >> atur tataletaknya
>> Ganti Propertis
Nama Control
|
Propertis
|
Setting
|
Command1
|
Caption
|
Add Folder
|
Command2
|
Caption
|
Close
|
*silahkan melanjutkan pnambahan Form4 & form5 ntuk menambahkan scan virus & web browser
6. Buat Form4 (untuk menambahkan Scan Virus) >> tutup form3 >> Buka Menu Project dan Pilih Add Form >> Berikan komponen berikut pada Form4 , 1 buah DriveListBox, 1 Buah DirListBox, 1 buah listbox, 4 buah textbox dan 2 Buah CommandButton >> atur tataletaknya
>> Ganti Propertis
Nama Control
|
Propertis
|
Setting
|
Command1
|
Caption
|
Add Folder
|
Command2
|
Caption
|
Close
|
Tex2
|
Caption
|
Control Text2
|
7. Buat Form5 (untuk web browser) >> tutup form4 >> Buka Menu Project dan Pilih Add Form >> Berikan komponen berikut pada Form5, 2 Label, 1 Text box, 1 Button 1, Webbrowser, 1 Progress Bar >> atur tataletaknya
>> Ganti Propertis
Nama Control
|
Propertis
|
Setting
|
Command1
|
Caption
|
GO..!!!
|
TexBox
|
Caption
|
(kosongkan)
|
PEMBERIAN CODE
1. Form1
Private Sub add_Click()
Form2.Show
End Sub
Private Sub Command1_Click()
On Error Resume Next
CommonDialog1.ShowOpen
WindowsMediaPlayer1.URL = CommonDialog1.FileName
Exit Sub
End Sub
Private Sub Command2_Click()
If Command2.Caption = "ADD" Then
Command3.Visible = True
Command4.Visible = True
Command2.Caption = "Hide"
Else
Command3.Visible = False
Command4.Visible = False
Command2.Caption = "ADD"
End If
End Sub
Private Sub Command3_Click()
Form2.Show
End Sub
Private Sub Command4_Click()
Form3.Show
End Sub
Private Sub Command5_Click()
Form4.Show
End Sub
Private Sub Command6_Click()
End
End Sub
Private Sub Command7_Click()
Form5.Show
End Sub
Private Sub exit_Click()
End
End Sub
Private Sub Form_Unload(Cancel As Integer)
WindowsMediaPlayer1.URL = "stop"
End Sub
Private Sub List2_DblClick()
List1.ListIndex = List2.ListIndex
WindowsMediaPlayer1.URL = List1.List(List1.ListIndex)
End Sub
Private Sub open_Click()
On Error Resume Next
CommonDialog1.ShowOpen
WindowsMediaPlayer1.URL = CommonDialog1.FileName
Exit Sub
End Sub
Private Sub project_Click()
Command7 = True
End Sub
2. Form2
Private Sub Command1_Click()
Form1.List1.AddItem Dir1.path & "\" & File1
Form1.List2.AddItem File1
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Dir1_Change()
File1.path = Dir1.path
End Sub
Private Sub Drive1_Change()
Dir1.path = Drive1.Drive
End Sub
Private Sub File1_DblClick()
Form1.List2.AddItem Dir1.path & "\" & File1.FileName
Form1.List1.AddItem File1.FileName
End Sub
Private Sub Form_Load()
End Sub
3. Form3
Private Sub Command1_Click()
Form1.List2.AddItem Form1.List1 & "\" & Dir1.Path
Form1.List2.AddItem Dir1.Path
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Dir1_Change()
Form1.List1.AddItem Dir1.path
End Sub
Private Sub Drive1_Change()
Dir1.path = Drive1.Drive
End Sub
Private Sub Form_Load()
End Sub
4. Form4
Option Explicit
Function FindFilesAPI(path As String, SearchStr As String, _
FileCount As Integer, DirCount As Integer)
Dim FileName As String ' Walking filename variable...
Dim DirName As String ' SubDirectory Name
Dim dirNames() As String ' Buffer for directory name entries
Dim nDir As Integer ' Number of directories in this path
Dim i As Integer ' For-loop counter...
Dim hSearch As Long ' Search Handle
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
Dim FT As FILETIME
Dim ST As SYSTEMTIME
Dim DateCStr As String, DateMStr As String
If Right(path, 1) <> "\" Then path = path & "\"
' Search for subdirectories.
nDir = 0
ReDim dirNames(nDir)
Cont = True
hSearch = FindFirstFile(path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
DirName = StripNulls(WFD.cFileName)
' Ignore the current and encompassing directories.
If (DirName <> ".") And (DirName <> "..") Then
' Check for directory with bitwise comparison.
If GetFileAttributes(path & DirName) And _
FILE_ATTRIBUTE_DIRECTORY Then
dirNames(nDir) = DirName
DirCount = DirCount + 1
nDir = nDir + 1
ReDim Preserve dirNames(nDir)
' Uncomment the next line to list directories
'List1.AddItem path & FileName
End If
End If
Cont = FindNextFile(hSearch, WFD) ' Get next subdirectory.
Loop
Cont = FindClose(hSearch)
End If
' Walk through this directory and sum file sizes.
hSearch = FindFirstFile(path & SearchStr, WFD)
Cont = True
If hSearch <> INVALID_HANDLE_VALUE Then
While Cont
FileName = StripNulls(WFD.cFileName)
If (FileName <> ".") And (FileName <> "..") And _
((GetFileAttributes(path & FileName) And _
FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * _
MAXDWORD) + WFD.nFileSizeLow
FileCount = FileCount + 1
' To list files w/o dates, uncomment the next line
' and remove or Comment the lines down to End If
'List1.AddItem path & FileName
' Include Creation date...
FileTimeToLocalFileTime WFD.ftCreationTime, FT
FileTimeToSystemTime FT, ST
DateCStr = ST.wMonth & "/" & ST.wDay & "/" & ST.wYear & _
" " & ST.wHour & ":" & ST.wMinute & ":" & ST.wSecond
' and Last Modified Date
FileTimeToLocalFileTime WFD.ftLastWriteTime, FT
FileTimeToSystemTime FT, ST
DateMStr = ST.wMonth & "/" & ST.wDay & "/" & ST.wYear & _
" " & ST.wHour & ":" & ST.wMinute & ":" & ST.wSecond
List1.AddItem path & FileName & vbTab & _
Format(DateCStr, "mm/dd/yyyy hh:nn:ss") _
& vbTab & Format(DateMStr, "mm/dd/yyyy hh:nn:ss")
End If
Cont = FindNextFile(hSearch, WFD) ' Get next file
Wend
Cont = FindClose(hSearch)
End If
' If there are sub-directories...
If nDir > 0 Then
' Recursively walk into them...
For i = 0 To nDir - 1
FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) _
& "\", SearchStr, FileCount, DirCount)
Next i
End If
End Function
Private Sub Command1_Click()
Dim SearchPath As String, FindStr As String
Dim FileSize As Long
Dim NumFiles As Integer, NumDirs As Integer
Screen.MousePointer = vbHourglass
List1.Clear
SearchPath = Text1.Text
FindStr = Text2.Text
FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
Text3.Text = NumFiles & " Files found in " & NumDirs + 1 & _
" Directories"
Text4.Text = "Size of files found under " & SearchPath & " = " & _
Format(FileSize, "#,###,###,##0") & " Bytes"
Screen.MousePointer = vbDefault
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Drive1_Change()
Dir1.path = Drive1.Drive
End Sub
Private Sub Form_Load()
End Sub
5. Form5
Private Sub back_Click()
On Error Resume Next
WebBrowser1.GoBack
End Sub
Private Sub Command1_Click()
On Error Resume Next
WebBrowser1.Navigate (Text1.Text)
End Sub
Private Sub Command2_Click()
End Sub
Private Sub exit_Click()
Unload Me
End Sub
Private Sub forward_Click()
On Error Resume Next
WebBrowser1.GoForward
End Sub
Private Sub home_Click()
On Error Resume Next
WebBrowser1.GoHome
End Sub
Private Sub refresh_Click()
On Error Resume Next
WebBrowser1.refresh
End Sub
Private Sub WebBrowser1_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
On Error Resume Next
If Progress = -1 Then ProgressBar1.Value = 100
Label1.Caption = "Done"
ProgressBar1.Visible = False
If Progress > 0 And ProgressMax > 0 Then
ProgressBar1.Visible = True
Image1.Visible = False
ProgressBar1.Value = Progress * 100 / ProgressMax
Label1.Caption = "Loading... " & Int(Progress * 100 / ProgressMax) & "%"
End If
Exit Sub
End Sub
6. Modul1
Declare Function FindFirstFile Lib "kernel32" Alias _
"FindFirstFileA" (ByVal lpFileName As String, lpFindFileData _
As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function GetFileAttributes Lib "kernel32" Alias _
"GetFileAttributesA" (ByVal lpFileName As String) As Long
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) _
As Long
Declare Function FileTimeToLocalFileTime Lib "kernel32" _
(lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Declare Function FileTimeToSystemTime Lib "kernel32" _
(lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Public Const MAX_PATH = 260
Public Const MAXDWORD = &HFFFF
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Public Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, _
InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function
tiba saat.a pada penutup saya ucapkan banyak terimakasih telah membaca blog saya, saya harap setelah membaca posting saya, anda akan bahagia dan brtambah ilmu.. amin.. ^_^..
