Posted by : Arief Hilman Nugraha Saturday, April 13, 2013

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.. ^_^..

Leave a Reply

Subscribe to Posts | Subscribe to Comments

Welcome to My Blog

Berlangganan Lewat Email

Subscribe via Email

Translate

Lagu

- Copyright © Arief Hilman Nugraha - Robotic Notes - Disponsori Oleh Blogger - Editing by Arief Hilman Nugraha -