finsedit.frm

OMRON FINS 串口 以太网通讯协议软件原代码

      End
      Begin VB.ComboBox Combo1 
         Height          =   300
         Index           =   3
         ItemData        =   "Finsedit.frx":0572
         Left            =   1080
         List            =   "Finsedit.frx":057C
         Style           =   2  'Dropdown List
         TabIndex        =   7
         Top             =   720
         Width           =   1800
      End
      Begin VB.ComboBox Combo1 
         Height          =   300
         Index           =   2
         ItemData        =   "Finsedit.frx":0596
         Left            =   5760
         List            =   "Finsedit.frx":0598
         Style           =   2  'Dropdown List
         TabIndex        =   5
         Top             =   240
         Width           =   975
      End
      Begin VB.ComboBox Combo1 
         Height          =   300
         Index           =   1
         ItemData        =   "Finsedit.frx":059A
         Left            =   3360
         List            =   "Finsedit.frx":059C
         Style           =   2  'Dropdown List
         TabIndex        =   3
         Top             =   240
         Width           =   975
      End
      Begin VB.ComboBox Combo1 
         Height          =   300
         Index           =   0
         ItemData        =   "Finsedit.frx":059E
         Left            =   1080
         List            =   "Finsedit.frx":05A0
         Style           =   2  'Dropdown List
         TabIndex        =   2
         Top             =   240
         Width           =   975
      End
      Begin VB.Label Label6 
         Caption         =   "SID："
         Height          =   255
         Index           =   5
         Left            =   5160
         TabIndex        =   30
         Top             =   780
         Width           =   495
      End
      Begin VB.Label Label6 
         Caption         =   "主链接单元号："
         Height          =   255
         Index           =   4
         Left            =   3000
         TabIndex        =   10
         Top             =   780
         Width           =   1335
      End
      Begin VB.Label Label6 
         Caption         =   "通讯界面："
         Height          =   255
         Index           =   3
         Left            =   120
         TabIndex        =   8
         Top             =   780
         Width           =   975
      End
      Begin VB.Label Label6 
         Caption         =   "目标节点号："
         Height          =   255
         Index           =   2
         Left            =   4560
         TabIndex        =   6
         Top             =   300
         Width           =   1215
      End
      Begin VB.Label Label6 
         Caption         =   "目标网络号："
         Height          =   255
         Index           =   1
         Left            =   2160
         TabIndex        =   4
         Top             =   300
         Width           =   1215
      End
      Begin VB.Label Label6 
         Caption         =   "源网络号："
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   1
         Top             =   300
         Width           =   975
      End
   End
   Begin MSWinsockLib.Winsock Winsock1 
      Left            =   0
      Top             =   7000
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      Protocol        =   1
      RemoteHost      =   "192.168.1.74"
      RemotePort      =   9600
      LocalPort       =   9600
   End
End
Attribute VB_Name = "finsform"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Const MAX_WSADescription = 256
Private Const MAX_WSASYSStatus = 128
Private Const ERROR_SUCCESS       As Long = 0
Private Const WS_VERSION_REQD     As Long = &H101
Private Const WS_VERSION_MAJOR    As Long = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR    As Long = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD    As Long = 1
Private Const SOCKET_ERROR        As Long = -1

Private Type HOSTENT
   hName      As Long
   hAliases   As Long
   hAddrType  As Integer
   hLen       As Integer
   hAddrList  As Long
End Type

Private Type WSADATA
   wVersion      As Integer
   wHighVersion  As Integer
   szDescription(0 To MAX_WSADescription)   As Byte
   szSystemStatus(0 To MAX_WSASYSStatus)    As Byte
   wMaxSockets   As Integer
   wMaxUDPDG     As Integer
   dwVendorInfo  As Long
End Type


Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long

Private Declare Function WSAStartup Lib "WSOCK32.DLL" _
   (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
   
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long

Private Declare Function gethostname Lib "WSOCK32.DLL" _
   (ByVal szHost As String, ByVal dwHostLen As Long) As Long
   
Private Declare Function gethostbyname Lib "WSOCK32.DLL" _
   (ByVal szHost As String) As Long
   
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
   (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)

Private ICF As String
Private RSV As String
Private GCT As String
Private DNA As String
Private DA1 As String
Private DA2 As String
Private SNA As String
Private SA1 As String
Private SA2 As String
Private SID As Byte

Private HostNode As String
Private HeaderCode As String
Private DelayTim As String
Private Memory As String
Private CommandCode As String
Private Address As String
Private Bit As String
Private Num As String
Private WriteData As String
Private EndStr As String
Dim EtnFins() As Byte
Dim RevInfo() As Byte
Dim RevInfoStr As String
Dim RevinfoCnt As Long

Private Function GetIPAddress() As String

   Dim sHostName    As String * 256
   Dim lpHost    As Long
   Dim HOST      As HOSTENT
   Dim dwIPAddr  As Long
   Dim tmpIPAddr() As Byte
   Dim i         As Integer
   Dim sIPAddr  As String
   
   If Not SocketsInitialize() Then
      GetIPAddress = ""
      Exit Function
   End If
   If gethostname(sHostName, 256) = SOCKET_ERROR Then
      GetIPAddress = ""
      MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & _
              " has occurred. Unable to successfully get Host Name."
      SocketsCleanup
      Exit Function
   End If
   sHostName = Trim$(sHostName)
   lpHost = gethostbyname(sHostName)
    
   If lpHost = 0 Then
      GetIPAddress = ""
      MsgBox "Windows Sockets are not responding. " & _
              "Unable to successfully get Host Name."
      SocketsCleanup
      Exit Function
   End If
   CopyMemory HOST, lpHost, Len(HOST)
   CopyMemory dwIPAddr, HOST.hAddrList, 4
   ReDim tmpIPAddr(1 To HOST.hLen)
   CopyMemory tmpIPAddr(1), dwIPAddr, HOST.hLen
   For i = 1 To HOST.hLen
      sIPAddr = sIPAddr & tmpIPAddr(i) & "."
   Next
   GetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)
   
   SocketsCleanup
End Function

Private Function HiByte(ByVal wParam As Integer)

    HiByte = wParam \ &H100 And &HFF&
 
End Function
Private Function LoByte(ByVal wParam As Integer)

    LoByte = wParam And &HFF&

End Function
Private Sub SocketsCleanup()

    If WSACleanup() <> ERROR_SUCCESS Then
        MsgBox "Socket error occurred in Cleanup."
    End If
    
End Sub

Private Function SocketsInitialize() As Boolean

   Dim WSAD As WSADATA
   Dim sLoByte As String
   Dim sHiByte As String
   
   If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then
      MsgBox "The 32-bit Windows Socket is not responding."
      SocketsInitialize = False
      Exit Function
   End If
   
   
   If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
        MsgBox "This application requires a minimum of " & _
                CStr(MIN_SOCKETS_REQD) & " supported sockets."
        
        SocketsInitialize = False
        Exit Function
   End If
   
   
   If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or _
     (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And _
      HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
      
      sHiByte = CStr(HiByte(WSAD.wVersion))
      sLoByte = CStr(LoByte(WSAD.wVersion))
      
      MsgBox "Sockets version " & sLoByte & "." & sHiByte & _
             " is not supported by 32-bit Windows Sockets."
      
      SocketsInitialize = False
      Exit Function
      
   End If
    SocketsInitialize = True
End Function

'Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Sub Combo1_Click(Index As Integer)
Dim TmpInx As Long
TmpInx = Combo1(Index).ListIndex
Select Case Index
    Case 0
        If TmpInx < 16 Then
            SNA = "0" & Hex(TmpInx)
        Else
            SNA = Hex(TmpInx)
        End If
    Case 1
        If TmpInx < 16 Then
            DNA = "0" & Hex(TmpInx)
        Else
            DNA = Hex(TmpInx)
        End If
    Case 2
        If TmpInx < 16 Then
            DA1 = "0" & Hex(TmpInx)
        Else
            DA1 = Hex(TmpInx)
        End If
    Case 3
        If Combo1(3).ListIndex = 1 Then
            Label6(0).Enabled = True
            Combo1(0).Enabled = True
            Label6(4).Enabled = False
            Combo1(4).Enabled = False
            Combo1(4).ListIndex = 0
            Label6(5).Enabled = True
            Combo1(5).Enabled = True
            Option1.Enabled = True
            Option2.Enabled = True
            Frame4.Enabled = True
            If Option1.Value = False Then
            Combo1(6).Enabled = True
            Combo1(7).Enabled = True
            Combo1(8).Enabled = True
            Combo1(9).Enabled = True
            End If
            Call IPDispose
        ElseIf Combo1(3).ListIndex = 0 Then
            Label6(0).Enabled = False
            Combo1(0).Enabled = False
            Combo1(0).ListIndex = 0
            Label6(4).Enabled = True
            Combo1(4).Enabled = True
            Label6(5).Enabled = False
            Combo1(5).Enabled = False
            Combo1(5).ListIndex = 0
            Option1.Enabled = False
            Option2.Enabled = False
            Frame4.Enabled = False
            Combo1(6).Enabled = False
            Combo1(7).Enabled = False
            Combo1(8).Enabled = False
            Combo1(9).Enabled = False
        End If
    Case 4
        If TmpInx < 10 Then
            HostNode = "0" & TmpInx
        Else
            HostNode = TmpInx
        End If
    Case 5
        If TmpInx < 16 Then
            SID = "0" & Hex(TmpInx)
        Else
            SID = Hex(TmpInx)
        End If
    Case 9
        If TmpInx < 16 Then
            SA1 = "0" & Hex(TmpInx)
        Else
            SA1 = Hex(TmpInx)
        End If
End Select
End Sub

Private Sub Combo2_Click()
Dim Inx As Long
If Combo2.ListIndex = 0 Then
    CommandCode = "0101"
    WriteData = ""
ElseIf Combo2.ListIndex = 1 Then
    CommandCode = "0102"
    
End If


If Combo2.ListIndex = 2 Then
    Frame1.Enabled = False
    For Inx = 0 To 4
        Combo1(Inx).Enabled = False
        Label6(Inx).Enabled = False
    Next Inx
    Frame3.Enabled = False
    Label3.Enabled = False
    Combo3.Enabled = False
    Combo4.Enabled = False
    Label2.Enabled = False
'    VScroll3.Enabled = False
'    Text4.Enabled = False
    
    Label4.Enabled = False
    VScroll4.Enabled = False
    Text5.Enabled = False
    
    Label5.Enabled = False
    VScroll5.Enabled = False
    Text6.Enabled = False
    Text1.Locked = False
    Check1.Enabled = False
Else
    Frame1.Enabled = True
    For Inx = 0 To 4
        Combo1(Inx).Enabled = True
        Label6(Inx).Enabled = True
    Next Inx
    Frame3.Enabled = True
    Label3.Enabled = True
    Combo3.Enabled = True
    Combo4.Enabled = True
    Label2.Enabled = True
'    VScroll3.Enabled = True
'    Text4.Enabled = True
    
    Label4.Enabled = True
    VScroll4.Enabled = True
    Text5.Enabled = True
    
    Label5.Enabled = True
    VScroll5.Enabled = True
    Text6.Enabled = True
    If Combo2.ListIndex = 1 Then
        Text1.Locked = False
    Else
        Text1.Locked = True
    End If
    Check1.Enabled = True
End If
End Sub

Private Sub Combo3_Click()
If Combo3.ListIndex = 0 Then
    Label2.Enabled = True
    Combo4.Enabled = True
Else
    Label2.Enabled = False
    Combo4.Enabled = False
    Combo4.ListIndex = 0
    Bit = ""
End If
Select Case Combo3.ListIndex
    Case 0
'        Text4.Text = "CIO Bit"