Elektroda.pl
Elektroda.pl
X
Proszę, dodaj wyjątek www.elektroda.pl do Adblock.
Dzięki temu, że oglądasz reklamy, wspierasz portal i użytkowników.

[vba] Czytanie danych TCP/IP

szeryf_wojciech 23 Mar 2010 18:48 1218 0
  • #1 23 Mar 2010 18:48
    szeryf_wojciech
    Poziom 12  

    Witam,

    Z programowaniem w VBA miałem jak do tej pory bardzo mało styczności i dzisiaj takie coś mnie dopadło. Znalazłem skrypt, który czyta dane TCP/IP (urządzenie podpięte do routera, router do mojego komputera, na komputerze makro). Jako że nie znam składni VBA i nie mogę znaleźć tematu pokrewnego pisze na forum. Problem:

    - przy próbie uruchomienia makra dostaje komunikat, że została uzyta opcja Explicit. Opcja ta wymaga zdefinowania zmiennych
    - Komunikat pojawia się przy Private Sub CmdClose_Click() -> Wschat.Close

    wg mnie wygląda to następująco: skrypt nie widzi funkcji Wschat.Close, bo zdefinowana jest Wschat_Close(). Nie wiem czy mój tok rozumowania jest właściwy. Będę wdzięczny za jakąkolwiek pomoc.

    Skrypt wygląda tak:

    Code:


    Option Explicit
    '12/11/08 RL: communication with E+L CanServer
    Public n As Integer

    Private Sub CmdClose_Click()
    'Disable the outgoing buttons and tell the user
    'that the connection has been closed
      Wschat_Close
      CmdClose.Enabled = False
      txtPort.Enabled = True
      cmdConnect.Enabled = True
      Sheet1.CommandButton1.BackColor = &HFF&
      Feuil1.CommandButton1.BackColor = &HFF&
     
    End Sub

    Private Sub cmdConnect_Click()
    'Before we can connect, we should check to see
    'if there is an IP and name for the user.

    n = 4
    Sheet1.CommandButton1.BackColor = &HFF00&
    Feuil1.CommandButton1.BackColor = &HFF00&

    If txtIP.Text = "" Or txtPort.Text = "" Then
        MsgBox "You must enter both an IP and Port!", vbCritical, "Error!"
        txtPort.SetFocus
        Exit Sub
      End If

      On Error Resume Next
      'Connecting the IP that is placed in the txtIP.text value.
      wsChat.Close
      wsChat.Connect txtIP.Text, txtPort.Text
      CmdClose.Enabled = True
      cmdConnect.Enabled = False
      txtPort.Enabled = False
    End Sub

    Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)

    End Sub

    Private Sub Label1_Click()

    End Sub

    Private Sub txtIP_Change()

    End Sub

    Private Sub Wschat_AfterUpdate()

    End Sub

    Private Sub Wschat_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

    End Sub


    Private Sub Wschat_Close()

    End Sub

    Private Sub wsChat_Connect()

      Do
        DoEvents
      Loop Until wsChat.State = sckConnected Or wsChat.State = sckError





      If wsChat.State = sckConnected Then
        'Tell the user that the connection has been established
        txtPort.Enabled = False
      Else
        'Tell the user that the connection has been established
      End If

    End Sub

    Private Sub wsChat_ConnectionRequest(ByVal requestID As Long)
      wsChat.Close
      wsChat.Accept requestID
      'If the remote system requests a connection, accept it and connect

      'Tell the user that the connection has been established
      CmdClose.Enabled = True
      txtPort.Enabled = False
      'txtOut.SetFocus
    End Sub
    Private Sub wsChat_DataArrival(ByVal bytesTotal As Long)
    'This function is called if data is available at the socket
    Dim incoming() As Byte

    On Error GoTo ErrorLabel  'error handling

      'Read incoming data
    wsChat.GetData incoming


      'Select Sheet1 as spreadsheet
    Dim ws As Worksheet

    Set ws = Sheets("data sheet")

      'Extract here some sample data and write them to a cell in the spreadsheet

    Dim lParam As Long, ucParam As Byte
    ws.Cells(4, 6) = n

    lParam = GetLong(incoming, 0, True)
    ws.Cells(n, 1) = lParam

    lParam = GetLong(incoming, 4, True)
    ws.Cells(n, 2) = lParam

    lParam = GetLong(incoming, 8, True)
    ws.Cells(n, 3) = lParam

    lParam = GetLong(incoming, 12, True)
    ws.Cells(n, 4) = lParam

    lParam = GetLong(incoming, 16, True)
    ws.Cells(n, 5) = lParam

        If n > 300 Then
            n = 4
          Else
            n = n + 1
        End If

    Exit Sub  'Leave function here if no error has occured

    ErrorLabel:
      Call CmdClose_Click
      MsgBox (Err.Description)
      Err.Clear
     
    End Sub

    Private Sub Wschat_Enter()

    End Sub

    Private Sub Wschat_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    If Number <> 0 Then
    'AddText "----- Error [" & Description & "] -----" & vbCrLf
    MsgBox "Problčme de connection avec Canserver", vbInformation + vbOKOnly, "Problčme de transmission"

    Call CmdClose_Click
    End If
    End Sub

    Private Sub Wschat_SendComplete()

    End Sub


    Private Sub Wschat_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)

    End Sub


    0 0