www.pudn.com > PackSock.rar > Module2.bas

Attribute VB_Name = "Module2" 
Option Explicit 
 
 
Public Const GWL_WNDPROC = (-4) 
 
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long 
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
 
'保存原来的窗口消息钩子的处理入口 
Public lpPrevWndProc As Long 
 
Public hPackSock As Long 
Public hPackSockAccept As Long 
Public hPackSockClient As Long 
 
 
Public lpServerBuf() As Byte 
Public ServerBufSize As Long 
 
Public lpClientBuf() As Byte 
Public ClientBufSize As Long 
 
'安装消息钩子 
Public Sub Hook(ByVal gHW As Long) 
  If lpPrevWndProc <> 0 Then Exit Sub 
  lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc) 
End Sub 
 
'取下消息钩子 
Public Sub Unhook(ByVal gHW As Long) 
  If lpPrevWndProc = 0 Then Exit Sub 
  Call SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc) 
  lpPrevWndProc = 0 
End Sub 
 
'消息处理过程 
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
  If hwnd = Form1.hwnd Then 
    Select Case uMsg 
      Case WM_USER_ACCEPT: 
        Call OnAccept(wParam, lParam) 
      Case WM_USER_CLOSED: 
        Call OnClosed(wParam, lParam) 
      Case WM_USER_FILERECEIVED: 
        Call OnFileRecived(wParam, lParam) 
      Case WM_USER_CONNECTED: 
        Call OnConnected(wParam, lParam) 
      Case WM_USER_FILESENT: 
        Call OnFileSent(wParam, lParam) 
    End Select 
  End If 
  WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam) 
End Function 
 
Public Function OnAccept(ByVal wParam As Long, ByVal lParam As Long) 
  Sock_Accept hPackSock, hPackSockAccept 
  Form1.txtServer = Form1.txtServer & Now & "  OnAccept  " & vbCrLf 
End Function 
 
Public Function OnClosed(ByVal wParam As Long, ByVal lParam As Long) 
  Form1.txtServer = Form1.txtServer & Now & "  OnClosed  " & vbCrLf 
End Function 
 
Public Function OnFileRecived(ByVal wParam As Long, ByVal lParam As Long) 
  Dim buf() As Byte 
  Dim datalen As Long 
  Dim I As Long 
  Dim strTmp As String 
   
  datalen = lParam 
  ReDim buf(datalen) As Byte 
  Sock_GetReceivedData hPackSockAccept, buf(0), datalen 
 
'  strTmp = buf(0) & buf(datalen - 1) 
   
'  Form1.txtServer = Form1.txtServer & Now & "  OnFileRecived  " & vbCrLf 
'  Form1.txtServer = Form1.txtServer & Now & "  datalen= " & datalen & " , data's flag is:  " & strTmp & vbCrLf 
   
  Static kk As Long 
  kk = kk + 1 
  If kk = 800 Then 
    Form1.Caption = "okokokokokokokokok" 
  End If 
End Function 
 
Public Function OnConnected(ByVal wParam As Long, ByVal lParam As Long) 
  Form1.txtServer = Form1.txtServer & Now & "  OnConnected  " & vbCrLf 
End Function 
 
Public Function OnFileSent(ByVal wParam As Long, ByVal lParam As Long) 
'  Form1.txtServer = Form1.txtServer & Now & "  OnFileSent  " & vbCrLf 
End Function