home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD124481272000.psc / mdWinProc.bas < prev    next >
Encoding:
BASIC Source File  |  2000-12-08  |  3.6 KB  |  100 lines
  1. Attribute VB_Name = "mdWinProc"
  2. Option Explicit
  3.  
  4. 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
  5.  
  6.  
  7. '**********************************
  8. Public DataInBuffer As Boolean
  9. Public e_err As Variant
  10. Public e_errstr As Variant
  11. '**********************************
  12.  
  13. Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  14. Dim sckCurrentCommand As String
  15.  
  16. Dim x As Long
  17. Dim wp As Integer
  18. Dim temp As Variant
  19. Dim ReadBuffer(1000) As Byte
  20. Dim DataFlag As Boolean
  21. Dim DataBuffer As Variant
  22. Dim plpPrevWndProc As Long
  23.  
  24.  
  25.  
  26. 'Debug.Print uMsg, wParam, lParam
  27.     
  28.     Select Case uMsg
  29.         
  30.         Case 1025:
  31.             
  32.             e_err = WSAGetAsyncError(lParam)
  33.             e_errstr = GetWSAErrorString(e_err)
  34.             
  35.             If e_err <> 0 Then
  36.             '********** Error *********
  37.                 gLog.Log "Error String returned -> " & e_err & " - " & e_errstr, hw
  38.                 gLog.Log "Terminating....", hw
  39.                
  40.                 'Exit Function
  41.             
  42.             End If
  43.             
  44.             Select Case lParam
  45.             
  46.                 Case FD_READ: 'lets check for data
  47.                             
  48.                         If gRegistredForms(Hex(hw)).LastCommand <> "" Then
  49.                            'Command Pending
  50.                            sckCurrentCommand = gRegistredForms(Hex(hw)).LastCommand
  51.                            gRegistredForms(Hex(hw)).LastCommand = ""
  52.                         
  53.                         ElseIf gRegistredForms(Hex(hw)).LastCommand = "DATA" Then
  54.                                DataFlag = True
  55.                         End If
  56.                         
  57.  
  58.                         x = recv(gRegistredForms(Hex(hw)).SocketPointer, ReadBuffer(0), 1000, 0) 'try to get some
  59.                         
  60.                         If x > 0 Then 'was there any?
  61.                             
  62.                             ReadFlag = False
  63.                             
  64.                             RecvBuffer = StrConv(ReadBuffer, vbUnicode) 'yep, lets change it to stuff we can understand
  65.                             
  66.                             gLog.Log RecvBuffer, hw
  67.                             gSocketData.Log sckCurrentCommand, RecvBuffer, hw
  68.                             
  69.                             gSocketData.SetData RecvBuffer, hw
  70.                             
  71.                             'rtncode = Mid(RecvBuffer, 1, 3)
  72.                             DataInBuffer = True
  73.                         
  74.                         End If
  75.                 
  76.                 Case FD_CONNECT: 'did we connect?
  77.                         
  78.                       gLog.Log "Connection Established... :" & lParam, hw
  79.                       gRegistredForms(Hex(hw)).SocketPointer = wParam 'yep, we did! yayay
  80.  
  81.                 Case FD_OOB:
  82.                                                 
  83.                       'gSocketData.SetData(recv  , hw
  84.                         
  85.                 Case FD_CLOSE: 'uh oh. they closed the connection
  86.                       
  87.                     Call closesocket(wp)   'so we need to close
  88.                     gLog.Log "CLS-Connection Closed By Peer", hw
  89.             
  90.             End Select
  91.     
  92.     End Select
  93.     
  94.     plpPrevWndProc = gRegistredForms(Hex(hw)).PreviousWinProc
  95.     'let the msg get through to the form
  96.     
  97.     WindowProc = CallWindowProc(plpPrevWndProc, hw, uMsg, wParam, lParam)
  98.  
  99. End Function
  100.