Source Code Program. A. Form Utama. Dim IEWin As ciewindows

Source Code Program A. Form Utama Dim IEWin As cIEWindows Private Sub Check1_Click() If Check1.Value = "RunAtStartUp", 0) Then Command3.Enabled = False Else Command3.Enabled = True End If End Sub

GetSetting("Spy",

"Settings",

Private Sub Command1_Click() If Command1.Caption = "Aktif" Then Set IEWin = New cIEWindows AddToLog vbCrLf & vbTab & vbTab & vbTab & "Spy Activated " & Now Command1.Caption = "Non Aktif" Label2 = "Status: Aktif" Command2.Caption = "Sembunyikan" Else Set IEWin = Nothing AddToLog vbTab & vbTab & vbTab & "Spy Deactivated " & Now Command1.Caption = "Aktif" Label2 = "Status: Pasif" Command2.Caption = "Close" End If End Sub Private Sub Command2_Click() If Command2.Caption = "Close" Then Unload Me Else Me.Hide End If End Sub Private Sub Command3_Click() Dim objWSHShell As Object Set objWSHShell = CreateObject("WScript.Shell") Command3.Enabled = False Call SaveSetting("InternetSpy", "Settings", "LogFile", Text1.Text) Call SaveSetting("InternetSpy", "Settings", "RunAtStartUp", CStr(Check1.Value)) sFile = Text1 If Check1.Value = 1 Then objWSHShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\InternetSpy ", App.Path & "\" & "InternetSpy.exe" Else On Error Resume Next objWSHShell.RegDelete "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\GetSound" On Error GoTo 0 End If

Universitas Sumatera Utara

Set objWSHShell = Nothing End Sub Private Sub Form_Load() App.TaskVisible = False Me.Hide Command3.Caption = "Apply" Command3.Enabled = False Label2 = "Status: Aktif" Command1.Caption = "Non aktif" Command2.Caption = "Sembunyikan" Text1 = GetSetting("InternetSpy", "Settings", "LogFile", "c:\Spylog.txt") Check1.Value = GetSetting("InternetSpy", "Settings", "RunAtStartUp", 0) sFile = Text1 Set IEWin = Nothing Set IEWin = New cIEWindows AddToLog vbCrLf & vbTab & vbTab & vbTab & "Spy Activated " & Now & vbCrLf SetHotKey hwnd, MOD_CONTROL + MOD_SHIFT, vbKeyP End Sub Private Sub Form_Unload(Cancel As Integer) RemoveHotKey Set IEWin = Nothing End Sub Private Sub Label1_Click() End Sub Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single) End Sub Private Sub Text1_Change() If Text1 = GetSetting("InternetSpy", "Settings", "LogFile", "c:\Spylog.txt") Then Command3.Enabled = False Else Command3.Enabled = True End If End Sub

B. Module Hot Key Private Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long Private Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As Integer Private Declare Function GlobalDeleteAtom Lib "kernel32" (ByVal nAtom As Integer) As Integer Private Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long

Universitas Sumatera Utara

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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Const GWL_WNDPROC = (-4) Const WM_HOTKEY = &H312 Public Enum ModKeys MOD_ALT = &H1 MOD_CONTROL = &H2 MOD_SHIFT = &H4 MOD_WIN = &H8 End Enum Dim iAtom As Integer Dim OldProc As Long, hOwner As Long Public sFile As String Public Function SetHotKey(hWin As Long, ModKey As ModKeys, vKey As Long) As Boolean If hOwner > 0 Then Exit Function hOwner = hWin iAtom = GlobalAddAtom("MyHotKey") SetHotKey = RegisterHotKey(hOwner, iAtom, ModKey, vKey) OldProc = SetWindowLong(hOwner, GWL_WNDPROC, AddressOf WndProc) End Function Public Sub RemoveHotKey() If hOwner = 0 Then Exit Sub Call UnregisterHotKey(hOwner, iAtom) Call SetWindowLong(hOwner, GWL_WNDPROC, OldProc) End Sub Public Function WndProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If wMsg = WM_HOTKEY And wParam = iAtom Then Form1.Show Else WndProc = CallWindowProc(OldProc, hwnd, wMsg, wParam, lParam) End If End Function Public Sub AddToLog(sText As String) Dim nFile As Integer nFile = FreeFile Open sFile For Append As #nFile Print #nFile, sText Close #nFile End Sub

C. Class Windows

Universitas Sumatera Utara

Private WithEvents winShell As SHDocVw.ShellWindows Private mCol As Collection Dim bRefreshing As Boolean, bInit As Boolean Private Function Add(IEctl As SHDocVw.InternetExplorer) IE_Class Dim objNewMember As IE_Class Set objNewMember = New IE_Class Set objNewMember.IEctl = IEctl mCol.Add objNewMember Set Add = objNewMember Set objNewMember = Nothing End Function

As

Public Property Get IE(vntIndexKey As Variant) As IE_Class Do While bRefreshing DoEvents Loop Set IE = mCol(vntIndexKey) End Property Public Property Get Count() As Long Count = mCol.Count End Property Private Sub Remove(vntIndexKey As Variant) mCol.Remove vntIndexKey End Sub Public Property Get NewEnum() As IUnknown Set NewEnum = mCol.[_NewEnum] End Property Private Sub Class_Initialize() Refresh_Col End Sub Private Sub Class_Terminate() Set mCol = Nothing Set winShell = Nothing End Sub Private Sub winShell_WindowRegistered(ByVal lCookie As Long) Refresh_Col Do While bRefreshing DoEvents Loop End Sub Private Sub winShell_WindowRevoked(ByVal lCookie As Long) Refresh_Col Do While bRefreshing DoEvents Loop End Sub Private Sub Refresh_Col() bRefreshing = True Dim SWs As New SHDocVw.ShellWindows

Universitas Sumatera Utara

Dim Set Set For

var As SHDocVw.InternetExplorer mCol = Nothing mCol = New Collection Each var In SWs Add var Next If Not bInit Then Set winShell = SWs bInit = True Set SWs = Nothing Set var = Nothing bRefreshing = False End Sub

D. Calss Internet Explorer Private WithEvents IE As SHDocVw.InternetExplorer Private bDownloading As Boolean Public Property Set IEctl(IncomeIE As SHDocVw.InternetExplorer) Set IE = IncomeIE End Property Private Sub Class_Terminate() ' On Error Resume Next Set IE = Nothing End Sub Private Sub IE_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean) Dim s As String If Not bDownloading Then s = Time & vbTab & "Navigation begin." s = s & vbCrLf & vbTab & "URL = " & CStr(URL) AddToLog s End If bDownloading = True End Sub Private Sub IE_DocumentComplete(ByVal pDisp As Object, URL As Variant) Dim s As String If pDisp Is IE Then s = Time & vbTab & "Documente complete." s = s & vbCrLf & vbTab & "URL = " & IE.LocationURL Do While IE.Busy DoEvents Loop s = s & vbCrLf & vbTab & "Location = " & IE.LocationName AddToLog s bDownloading = False End If End Sub Private Sub IE_DownloadBegin() Dim s As String If Not bDownloading Then s = Time & vbTab & "Navigation begin." s = s & vbCrLf & vbTab & "URL = " & IE.LocationURL

Universitas Sumatera Utara

AddToLog s End If bDownloading = True End Sub

Universitas Sumatera Utara

SURAT KETERANGAN Hasil Uji Program Tugas Akhir

Yang bertanda tangan dibawah ini, menerangkan bahwa Mahasiswa Tugas Akhir Program Diploma 3 Ilmu Komputer/Statistika :

Nama

:

Muhammad Reza Fauzi

NIM

:

072406130

Prog. Studi

:

Ilmu Komputer

Judul TA

:

Program Aplikasi Pencatatan History Dari Web Browser Untuk Memudahkan Orangtua Mengawasi Anak – anaknya Ketika Menggunakan Internet

Telah melaksanakan test program Tugas Akhir Mahasiswa tersebut di atas pada tanggal……………………….

Dengan Hasil :

Sukses / Gagal

Demikian diterangkan untuk digunakan melengkapi syarat pendaftaran Ujian Meja Hijau Tugas Akhir Mahasiswa bersangkutan di Departemen Matematika FMIPA USU Medan.

Medan,

Mei 2010

Dosen Pembimbing

Drs. Suyanto M.Kom NIP 19590813 198601 1002

Universitas Sumatera Utara

KEMENTERIAN PENDIDIKAN NASIONAL

UNIVERSITAS SUMATERA UTARA FAKULTAS MATEMATIKA DAN ILMU PENGETAHUAN ALAM(FMIPA)

Jl. Bioteknologi No.1 Kampus USU Telp. (061) 8211050 Fax (061) 8214290 MEDAN – 20155, Email : [email protected]

KARTU BIMBINGAN TUGAS AKHIR MAHASISWA

Nama Mahasiswa

: Muhammad Reza Fauzi

Nomor Stambuk

: 072406130

Judul Tugas Akhir

: Program Aplikasi Pencatatan History Dari Web Browser Mengawasi

Untuk

Memudahkan Orangtua

Anak

–

anaknya

Ketika

Menggunakan Internet Dosen Pembimbing

: Drs. Suyanto, M.Kom

Tanggal Mulai Bimbingan

:

Tanggal Selesai Bimbingan : No

*

TANGGAL ASISTEN BIMBINGAN

PEMBAHASAN PADA ASISTENSI MENGENAI, PADA BAB

PARAF DOSEN KETERANGAN PEMBIMBING

Kartu ini harap dikembalikan ke Departemen Matematika bila bimbingan telah selesai. Diketahui: Ketua Departemen Matematika FMIPA USU,

Disetujui Pembimbing Utama/ Penanggung Jawab

Dr. Saib Suwilo M.Sc

Drs. Suyanto, M.Kom

NIP. 19640109 198803 1 004

NIP. 19590813 198601 1002

Universitas Sumatera Utara