frmradmin.frm

Billing Internet Cafe

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmradmin 
   Caption         =   "Form1"
   ClientHeight    =   6495
   ClientLeft      =   60
   ClientTop       =   420
   ClientWidth     =   6675
   LinkTopic       =   "Form1"
   ScaleHeight     =   6495
   ScaleWidth      =   6675
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox picTmp 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   360
      Left            =   465
      ScaleHeight     =   24
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   22
      TabIndex        =   1
      Top             =   885
      Visible         =   0   'False
      Width           =   330
   End
   Begin VB.PictureBox picCursor 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   480
      Left            =   1020
      Picture         =   "frmradmin.frx":0000
      ScaleHeight     =   32
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   32
      TabIndex        =   0
      Top             =   840
      Visible         =   0   'False
      Width           =   480
   End
   Begin MSWinsockLib.Winsock sckCommand 
      Left            =   0
      Top             =   825
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Label lblStatus 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Ready..."
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   390
      TabIndex        =   3
      Top             =   30
      Width           =   630
   End
   Begin VB.Label lblAnim 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "[\]"
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   225
      Left            =   0
      TabIndex        =   2
      Top             =   0
      Width           =   315
   End
End
Attribute VB_Name = "frmradmin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Download from www.vbbego.com
'Copyright by vbBeGo 2005
'Code by @jie
'----------------------------
Option Explicit
Public SrcPath As String
Public IsReceived As Boolean
Dim Quality As Long

Private Sub Form_Load()
sckCommand.Close
sckCommand.LocalPort = "1982"
sckCommand.Listen
picTmp.Move 0, 0, Screen.Width, Screen.Height
End Sub

Private Sub sckCommand_Close()
lblStatus.Caption = "Ready..."
sckCommand.Close
sckCommand.Listen
End Sub

Private Sub sckCommand_ConnectionRequest(ByVal requestID As Long)
sckCommand.Close
sckCommand.Accept requestID
lblStatus.Caption = "Connected from " & sckCommand.RemoteHostIP
End Sub
Private Sub sckCommand_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
AnimasiLabel
    Dim recBuffer As String, sParam, pt As POINTAPI
    sckCommand.GetData recBuffer
    Select Case LCase(Left(recBuffer, 6))
    Case KEY_DOWN
         keybd_event Val(Mid(recBuffer, 7)), 0, KEYEVENTF_KEYDOWN, 0
    Case KEY_UP
         keybd_event Val(Mid(recBuffer, 7)), 0, KEYEVENTF_KEYUP, 0
    Case MOUSE_MOVE
         sParam = Split(Mid(recBuffer, 7), ":")
         SetCursorPos Val(CStr(sParam(0))), Val(CStr(sParam(1)))
    Case MOUSE_RIGHT_DOWN
         GetCursorPos pt
         mouse_event MOUSEEVENTF_RIGHTDOWN, pt.x, pt.y, 0, 0
    Case MOUSE_LEFT_DOWN
         GetCursorPos pt
         mouse_event MOUSEEVENTF_LEFTDOWN, pt.x, pt.y, 0, 0
    Case MOUSE_MID_DOWN
         GetCursorPos pt
         mouse_event MOUSEEVENTF_MIDDLEDOWN, pt.x, pt.y, 0, 0
    Case MOUSE_RIGHT_UP
         GetCursorPos pt
         mouse_event MOUSEEVENTF_RIGHTUP, pt.x, pt.y, 0, 0
    Case MOUSE_LEFT_UP
         GetCursorPos pt
         mouse_event MOUSEEVENTF_LEFTUP, pt.x, pt.y, 0, 0
    Case MOUSE_MID_UP
         GetCursorPos pt
         mouse_event MOUSEEVENTF_MIDDLEUP, pt.x, pt.y, 0, 0
    Case FILE_BERIKUTNYA
          IsReceived = True
    Case FILE_OK
          SendFile
    Case QUALITY_FILE
         Quality = Val(Mid(recBuffer, 7))
    Case MULAI_KIRIM_FILE
        Dim C As cDIBSection
        Set C = New cDIBSection
        IsReceived = True
        picTmp.Width = Screen.Width / Screen.TwipsPerPixelX
        picTmp.Height = Screen.Height / Screen.TwipsPerPixelY
        PrintScreen picTmp, , , False, True
        C.CreateFromPicture2 picTmp.Picture
        SrcPath = "C:\remote.put"
        Kill SrcPath
        sckCommand.SendData INFO_FILE
        If Quality <= 0 Or Quality > 100 Then
           Quality = 20
        End If
        Call SaveJPG(C, SrcPath, Quality)
        picTmp.Cls
        picTmp.Picture = Nothing
    End Select
End Sub

Sub SendFile()
    Dim BufFile As String
    Dim LnFile As Long
    Dim nLoop As Long
    Dim nRemain As Long
    Dim Cn As Long
    
    'On Error GoTo GLocal:
    LnFile = FileLen(SrcPath)
    If LnFile > 8198 Then
        nLoop = Fix(LnFile / 8198)
        nRemain = LnFile Mod 8198
    Else
        nLoop = 0
        nRemain = LnFile
    End If
    
    If LnFile = 0 Then
        Exit Sub
    End If
    
    Open SrcPath For Binary As #1
    If nLoop > 0 Then
        For Cn = 1 To nLoop
            BufFile = String(8198, " ")
            Get #1, , BufFile
            sckCommand.SendData BufFile
            IsReceived = False
            While IsReceived = False
                DoEvents
            Wend
        Next
        If nRemain > 0 Then
            BufFile = String(nRemain, " ")
            Get #1, , BufFile
            sckCommand.SendData BufFile
            IsReceived = False
            While IsReceived = False
                DoEvents
            Wend
        End If
    Else
        BufFile = String(nRemain, " ")
        Get #1, , BufFile
        sckCommand.SendData BufFile
        IsReceived = False
        While IsReceived = False
            DoEvents
        Wend
    End If
    sckCommand.SendData FILE_DITERIMA
    Close #1
    Exit Sub
GLocal:
'On Error Resume Next
    Close #1
End Sub


Sub AnimasiLabel()
If lblAnim.Caption = "[\]" Then
   lblAnim.Caption = "[|]"
ElseIf lblAnim.Caption = "[|]" Then
   lblAnim.Caption = "[/]"
ElseIf lblAnim.Caption = "[/]" Then
   lblAnim.Caption = "[-]"
ElseIf lblAnim.Caption = "[-]" Then
   lblAnim.Caption = "[\]"
End If
End Sub