examplestation.bas

PLC相关-656M.zip

Attribute VB_Name = "ExampleStation"
Option Explicit

' TEIL: S T A T I O N

Public Function GetStationTypeStr(T As S7StationType) As String
    Dim str As String
    
    Select Case T
        'Eigentlich sollte die 3 folgenden Zeilen funktionieren.
        'Case S7300Station: str = "S7300Station"
        'Case S7400Station: str = "S7400Station"
        'Case S7HStation: str = "S7HStation"
        'Doch leider gibt ein S7Station-Objekt einen anderen Typwert
        'zurueck. Dieses Manko wird sicherlich in der naechsten Version
        'behoben sein. Dann werden auch die Konstanten S7300, S7400 und
        'S7400H nicht mehr existieren.
        
        Case S7300: str = "S7300Station"
        Case S7400: str = "S7400Station"
        Case S7400H: str = "S7400H"
        Case Else: str = "I don't know"
    End Select
    
    GetStationTypeStr = str
End Function


Public Sub AllStationData(Sta As S7Station)
On Error Resume Next
    Dim str As String
    str = "Name: " & Sta.Name & Chr(13) & _
          "LogPath: " & Sta.LogPath & Chr(13) & _
          "Type: " & GetStationTypeStr(Sta.Type) & Chr(13) & _
          "Anzahl SubStations: " & Sta.SubSystems.count & Chr(13) & _
          "Anzahl Racks: " & Sta.Racks.count & Chr(13)
    If CatchError Then Exit Sub
    MsgBox str, vbInformation, "Daten der Station " & Sta.Name
End Sub


Public Sub ExampleStation1()
    Dim Sta As S7Station
    Dim str As String
                
On Error Resume Next
    ' Ermittle Station "relativity"
    Set Sta = S.Projects("reptiles").Stations("relativity")
    If CatchError Then
        MsgBox "Es wird das Project 'Reptiles' und die Station " _
            & "'Relativity' benoetigt."
        Exit Sub
    End If
    
    ' Zeige Daten der Station an
    Call AllStationNames(S.Projects("reptiles"))
        
    ' Benenne Station um
    MsgBox "Benenne 'relativity' nach 'relativity2' um"
    Sta.Name = "relativity2"
    If CatchError Then Exit Sub
        
    ' Ausgabe: Alle Stationsnamen des Projekt "reptiles"
    Call AllStationNames(S.Projects("reptiles"))
                
    ' Nun die Infos der Station relativity2
    Set Sta = S.Projects("reptiles").Stations("relativity2")
    If CatchError Then Exit Sub
    Call AllStationData(Sta)

    ' Bennenne Station wieder nach relativity um
    MsgBox "Und nun: Kommando zur點k"
    Sta.Name = "relativity"
    If CatchError Then Exit Sub
    
    ' Nochmals die Daten
    Call AllStationNames(S.Projects("reptiles"))
End Sub


Public Sub ExampleStation2()
    Dim Sta As S7Station
    Dim dlg As New AttributesDlg
    Dim str As String
    Dim AttrNames As Variant, AttrValues As Variant
    Dim NumAttr As Long
    Dim i As Integer
            
On Error Resume Next
    ' Ermittle Station "relativity"
    Set Sta = S.Projects("reptiles").Stations("relativity")
    If CatchError Then
        MsgBox "Es wird das Project 'Reptiles' und die Station " _
            & "'Relativity' benoetigt."
        Exit Sub
    End If
    
    ' die Attribute mit GetFirst..., GetNext...
    Set dlg.Obj = Sta
    dlg.Show vbModal
        
    ' Setze Comment-Attribut mit Late-Binding
    MsgBox "Setze Comment-Attribut mittels Late-Binding"
    Sta.Comment = "ein Late-Binding Kommentar"
    If CatchError Then Exit Sub
    dlg.Show vbModal
    
    ' Ermittle Comment-Attribut mit Late-Binding
    str = Sta.Comment
    MsgBox ("Mit Late-Binding ermittelter Kommentar:" & Chr(13)) & str
        
    ' Setze Comment-Attribut ohne Late-Binding
    MsgBox "Setze Comment-Attribut ohne Late-Binding"
    Sta.Attribute("Comment") = "ein Kommentar ohne Late-Binding"
    If CatchError Then Exit Sub
    dlg.Show vbModal
    
    ' Ermittle Comment-Attribut ohne Late-Binding
    str = Sta.Attribute("Comment")
    MsgBox ("Ohne Late-Binding ermittelter Kommentar:" & Chr(13)) & str
        
    ' Ermittle alle Attribute mit GetAllAttributes
    Call Sta.GetAllAttributes(AttrNames, AttrValues, NumAttr)
    str = "Es gibt " & NumAttr & " Attribute:" & Chr(13) & Chr(13)
        
    For i = 0 To NumAttr - 1
        str = str & AttrNames(i) & ": " & AttrValues(i) & Chr(13)
    Next
        
    str = "Folgende Attribute wurden mit 'GetAllAttributes' " & Chr(13) _
        & "ermittelt." & Chr(13) & Chr(13) & str
    MsgBox str
End Sub



Public Sub ExampleStation3()
    Dim Sta As S7Station
    
On Error Resume Next
    ' Ermittle Station "relativity"
    Set Sta = S.Projects("reptiles").Stations("relativity")
    If CatchError Then
        MsgBox "Es wird das Project 'Reptiles' und die Station " _
            & "'Relativity' benoetigt."
        Exit Sub
    End If
    
    MsgBox ("Nun wird HW-Konfig gestartet, um" & Chr(13) & _
            "die Station 'relativity' zu editieren.")
                
    ' Nun wird die neue Station in HW-Config editiert
    Call Sta.Edit(STATE_OFFLINE)
    
    MsgBox ("Und schon gehts im Bsp-Programm weiter")
End Sub


Public Sub ExampleStation4()
    Dim Pro As S7Project
    Dim Sta As S7Station
        
On Error Resume Next
    Set Sta = S.Projects("reptiles").Stations("relativity")
    If CatchError Then
        MsgBox "Es wird das Project 'Reptiles' und die Station " _
            & "'Relativity' benoetigt."
        Exit Sub
    End If
    
    ' Exportiere die Station relativity
    MsgBox "Exportiere Station 'relativity' in die Datei" & Chr(13) _
        & "c:\tmp\relativity.txt"
    Sta.Export ("c:\tmp\relativity.txt")
    If CatchError Then Exit Sub
    
    ' das wars schon
    MsgBox ("done.")
End Sub


Public Sub ExampleStation6()
    Dim Sta As S7Station
    
On Error Resume Next
    Set Sta = S.Projects("reptiles").Stations("relativity")
    If CatchError Then
        MsgBox "Es wird das Project 'Reptiles' und die Station " _
            & "'Relativity' benoetigt."
        Exit Sub
    End If
    
    ' Compiliere Station, erzeuge SDBs
    MsgBox "Die Station 'relativity' wird nun auf Konsitenz geprueft."
    Sta.Compile True
    If CatchError Then Exit Sub
    
    MsgBox "Nun werden auch die SDBs erzeugt."
    Sta.Compile
    If CatchError Then Exit Sub
    
    MsgBox "done."
End Sub