module1.bas

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

Attribute VB_Name = "Module1"
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Public NowJF As Boolean
Public SysComputerNum As Long
Public NoDelFormatComm As Boolean
'抓图声明
Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long


Declare Function SystemParametersInfoByRef Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long

Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long


Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long

Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Type iGoods
     Index As Long
     商品编号 As String
     商品名称 As String
     零售价格 As Double
End Type
Public Goods() As iGoods
Public GoodCount As Long

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
        (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
        ByVal lpsz2 As String) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _
        ByVal nCmdShow As Long) As Long

'定义窗口以及子窗口的类名
Public Const sTrayWindow = "Shell_TrayWnd"
Public Const sTrayNotify = "TrayNotifyWnd"
Public Const sStartButton = "Button"
Public Const sAppSwitchBar = "ReBarWindow32"
Public Const sAppSwitch = "MSTaskSwWClass"
Public Const sAppIcon = "ToolbarWindow32"
Public Const sTrayClock = "TrayClockWClass"
Public Const sDesktopIcon = "ShellDll_DefView"
Public Const sProgman = "Progman"

Public Const SW_SHOW = 5
Public Const SW_HIDE = 0


Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) 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 ReleaseCapture Lib "user32" () As Long
Type tHttp
   Name As String
   Host As String
End Type
Public QuickHttp() As tHttp
Public HickHttp() As String
Public HickHttpCount As Long
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long

Public Declare Function GetCurrentProcess Lib "kernel32" () As Long

Public Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long

Sub Main()
On Error Resume Next
Dim pid As Long, reserv As Long, pOld As Boolean
SystemParametersInfoByRef 97, True, pOld, 0


pid = GetCurrentProcessId()
reserv = RegisterServiceProcess(pid, 1)
 frmButton.Show
End Sub

Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
   On Error Resume Next
    Dim s As String
    
    s = String(80, 0)
    Call GetWindowText(hwnd, s, 80)
    s = Left(s, InStr(s, Chr(0)) - 1)
    s = UCase(s)
    If Len(s) > 0 Then
          
      If (InStr(1, s, "删除") Or InStr(1, s, "格式化") Or InStr(1, s, "DEL") Or InStr(1, s, "INTERNET 选项") Or InStr(1, s, "INTERNET 属性")) And NoDelFormatComm Then
          ' PostMessage hwnd, &H10, 0, 0&
       Else
           If InStr(1, s, "网吧记费器客户版") = 0 And InStr(1, s, "DEFAULT IME") = 0 Then
           frmButton.List1.AddItem s
           frmButton.List1.ItemData(frmButton.List1.NewIndex) = hwnd
           End If
      End If

    End If
    
    EnumWindowsProc = True
   ' frmLabel.Flash
End Function

Sub ShutDown()
'关机
'  If MsgBox("确实要关闭电脑吗？ 建议您保存所有工作后再关机。", vbYesNo + vbCritical, "电话本：关闭电脑 ") = vbYes Then
   ExitWindowsEx &H1, 4
 ' End If

End Sub

Sub Reset()
'重启
 'If MsgBox("确实要重新启动计算机吗？ 建议您保存所有工作后再关机。", vbYesNo + vbCritical, "电话本：关闭电脑 ") = vbYes Then
 
  ExitWindowsEx &H2, 4
 'End If
End Sub

Sub SockCommand(str As String)
'接收命令
On Error Resume Next
Dim comm As String, cc As Integer
   Dim pOld As Boolean
       Dim thisStr() As String
      
    cc = 0
    ReDim Preserve thisStr(cc) As String

    For i = 1 To Len(str)
        ab$ = Mid(str, 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
'cc = 0
'For i = 1 To Len(str)
'a$ = Mid(str, i, 1)

' If a$ = Chr(0) Then
' cc = cc + 1
' Else
' If cc = 1 Then comm = comm + a$
' End If
'Next i
Select Case thisStr(1)
Case "shutdown" '关机
  frmButton.Winsock1.Close
  DoEvents
  ShutDown
Case "reset" '重新启动
   frmButton.Winsock1.Close
   DoEvents
   Reset
Case "pause" '进入暂停
  frmMain.Label1 = "当前计算机正处于暂停状态，你想做什么？"
  ShowFrmMain
Case "stop" '停止记费
  'frmMain.Label1 = "当前计算机正处于等待状态，你想做什么？"
  'frmMain.Combo1.List(0) = "开始记费"
  NowJF = False
  'ShowFrmMain
  HideTray
  SystemParametersInfoByRef 97, True, pOld, 0

  'frmMain.Combo1_Click
  'ShowFrmMain
Case "start" '开始记费
  NowJF = True
              '根据任务栏窗口句柄获得子窗口的句柄
            '    wnd = FindWindow(sTrayWindow, vbNullString)
SystemParametersInfoByRef 97, False, pOld, 0

           ' wnd = FindWindowEx(wnd, 0, sStartButton, vbNullString)
  'ShowWindow wnd, SW_SHOW
    ShowTray


Case "setup" '设置系统
 frmSetup.Show vbModal, frmMain
Case "clearhistory" '清除历史记录
Case "settext" '设置提示
    SaveSetting "网吧记费器", "Set", "GetWord", thisStr(2)
    frmLabel.Label1 = thisStr(2)
    frmLabel.Flash
Case "close" '关闭程序
 frmButton.Winsock1.Close
 
 'pd = Shell_NotifyIcon(NIM_DELETE, myNID)
 SystemParametersInfoByRef 97, False, pOld, 0
Unload frmButton
 End
End Select
End Sub

Sub EditRegs(iStr As String)
'修改注册表
Dim cc As Integer, r1(5) As String
 For i = 1 To Len(iStr)
  a$ = Mid(iStr, i, 1)
  If a$ = Chr(0) Then
    cc = cc + 1
  Else
    r1(cc) = r1(cc) + a$
  End If
 Next i
' MsgBox r1(5)
 Select Case Val(r1(4))
 Case 1, 2, 7
  e = RegSaveStringValue(Val(r1(1)), r1(2), r1(3), Val(r1(4)), r1(5))
 Case 3, 4, 5
  e = RegSaveNumberValue(Val(r1(1)), r1(2), r1(3), Val(r1(4)), Val(r1(5)))

 End Select
 'MsgBox e
End Sub

Sub ShowFrmMain()

    frmMain.LoadScreen
 frmMain.Show
 SetWindowPos frmMain.hwnd, -1, 0, 0, 0, 0, 1 Or 2
 SetWindowPos frmMain.hwnd, -2, 0, 0, 0, 0, 1 Or 2
    SystemParametersInfoByRef 97, True, pOld, 0
    DoEvents
    BringWindowToTop frmMain.hwnd

End Sub

Sub ShowTray()
'显示任务栏
Dim wnd As Long
    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 Sub

Sub HideTray()
'隐去任务栏
Dim wnd As Long
    wnd = FindWindow(sTrayWindow, vbNullString)

            '根据任务栏窗口句柄获得子窗口的句柄
            wnd = FindWindowEx(wnd, 0, sStartButton, vbNullString)
  ShowWindow wnd, SW_HIDE
      wnd = FindWindow(sTrayWindow, vbNullString)

            wnd = FindWindowEx(wnd, 0, sTrayNotify, vbNullString)
 ShowWindow wnd, SW_HIDE
    wnd = FindWindow(sTrayWindow, vbNullString)
            
            wnd = FindWindowEx(wnd, 0, sAppSwitchBar, vbNullString)
            wnd = FindWindowEx(wnd, 0, sAppSwitch, vbNullString)
 ShowWindow wnd, SW_HIDE
    wnd = FindWindow(sTrayWindow, vbNullString)
            
            wnd = FindWindowEx(wnd, 0, sTrayNotify, vbNullString)
            wnd = FindWindowEx(wnd, 0, sTrayClock, vbNullString)
ShowWindow wnd, SW_HIDE
            '获取桌面的窗口句柄
    wnd = FindWindow(sTrayWindow, vbNullString)
            
            wnd = FindWindow(sProgman, vbNullString)
            wnd = FindWindowEx(wnd, 0, sDesktopIcon, vbNullString)
ShowWindow wnd, SW_HIDE
    wnd = FindWindow(sTrayWindow, vbNullString)
            
            wnd = FindWindowEx(wnd, 0, sAppSwitchBar, vbNullString)
            wnd = FindWindowEx(wnd, 0, sAppIcon, vbNullString)
ShowWindow wnd, SW_HIDE
End Sub