Attribute VB_Name = "TcpIP"
'
'   !------------------------------------------------------------------------!
'   !  Modul: TcpIP.bas                                                      !
'   !------------------------------------------------------------------------!
'   !                                                                        !
'   !                                                   !
'   !                                                                        !
'   !------------------------------------------------------------------------!
'   !  Datum    ! Name        ! Abt.    ! Aenderung                          !
'   !------------------------------------------------------------------------!
'   !  09.02.05 ! Mahler      ! CoSoMa  ! Erstellung                         !
'   !------------------------------------------------------------------------!

'   Ein Programm benötigt TcpIP.bas und TcpServ.frm
'
'   Project\Components das Winsock Control 6.0 anwählen
'   Ein Element dieses Controls mit Name TcpServ auf einer Form einfügen
'   Mit SetupServer (Portnummer) eine Verbindung aufbauen
'   Portnummer muss die gleiche Protnummer wie im Hardwareprofil der S7 sein

'   Beispiel Senden
'Function Senden() As Integer
'Dim PLC As Integer
'Dim DB As Integer
'Dim DBB As Integer
'Dim anz As Integer
'Dim ret As Integer
'Dim daten(100) As Byte

'  daten(1) = 1
'  daten(2) = 2
'  daten(3) = 3
'  daten(4) = 4
'  daten(5) = 5
'  daten(6) = 6
'  daten(7) = 7
'  daten(8) = 8
  
'  Do
'  ret = WritePLC(11, 60, 50, 10, daten)
'  DoEvents
'  Loop While ret = False
'End Function


'Mit FetchPLc kann man Daten von der S7 anfordern.
'Die Steuerung antwortet mit einem Telegramm

Option Explicit

Global MSG_Debug As Object
Global msgDebug As Integer
Global Const MAXTCP = 20
Global CloseSocketIndex As Long

Type tcpI
      Index As Integer
      ID As Long
      PCU As Integer
      Status As Integer
      Timer As Integer
      DB As Integer
      DBB As Integer
      anz As Integer
End Type
Global tcpIndex(MAXTCP) As tcpI

Public Function SetupServer(Optional ByVal localPort As Long = 2001) As Boolean
   
   On Error GoTo fSetup
   
   CloseSocketIndex = -1
   
   With MP_Remote.Winsock(0)
        
        .Close
        .RemotePort = 0
        .localPort = localPort
        
        .Listen
        
   End With
   
   SetupServer = True
     
   If msgDebug > 100 Then
   'MSG_Debug.AddItem "TcpIP-Server eingerichtet - Rechner: " + Rechner + " User: " + User + " Port: " + Format(MP_Remote.Winsock(0).localPort, "0000") + " TcpIP-Adr.: " + MP_Remote.Winsock(0).LocalIP
   End If
   
   Exit Function
   
fSetup:

   SetupServer = False
   
  If msgDebug > 100 Then
  'MSG_Debug.AddItem "TcpIP-Servereinrichtung fehlgeschlagen - Rechner: " + Rechner + " User: " + User
  End If
   
End Function


'Daten vom Client anfordern
Public Function FetchPLC(PLC As Integer, DB As Integer, DBB As Integer, anzahl As Integer) As Integer
   Dim Index As Integer
   Dim Data(15) As Byte
   Dim i As Integer
   
   If PLC = 0 Then
      Index = tcpIndex(0).Index
   Else
      Index = GetPCUIndex(PLC)
   End If
   
   If tcpIndex(Index).Status = 0 Then
   
   'Kopf
   Data(0) = val("S")
   Data(1) = val("5")
   Data(2) = 16
   Data(3) = 1
   Data(4) = 3
   Data(5) = 5
   Data(6) = 3
   Data(7) = 8
   
   'Org-Kennung
   Data(8) = 1
   
   'DB-Nummer
   Data(9) = DB
   tcpIndex(Index).DB = DB
   
   'DBB
   Data(10) = DBB / 256
   Data(11) = DBB And &HFF
   tcpIndex(Index).DBB = DBB
   
   'anz
   Data(12) = anzahl / 256
   Data(13) = anzahl And &HFF
   tcpIndex(Index).anz = anzahl
   
   'Endekennung
   Data(14) = 255
   Data(15) = 2
   
     MP_Remote.Winsock(Index).SendData Data
   
   
     FetchPLC = True
     tcpIndex(Index).Status = 1
     
     MP_Remote.Timer1.Enabled = True
     
     If msgDebug > 0 Then
     MSG_Debug.AddItem "Fetch - ID: " + Format(PLC, "000") _
                                      + " / " + Format(DB, "000") _
                                      + " / " + Format(DBB, "0000") _
                                      + " / " + Format(anzahl, "0000") _
                                      + " Status: Anfrage an den Koppelpartner"
     End If
    
   Else
     'Auftrag nicht möglich da Schnittstelle belegt
     FetchPLC = False
     
   End If
   
End Function
'Daten an Client senden
Public Function WritePLC(PLC As Integer, DB As Integer, DBB As Integer, anzahl As Integer, daten() As Byte) As Integer
   Dim Index As Integer
   Dim Data(4120) As Byte
   Dim i As Integer
   Dim text As String
   
   
   If PLC = 0 Then
      Index = tcpIndex(0).Index
   Else
      Index = GetPCUIndex(PLC)
   End If
   
   Index = 1
   
   If Index = 0 Then
     WritePLC = True
     Exit Function
   End If
   
   If tcpIndex(Index).Status = 0 Then
   
   'Kopf
   Data(0) = val("S")
   Data(1) = val("5")
   Data(2) = 16
   Data(3) = 1
   Data(4) = 3
   Data(5) = 5
   Data(6) = 3
   Data(7) = 8
   
   'Org-Kennung
   Data(8) = 1
   
   'DB-Nummer
   Data(9) = DB
   tcpIndex(Index).DB = DB
   
   'DBB
   Data(11) = DBB / 256
   Data(10) = DBB And &HFF
   tcpIndex(Index).DBB = DBB
   
   'anz
   Data(13) = anzahl / 256
   Data(12) = anzahl And &HFF
   tcpIndex(Index).anz = anzahl
   
   'Endekennung
   Data(14) = 255
   Data(15) = 2
   
   'Nutzdaten
   For i = 16 To anzahl + 16
      Data(i) = daten(i - 15)
   Next i
   
   For i = 1 To 30
     text = text + Format(Hex(daten(i)), "00") + " "
   Next i
   
   
   MP_Remote.Winsock(Index).SendData (Data)
  
     WritePLC = True
     tcpIndex(Index).Status = 11
     
     MP_Remote.Timer1.Enabled = True
     
     If msgDebug > 0 Then
     MSG_Debug.AddItem "Write - ID: " + Format(PLC, "000") _
                                      + " / " + Format(DB, "000") _
                                      + " / " + Format(DBB, "0000") _
                                      + " / " + Format(anzahl, "0000") _
                                      + " Inhalt: " + text
     End If
    
   Else
     'Auftrag nicht möglich da Schnittstelle belegt
     WritePLC = False
     
   End If
   
End Function

'Daten vom Client anfordern
Public Function ReceivePLC(daten As Variant, ByVal anzahl As Integer) As Integer
   Dim typ As Integer
   Dim feh As Integer
   
   typ = daten(5)
   feh = daten(8)
   
   'Quittung auf Write
   If typ = 4 Then
   
   End If
   
   'Quittung auf Fetch
   If typ = 6 Then
   
   End If
   
End Function


Function GetPCUIndex(ByVal PCU As Integer) As Integer
    Dim i As Integer
    
   
    For i = 1 To MAXTCP
       If tcpIndex(i).PCU = PCU Then
          GetPCUIndex = tcpIndex(i).Index
          Exit For
       End If
    Next i
    
End Function

