form1.frm

Billing Internet Cafe

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Remote Server"
   ClientHeight    =   645
   ClientLeft      =   45
   ClientTop       =   405
   ClientWidth     =   3030
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   43
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   202
   Visible         =   0   'False
   Begin VB.TextBox Text1 
      Height          =   285
      Left            =   1200
      TabIndex        =   4
      Top             =   240
      Width           =   1575
   End
   Begin VB.PictureBox picCursor 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   480
      Left            =   1095
      Picture         =   "Form1.frx":000C
      ScaleHeight     =   32
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   32
      TabIndex        =   1
      Top             =   1140
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.PictureBox picTmp 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   360
      Left            =   540
      ScaleHeight     =   24
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   22
      TabIndex        =   0
      Top             =   1185
      Visible         =   0   'False
      Width           =   330
   End
   Begin MSWinsockLib.Winsock sckCommand 
      Left            =   75
      Top             =   1125
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   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            =   75
      TabIndex        =   3
      Top             =   300
      Width           =   315
   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            =   465
      TabIndex        =   2
      Top             =   330
      Width           =   630
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Public SrcPath As String
Public IsReceived As Boolean
Dim Quality As Long

Private Sub Form_Load()
On Error Resume Next
sckCommand.Close
sckCommand.LocalPort = FrmMain.TxtNo_Client.Text
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 FILE_BERIKUTNYA
          IsReceived = True
    Case FILE_OK
          SendFile
    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