fungsi.bas

Billing Internet Cafe

Attribute VB_Name = "Fungsi"
Public Declare Function GetSystemDirectory Lib "kernel32.dll" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long


Public Const WM_CLOSE = &H10

Public IP As String, Situs As String
Public x As String, Judul As String

Public Sub LoadFileHost(list As ListBox, Namafile As String)
Dim linestr As String, tmp() As String
On Error Resume Next
    Open Namafile For Input As #1
        While Not EOF(1)
          Line Input #1, linestr
        tmp = Split(linestr, "       ")
        IP = tmp(0)
        Situs = tmp(1)
        DoEvents
            list.AddItem Situs
        Wend
    Close #1
End Sub
Public Sub Load_Caption(list As ListBox, Namafile As String)
Dim linestr As String, tmp() As String
On Error Resume Next
Open Namafile For Input As #1
    While Not EOF(1)
        Line Input #1, linestr
        Judul = linestr
    DoEvents
        list.AddItem Judul
    Wend
Close #1
End Sub


Public Sub SaveFileHost(list As ListBox, place As String)
On Error Resume Next
Dim simpan As Long
    Open place For Output As #1
        For simpan = 0 To list.ListCount - 1
            Print #1, "127.0.0.1       " & list.list(simpan)
        Next
    Close #1
End Sub
Public Sub SaveCaption(list As ListBox, place As String)
On Error Resume Next
Dim simpan As Long
    Open place For Output As #1
        For simpan = 0 To list.ListCount - 1
            Print #1, list.list(simpan)
        Next
Close #1
End Sub


Public Sub hapus(list As ListBox, place As String)
On Error Resume Next
Dim hapus As Long
Open place For Output As #1
  For hapus = 0 To list.ListCount - 1
    Print #1, "127.0.0.1       " & list.list(hapus)
  Next
Close #1
End Sub

Public Sub HapusCaption(list As ListBox, place As String)
On Error Resume Next
Dim hapus As Long
Open place For Output As #1
    For hapus = 0 To list.ListCount - 1
        Print #1, list.list(hapus)
    Next
Close #1
End Sub


Public Sub backup()
FileCopy GetSystemPath & "\Drivers\etc\Hosts", App.Path & "\back.blc"
Open GetSystemPath & "\Drivers\etc\Hosts" For Output As #1
    Print #1, "127.0.0.1          localhost"
Close #1
End Sub
Public Sub mulai()
On Error Resume Next
FileCopy App.Path & "\back.blc", GetSystemPath & "\Drivers\etc\Hosts"
FileCopy App.Path & "back.blc", GetSystemPath & "\Drivers\etc\Hosts"

End Sub


Public Function GetSystemPath() As String

On Error Resume Next
Dim Buffer As String * 255
Dim x As Long
    x = GetSystemDirectory(Buffer, 255)
    GetSystemPath = Left(Buffer, x) & "\"
    
End Function

Public Function Hajar(target As String)
Dim h As Long
Dim t As String * 255
h = GetForegroundWindow
GetWindowText h, t, 255
If InStr(UCase(t), UCase(target)) > 0 Then
    SendMessage h, WM_CLOSE, 0, 0
MsgBox "Maaf perintah yang anda jalankan sementara di nonaktifkan", vbInformation + vbOKOnly, "Nonaktif"
End If
End Function


Public Sub Tonjok(target As String)
Dim h As Long
Dim t As String * 255
h = GetForegroundWindow
GetWindowText h, t, 255

If InStr(UCase(t), UCase(target)) > 0 Then
    SendMessage h, WM_CLOSE, 0, 0
End If
End Sub

Public Sub kill_IE(target As String)
Dim h As Long
Dim t As String * 255
h = GetForegroundWindow
GetWindowText h, t, 255

If InStr(UCase(t), UCase(target)) > 0 Then
Shell App.Path & "\kill.bat", vbHide
End If
End Sub