标题：Ｗｉｎｓｏｃｋ在车间作业调度管理系统中的应用
作者：徐永新，陆宝春
作者单位：南京理工大学机械工程学院
关键字：Ｗｉｎｓｏｃｋ，作业调度，ＶＢ，网络通信
摘要：

   本文介绍了Ｗｉｎｓｏｃｋ的基本概念及其在车间作业调度管理系统中的应用。基于Ｖｉｓｕａｌ Ｂａｓｉｃ重点讨论了一对多通信的实现方法和作业文件在网络中传输的方法，并给出了相应的ＶＢ代码。

客户端和服务器端程序如下：

客户端程序

Option Explicit  '注：只列出相关变量，filepath可由用户设定

Private filepath As String

Private filename As String

Private filesize As Long

Private dataflag As Integer  '接收的数据类型标识，

                       '1表示文件名，2表示文件长度，3表示文件内容

Private Sub Form_Load()

  dataflag = 1 '初始设定接收标识为文件名

  tcpclient.RemoteHost = "server"  '服务器名称

  tcpclient.RemotePort = 1234  '服务器的侦听端口

  tcpclient.Protocol = sckTCPProtocol '设置为TCP协议

  tcpclient.Connect  '向服务器请求连接

End Sub

Private Sub cmdRequest_Click() '设备操作员点击“申请”命令按钮

  On Error GoTo errorHandler

  If tcpclient.State <> sckClosed Then

    tcpclient.SendData "request"  '发送申请命令

  End If

  Exit Sub

errorHandler:

End Sub

Private Sub tcpclient_DataArrival(ByVal bytesTotal As Long)

  On Error GoTo errorHandler

  Select Case dataflag

    Case 1

      tcpclient.GetData filename, vbString '接收文件名

      dataflag = 2            '

      tcpclient.SendData "ok"  '发送确认信号

    Case 2

      tcpclient.GetData filesize, vbLong '接收文件长度

      dataflag = 3

      tcpclient.SendData "ok"  '发送确认信号

    Case 3

      Call Getfile

  End Select

  Exit Sub

errorHandler:

End Sub

Private Sub Getfile()

  Static filenumber As Long  '文件号

  Static recnumber As Long  '记录号，用于标识已接收到的数据量

  Dim data() As Byte  '存储文件内容的二进制动态数组

  On Error GoTo errorHandler

  tcpclient.GetData data, vbArray + vbByte  '读取接收到的数据

  If recnumber = 0 Then

    filenumber = FreeFile

    If Dir(filepath & "\" & filename) <> "" Then

      Kill filepath & "\" & filename

    End If

    Open filepath & "\" & filename For Binary As filenumber

      '以二进制方式打开文件

  End If

  recnumber = LOF(filenumber) + 1

  Put filenumber, recnumber, data  ' 向文件结尾处写入数据

  If LOF(filenumber) = filesize Then  '判断是否接收完

    recnumber = 0

    Close filenumber

    dataflag = 1

    tcpclient.SendData "ok"  '发送确认信号

    MsgBox "文件：" & filepath & "\" & filename & "接收完毕！"

  End If

  Exit Sub

errorHandler:

End Sub

 

服务器端程序

Option Explicit   '注：只列出相关变量

Private filepath As String  '作业文件的路径

Private filename As String  '当前队头的文件名

Private sending() As Boolean  '标识发送状态的动态数组，为每一个客户设置一个发送状态

Private Sub Form_Load()

  tcpserver(0).Protocol = sckTCPProtocol  '设置为TCP协议

  tcpserver(0).LocalPort = 1234 '设置本地端口为1234

  tcpserver(0).Listen '开始侦听，tcpserver(0)是专用于侦听的winsock控件

End Sub

Private Sub tcpserver_ConnectionRequest(Index As Integer, ByVal requestID As Long)

  Dim strIp As String

  Dim i As Integer

  strIp = tcpserver(0).RemoteHostIP '获得请求连接者的IP地址

  i = 1

  Do While i <= tcpserver.UBound '检查是否已有该IP地址的记录

    If tcpserver(i).RemoteHostIP = strIp Then '如有，则不必加载新控件

      If tcpserver(i).State <> sckClosed Then

        tcpserver(i).Close

      End If

      tcpserver(i).LocalPort = 0 '随机分配一个端口号

      tcpserver(i).Accept requestID '接受连接请求

      Exit Sub

    End If

    i = i + 1

  Loop

  ReDim sending(1 To i)  '增加一个发送状态标志

  Load tcpserver(i)   '加载新的控件实例

  tcpserver(i).LocalPort = 0

  tcpserver(i).Accept requestID '用新的控件接受连接请求

End Sub

Private Sub tcpserver_DataArrival(Index As Integer, ByVal bytesTotal As Long)

  Dim s As String

  tcpserver(Index).GetData s

  Select Case s

    Case "request"

      filename = GetHead(tcpserver(Index).RemoteHostIP)

      '根据申请者的IP地址返回该申请设备所对应的作业队列的队头文件名，GetHead()函数略

      Sendfile Index, filename

    Case "ok"

      sending(Index) = False

  End Select

End Sub

Private Sub Sendfile(i As Integer, ByVal name As String)

  Static filenumber As Long

  Dim data() As Byte

  Dim size As Long

  On Error GoTo ErrorHandler

  filenumber = FreeFile

  Open filepath & "\" & name For Binary As filenumber '以二进制方式打开文件

    size = LOF(filenumber)  '取得文件长度（字节数）

    ReDim data(size - 1)

    Get filenumber, 1, data()  '将文件内容全部读入data()数组中

  Close filenumber

  sending(i) = True

  tcpserver(i).SendData name    '发送文件名

  Do While sending(i)       '等待对方响应

    DoEvents              '处理其它事件

  Loop

  sending(i) = True

  tcpserver(i).SendData size    '发送文件长度

  Do While sending(i)

    DoEvents

  Loop

  sending(i) = True

  tcpserver(i).SendData data  '发送文件内容，如果文件比较长，

      '则自动分为多个数据包发送，接收方会产生多个DataArrival事件

  Do While sending(i)

    DoEvents

  Loop

  Label1.Caption = "文件：" & filepath & "\" & name & "下发成功！"

  Exit Sub

ErrorHandler:

End Sub