📄 frm_main.frm
字号:
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Century Gothic"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin XPControls.XPButton cmd_refreshcap
Height = 615
Left = 480
TabIndex = 34
Top = 5040
Width = 1695
_ExtentX = 2990
_ExtentY = 1085
Caption = "Refresh"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Century Gothic"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin XPControls.XPButton cmd_addcap
Height = 375
Left = 3360
TabIndex = 33
Top = 720
Width = 1215
_ExtentX = 2143
_ExtentY = 661
Caption = "Tambah"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Century Gothic"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.ListBox lst_cap
Appearance = 0 'Flat
BackColor = &H00FFFFC0&
Height = 2670
Left = 240
TabIndex = 16
Top = 1680
Width = 4335
End
Begin VB.TextBox txt_blokcap
Appearance = 0 'Flat
BackColor = &H00FFFFC0&
Height = 285
Left = 240
TabIndex = 17
Top = 720
Width = 3015
End
Begin VB.Label Label9
BackStyle = 0 'Transparent
Caption = "Daftar caption yang sedang di blokir"
Height = 255
Left = 120
TabIndex = 21
Top = 1320
Width = 3135
End
Begin VB.Label Label8
BackStyle = 0 'Transparent
Caption = "Masukan caption yang akan diblokir"
Height = 255
Left = 240
TabIndex = 20
Top = 360
Width = 3615
End
Begin VB.Label Label7
BackStyle = 0 'Transparent
Caption = "Jumlah caption yang diblokir : "
Height = 255
Left = 240
TabIndex = 19
Top = 4560
Width = 2415
End
Begin VB.Label lbl_jmlcap
BackStyle = 0 'Transparent
Caption = "00"
BeginProperty Font
Name = "Century Gothic"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2760
TabIndex = 18
Top = 4560
Width = 615
End
End
Begin VB.Image Image1
Height = 6240
Left = 0
Picture = "frm_main.frx":030A
Stretch = -1 'True
Top = 0
Width = 8040
End
Begin VB.Menu mnu
Caption = ""
Visible = 0 'False
Begin VB.Menu show
Caption = "Show"
End
Begin VB.Menu about
Caption = "About"
End
End
End
Attribute VB_Name = "frmblock"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmd_about_Click()
Load frm_about
frm_about.show
End Sub
Private Sub cmd_add_Click()
Dim cari As Long
If Text1.Text = "" Then
MsgBox "Anda belum memasukan situs yang akan diblokir", vbInformation + vbOKOnly, "The P * * N Blocker"
Exit Sub
End If
For cari = 0 To List1.ListCount - 1
If Text1.Text = List1.list(cari) Then
MsgBox "Situs yang anda masukan sudah ada dalam daftar situs yang diblokir", vbInformation + vbOKOnly, "The P * * N Blocker"
Exit Sub
End If
Text1.SetFocus
Next
List1.AddItem Text1.Text
Text1.Text = ""
SaveFileHost List1, GetSystemPath & "\drivers\etc\Hosts"
lbl_jml.Caption = List1.ListCount
End Sub
Private Sub cmd_addcap_Click()
Dim cari As Long
If txt_blokcap.Text = "" Then
MsgBox "Anda belum memasukan caption yang akan diblokir", vbInformation + vbOKOnly, "The P * * N Blocker"
Exit Sub
End If
For cari = 0 To lst_cap.ListCount - 1
If txt_blokcap.Text = lst_cap.list(cari) Then
MsgBox "Caption yang anda masukan sudah ada dalam daftar caption yang diblokir", vbInformation + vbOKOnly, "The P * * N Blocker"
txt_blokcap.SetFocus
Exit Sub
End If
Next
lst_cap.AddItem txt_blokcap.Text
txt_blokcap.Text = ""
SaveCaption lst_cap, App.Path & "\list.blc"
lbl_jmlcap.Caption = lst_cap.ListCount
End Sub
Private Sub cmd_admin_Click()
Frame1.Visible = False
Frame1.Enabled = False
Frame2.Enabled = True
Frame2.Visible = True
Framecap.Visible = False
Framecap.Enabled = False
End Sub
Private Sub cmd_atur_Click()
Frame1.Visible = True
Frame1.Enabled = True
Frame2.Enabled = False
Frame2.Visible = False
Framecap.Visible = False
Framecap.Enabled = False
lbl_jml.Caption = List1.ListCount
End Sub
Private Sub cmd_aturcap_Click()
Frame1.Visible = False
Frame1.Enabled = False
Frame2.Enabled = False
Frame2.Visible = False
Framecap.Visible = True
Framecap.Enabled = True
lbl_jmlcap.Caption = lst_cap.ListCount
End Sub
Private Sub cmd_default_Click()
If MsgBox("Apakah anda yakin", vbInformation + vbYesNo, "The P * * N Blocker") = vbYes Then
Open App.Path & "\pass.blc" For Output As #1
Print #1, "y4d0y666"
Close #1
Check1.value = 1
Check2.value = 1
kill_task.Enabled = True
kill_task.interval = 100
MsgBox "Settingan default berhasil dilakukan" & vbNewLine & "Password default anda adalah y4d0y666" & vbNewLine & "Jangan lupa untuk menggantinya", vbInformation + vbOKOnly, "The P * * N Blocker"
Else
Exit Sub
End If
End Sub
Private Sub cmd_delcap_Click()
If lst_cap.ListIndex = -1 Then
MsgBox "Anda belum memilih situs yang akan dihapus", vbInformation + vbOKOnly, "The P * * N Blocker"
Exit Sub
End If
lst_cap.RemoveItem (lst_cap.ListIndex)
HapusCaption lst_cap, App.Path & "\list.blc"
Call cmd_refreshcap_Click
lbl_jmlcap.Caption = lst_cap.ListCount
End Sub
Private Sub cmd_exit_Click()
If MsgBox("Apakah anda yakin ingin keluar dari aplikasi ini?" & vbNewLine & "Keluar dari aplikasi ini berarti proses pemblokiran dihentikan", vbInformation + vbYesNo, "The P * * N Blocker") = vbYes Then
TrayDelete
backup
Kill App.Path & "\kill.bat"
Unload Me
Else
Exit Sub
End If
End Sub
Private Sub cmd_hapus_Click()
If List1.ListIndex = -1 Then
MsgBox "Anda belum memilih situs yang akan dihapus", vbInformation + vbOKOnly, "The P * * N Blocker"
Exit Sub
End If
List1.RemoveItem (List1.ListIndex)
hapus List1, GetSystemPath & "\drivers\etc\Hosts"
Call cmd_refresh_Click
lbl_jml.Caption = List1.ListCount
End Sub
Private Sub cmd_hide_Click()
Me.Hide
App.TaskVisible = False
ilang.Enabled = True
End Sub
Private Sub cmd_refresh_Click()
List1.Clear
LoadFileHost List1, GetSystemPath & "\drivers\etc\Hosts"
Text1.Text = ""
Text1.SetFocus
lbl_jml.Caption = List1.ListCount
End Sub
Private Sub cmd_refreshcap_Click()
lst_cap.Clear
Load_Caption lst_cap, App.Path & "\list.blc"
txt_blokcap.Text = ""
txt_blokcap.SetFocus
lbl_jmlcap.Caption = lst_cap.ListCount
End Sub
Private Sub cmd_save_seting_Click()
If Check1.value = 0 Then
kill_task.Enabled = False
kill_task.interval = 0
Else
kill_task.Enabled = True
kill_task.interval = 100
End If
End Sub
Private Sub cmd_set_Click()
If txtpwd.Text = "" Then
MsgBox "Anda belum memasukan password", vbInformation + vbOKOnly, "The P * * N Blocker"
Exit Sub
End If
Open App.Path & "\pass.blc" For Output As #1
Print #1, txtpwd.Text
Close #1
MsgBox "Password berhasil disimpan" & vbNewLine & "password anda saat ini adalah :" & txtpwd.Text, vbInformation + vbOKOnly, "The P * * N Blocker"
txtpwd.Text = ""
txtpwd.SetFocus
End Sub
Private Sub Form_Load()
mulai
TrayAdd hwnd, Picture1.Picture, "Porn Blocker", MouseMove
Frame1.Visible = True
Frame1.Enabled = True
Frame2.Enabled = False
Frame2.Visible = False
Framecap.Visible = False
Framecap.Enabled = False
LoadFileHost List1, GetSystemPath & "\drivers\etc\Hosts"
lbl_jml.Caption = List1.ListCount
lst_cap.Clear
Load_Caption lst_cap, App.Path & "\list.blc"
lbl_jmlcap.Caption = lst_cap.ListCount
buat_kill
End Sub
Private Sub Form_Unload(Cancel As Integer)
TrayDelete
backup
Kill App.Path & "\kill.bat"
End Sub
Private Sub Frame1_Click()
Text1.SetFocus
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim cEvent As Single
cEvent = x / Screen.TwipsPerPixelX
Select Case cEvent
Case MouseMove
Debug.Print "MouseMove"
Case LeftUp
Debug.Print "Left Up"
Case LeftDown
Debug.Print "LeftDown"
Case LeftDbClick
Debug.Print "LeftDbClick"
Case MiddleUp
Debug.Print "MiddleUp"
Case MiddleDown
Debug.Print "MiddleDown"
Case MiddleDbClick
Debug.Print "MiddleDbClick"
Case RightUp
Debug.Print "RightUp": PopupMenu mnu
Case RightDown
Debug.Print "RightDown"
Case RightDbClick
Debug.Print "RightDbClick"
End Select
End Sub
Private Sub ilang_Timer()
On Error Resume Next
Dim bunuh As Long
frmblock.Hide
App.TaskVisible = False
For bunuh = 0 To lst_cap.ListCount - 1
kill_IE (lst_cap.list(bunuh))
Tonjok (lst_cap.list(bunuh))
Next
End Sub
Private Sub kill_task_Timer()
Hajar "TASK MANAGER"
Hajar "CMD"
Hajar "Command Prompt"
End Sub
Private Sub buat_kill()
Open App.Path & "\kill.bat" For Output As #1
Print #1, "taskkill /f /im iexplore.exe"
Close #1
End Sub
Private Sub show_Click()
frm_pass.Visible = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -