frmbutton.frm

能用的网吧计费管理系统(客户端).zip

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmButton 
   BorderStyle     =   0  'None
   ClientHeight    =   360
   ClientLeft      =   120
   ClientTop       =   120
   ClientWidth     =   795
   ControlBox      =   0   'False
   Icon            =   "frmButton.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   360
   ScaleWidth      =   795
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.ListBox List1 
      Height          =   960
      Left            =   360
      TabIndex        =   0
      Top             =   240
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.Timer tmrKey 
      Interval        =   100
      Left            =   600
      Top             =   240
   End
   Begin MSWinsockLib.Winsock Winsock1 
      Left            =   0
      Top             =   0
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Image Image1 
      Height          =   345
      Left            =   0
      Picture         =   "frmButton.frx":000C
      Top             =   0
      Width           =   765
   End
   Begin VB.Menu cdHTTP 
      Caption         =   "cd"
      Visible         =   0   'False
      Begin VB.Menu cdQuickHTTP1 
         Caption         =   "鼎智网"
      End
      Begin VB.Menu cdQuickHTTP 
         Caption         =   "-"
         Index           =   0
      End
   End
End
Attribute VB_Name = "frmButton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim WithEvents IEWin As cIEWindows
Attribute IEWin.VB_VarHelpID = -1

Dim dx As New DirectX7
Dim di As DirectInput
Dim diDEV As DirectInputDevice
Dim diState As DIKEYBOARDSTATE
Dim iKeyCounter As Integer
Dim aKeys(255) As String
Dim iStr As String




Private Sub cdQuickHTTP_Click(Index As Integer)
ShellExecute hwnd, "Open", QuickHttp(Index).Host, "", SystemPath, 1

End Sub

Private Sub cdQuickHTTP1_Click()
ShellExecute hwnd, "Open", "http://www.dingwisdom.com", "", SystemPath, 1
End Sub

Private Sub IEWin_IENavigationBegin(hwnd As Long, ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
On Error Resume Next

     For i = 1 To HickHttpCount - 1
      If InStr(1, UCase(URL), UCase(HickHttp(i))) Then
         IEWin.IE(CStr(hwnd)).IEctl.Quit
  '       MsgBox "管理员已经禁止访问这些内容，如果仍要访问，请和管理员联系！"
         Exit Sub
      End If
     Next i
End Sub

Private Sub IEWin_IENavigationComplete(hwnd As Long, ByVal pDisp As Object, URL As Variant)
 On Error Resume Next
      For i = 1 To HickHttpCount - 1
      If InStr(1, UCase(IEWin.IE(CStr(hwnd)).IEctl.LocationName), UCase(HickHttp(i))) Or InStr(1, UCase(IEWin.IE(CStr(hwnd)).IEctl.LocationURL), UCase(HickHttp(i))) Or InStr(1, UCase(IEWin.IE(CStr(hwnd)).IEctl.StatusText), UCase(HickHttp(i))) Then
        IEWin.IE(CStr(hwnd)).IEctl.Quit
        Exit Sub
      End If
     Next i

End Sub


Public Sub Flash()

 SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3 Or &H10
End Sub




Private Sub Form_Load()
If App.PrevInstance = True Then End

Me.Left = 30
Me.Top = Screen.Height - Me.Height
Me.Show
Me.Flash
  On Error Resume Next
          '初始化
If App.PrevInstance = True Then End

'frmButton.Show

HideTray

frmLabel.Label1 = GetSetting("网吧记费器", "Set", "GetWord", "网吧记费器客户版")
frmLabel.Show

          NoDelFormatComm = Val(GetSetting("网吧记费器", "Set", "NoDelFormatComm", "0"))
          SysComputerNum = Val(GetSetting("网吧记费器", "Set", "SysComputerNum", "0"))

          Winsock1.Close
          Winsock1.RemoteHost = GetSetting("网吧记费器", "Set", "IP", "")
            If SysComputerNum = 0 Or Winsock1.RemoteHost = "" Then
                MsgBox "计算机设置错误或主机IP地址错误！", vbCritical + vbSystemModal
                frmSetup.Show
            End If
            Winsock1.Close
          Winsock1.RemotePort = 14914
          Winsock1.Connect


    Set di = dx.DirectInputCreate '()
        
    'If Err.Number <> 0 Then
    '    MsgBox "Error starting Direct Input, please make sure you have DirectX installed" + vbCrLf + Error, vbSystemModal
       
    'End If
        
        
    Set diDEV = di.CreateDevice("GUID_SysKeyboard")
    
    diDEV.SetCommonDataFormat DIFORMAT_KEYBOARD
    diDEV.SetCooperativeLevel Me.hwnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
    
    'Me.Show
    
    diDEV.Acquire
        
    tmrKey.Interval = 10
    tmrKey.Enabled = True
 SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 1 Or 2
 'SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 1 Or 2
      '    MsgBox Winsock1.State
frmLabel.Show
frmLabel.Flash

Me.Flash
  
  Set IEWin = New cIEWindows


End Sub



Private Sub Form_Unload(Cancel As Integer)
    Dim wnd As Long
            '根据任务栏窗口句柄获得子窗口的句柄
            wnd = FindWindow(sTrayWindow, vbNullString)
            
            wnd = FindWindowEx(wnd, 0, sStartButton, vbNullString)
            ShowWindow wnd, SW_SHOW
            
            wnd = FindWindow(sTrayWindow, vbNullString)
            
            wnd = FindWindowEx(wnd, 0, sTrayNotify, vbNullString)
            ShowWindow wnd, SW_SHOW
            
            wnd = FindWindow(sTrayWindow, vbNullString)
            
            wnd = FindWindowEx(wnd, 0, sAppSwitchBar, vbNullString)
            wnd = FindWindowEx(wnd, 0, sAppSwitch, vbNullString)
            ShowWindow wnd, SW_SHOW
            
            wnd = FindWindow(sTrayWindow, vbNullString)
            
            wnd = FindWindowEx(wnd, 0, sTrayNotify, vbNullString)
            wnd = FindWindowEx(wnd, 0, sTrayClock, vbNullString)
            ShowWindow wnd, SW_SHOW
            
            wnd = FindWindow(sTrayWindow, vbNullString)
            
            '获取桌面的窗口句柄
            wnd = FindWindow(sProgman, vbNullString)
            wnd = FindWindowEx(wnd, 0, sDesktopIcon, vbNullString)
            ShowWindow wnd, SW_SHOW
            
            wnd = FindWindow(sTrayWindow, vbNullString)
            
            wnd = FindWindowEx(wnd, 0, sAppSwitchBar, vbNullString)
            wnd = FindWindowEx(wnd, 0, sAppIcon, vbNullString)
            ShowWindow wnd, SW_SHOW
            End
End Sub

Private Sub Image1_Click()
 frmMenu.Show
 'Me.Flash
End Sub

Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image1.BorderStyle = 1
End Sub

Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image1.BorderStyle = 0
End Sub

Private Sub Winsock1_Close()
On Error Resume Next
'Command1.Enabled = False
'Command2.Enabled = False
'Combo1.Enabled = False
'Image2.Enabled = False
'Label4.Caption = "与服务器联接失败，请待联接..."
'LoadScreen
'ShowFrmMain
'DoEvents
 '  Dim pOld As Boolean
 '  SystemParametersInfoByRef 97, True, pOld, 0
 '   DoEvents
 '   BringWindowToTop frmMain.hwnd
Winsock1.Close
Winsock1.RemoteHost = GetSetting("网吧记费器", "Set", "IP", "")
Winsock1.RemotePort = 14914
Winsock1.Connect

End Sub

Private Sub Winsock1_Connect()
'On Error Resume Next
'Command1.Enabled = True
'Command2.Enabled = True
'Combo1.Enabled = True
'Image2.Enabled = True
'If Combo1.List(0) = "结帐" Then Me.Hide
Winsock1.SendData "_sele" + Chr(0) + CStr(SysComputerNum)
DoEvents
'Combo1_Click
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
  On Error Resume Next
    Dim stri As String
    Winsock1.GetData stri '接收数据
    If Right(stri, 4) <> Chr(0) + "OK$" Then
      iStr = iStr + stri
      Exit Sub
     Else
      iStr = iStr + Left(stri, Len(stri) - 4)
      
    End If
  '  MsgBox Left(str, 5)

StartCommand iStr
End Sub


Private Sub tmrKey_Timer()
   On Error Resume Next
   Dim pOld As Boolean
 
'寻找有破坏性的程序并关闭
    List1.Clear
    EnumWindows AddressOf EnumWindowsProc, 0&
'
    diDEV.GetDeviceStateKeyboard diState
    If (diState.Key(29) Or diState.Key(157)) And (diState.Key(56) Or diState.Key(184)) Then
      
    SystemParametersInfoByRef 97, True, pOld, 0
 
        If diState.Key(211) <> 0 And (diState.Key(29) Or diState.Key(157)) And (diState.Key(56) Or diState.Key(184)) Then
          ShowFrmMain
        End If
    Else
     If Me.Visible = False Then SystemParametersInfoByRef 97, False, pOld, 0
    End If
    DoEvents

 SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3 Or &H10
End Sub


Sub StartCommand(LocateStr As String)
'处理主机的信息
On Error Resume Next
Do
inin = InStr(1, LocateStr, Chr(0) + "OK$")
If inin = 0 Then
 Exit Do
Else
  StartCommand Left(LocateStr, inin)
  LocateStr = Mid(LocateStr, inin + 4, Len(LocateStr) - inin - 4)
End If
Loop


    Dim thisStr() As String

Select Case Left(LocateStr, 5)
Case "_talk"
 If frmChat.IsLogin = True Then
    frmChat.XianShi LocateStr
 End If
Case "_comm"
 SockCommand LocateStr
Case "_good"

Case "_gets"

      
    cc = 0
    ReDim Preserve thisStr(cc) As String

    For i = 1 To Len(LocateStr)
        ab$ = Mid(LocateStr, i, 1)
        If ab$ = Chr(0) Then
            cc = cc + 1
            ReDim Preserve thisStr(cc) As String
        Else
            thisStr(cc) = thisStr(cc) + ab$
        End If
     Next i
    Select Case thisStr(1)
    Case "good"
    GoodCount = (cc - 2) / 3
    ReDim Goods(GoodCount) As iGoods
    
     For i = 1 To GoodCount
     Goods(i).Index = i
     Goods(i).商品编号 = thisStr(i * 3 - 1)
     Goods(i).商品名称 = thisStr(i * 3)
     Goods(i).零售价格 = Val(thisStr(i * 3 + 1))
  '  MsgBox Goods(i).商品名称
     Next i
     frmShangPin.Show
    End Select
Case "_ereg"
 
 EditRegs LocateStr
Case "_sets"

Case "_vali"

Case "_prog"
    cc = 0
                ReDim Preserve thisStr(cc) As String

    For i = 1 To Len(LocateStr)
        ab$ = Mid(LocateStr, i, 1)
        If ab$ = Chr(0) Then
            cc = cc + 1
            ReDim Preserve thisStr(cc) As String
        Else
            thisStr(cc) = thisStr(cc) + ab$
        End If
     Next i
 Select Case thisStr(1)
 Case "get"
 pp = "_prog"
 For i = 0 To List1.ListCount - 1
  pp = pp + Chr(0) + List1.List(i) + Chr(0) + CStr(List1.ItemData(i))
 Next i
 Winsock1.SendData pp
 DoEvents
' MsgBox List1.ListCount
 Case "close"
  'hWnd = Val(thisStr(2))
     SetForegroundWindow Val(thisStr(2))
    PostMessage Val(thisStr(2)), &H10, 0, 0&

 End Select
Case "_msgb" '接到信息
 'If Me.Visible = False Then unHook
 'Winsock1.LocalHostName
  MsgBox Right(LocateStr, Len(LocateStr) - 6), vbQuestion + vbSystemModal
 
 'If Me.Visible = False Then Hook
Case "_http"
    cc = 0: bb = 0
    ReDim Preserve QuickHttp(bb) As tHttp

    For i = 1 To Len(LocateStr)
        ab$ = Mid(LocateStr, i, 1)
        
        If ab$ = Chr(0) Then
            cc = cc + 1
            If Int(cc / 2) = cc / 2 Then
            Else
            bb = bb + 1
            ReDim Preserve QuickHttp(bb) ' As String
            End If
        Else
            If Int(cc / 2) <> cc / 2 Then
             QuickHttp(bb).Name = QuickHttp(bb).Name + ab$
            Else
             QuickHttp(bb).Host = QuickHttp(bb).Host + ab$
            End If
        End If
     Next i
     For i = 1 To cdQuickHTTP.Count - 1
      Unload cdQuickHTTP(i)
     Next i
     For i = 1 To bb - 1
          Load cdQuickHTTP(i)
      cdQuickHTTP(i).Caption = QuickHttp(i).Name
  
  '    MsgBox QuickHttp(i).Name, , i
      Next i
Case "_hick"
   bb = 0
   ReDim Preserve HickHttp(bb) As String
   For i = 1 To Len(LocateStr)
     ab$ = Mid(LocateStr, i, 1)
     If ab$ = Chr(0) Then
      bb = bb + 1
      ReDim Preserve HickHttp(bb) As String
      HickHttpCount = bb
     Else
      HickHttp(bb) = HickHttp(bb) + ab$
     End If
   Next i
  For Each tmpIE In IEWin
   'MsgBox tmpIE.IEctl.LocationURL
      For i = 1 To HickHttpCount - 1
      If InStr(1, UCase(tmpIE.IEctl.LocationName), UCase(HickHttp(i))) Or InStr(1, UCase(tmpIE.IEctl.LocationURL), UCase(HickHttp(i))) Or InStr(1, UCase(tmpIE.IEctl.StatusText), UCase(HickHttp(i))) Then
        tmpIE.IEctl.Quit
      End If
     Next i
   Next
End Select
LocateStr = ""



End Sub