信息(简1).frm

我们公司生产线大屏幕的程序．是用visual basic语言编写的．

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form send 
   Caption         =   "数据发送"
   ClientHeight    =   2505
   ClientLeft      =   3630
   ClientTop       =   1350
   ClientWidth     =   4290
   Icon            =   "信息(简1).frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   2505
   ScaleWidth      =   4290
   Begin MSWinsockLib.Winsock tcpClient 
      Left            =   4080
      Top             =   720
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.TextBox Text2 
      Height          =   270
      Left            =   2520
      TabIndex        =   2
      Text            =   "Text2"
      Top             =   180
      Width           =   1455
   End
   Begin VB.Timer Timer1 
      Interval        =   18000
      Left            =   4080
      Top             =   120
   End
   Begin VB.CommandButton sendst 
      Caption         =   "保存"
      Height          =   375
      Left            =   360
      TabIndex        =   0
      Top             =   120
      Width           =   735
   End
   Begin VB.Label Label2 
      Caption         =   "显示屏IP地址:"
      Height          =   255
      Left            =   1200
      TabIndex        =   3
      Top             =   240
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "Label1"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1695
      Left            =   120
      TabIndex        =   1
      Top             =   600
      Width           =   3975
   End
End
Attribute VB_Name = "send"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const PORT = 1000
Dim ip_adr  As String
Dim OutString As String
Dim njh, nwc, yjh, ywc, rjh, rwc, jp, error_inf

Private Sub Form_Load()
    Label1.Visible = False
    读设置
End Sub

Private Sub Form_Unload(Cancel As Integer)
      If tcpClient.State <> sckClosed Then _
      tcpClient.Close
End

End Sub

Private Sub sendst_Click()
写设置
End Sub

Private Sub Text2_Change()
ip_adr = Text2.Text
End Sub

Private Sub Timer1_Timer()
        读数据
        OutString = "CHR" + Chr(2)
        On Error Resume Next
        If tcpClient.State <> sckClosed Then _
        tcpClient.Close
        tcpClient.Connect ip_adr, PORT
        Dim EndTime As Date
        EndTime = DateAdd("s", 4, Now)
        Do Until tcpClient.State = sckClosed Or Now > EndTime
        DoEvents
        Loop
        
        OutString = "          奇瑞生产信息" & Chr(13) & Chr(10)
        OutString = OutString & Format(Date, "yyyy年mm月dd日 星期") & Choose(Weekday(Date), "日", "一", "二", "三", "四", "五", "六") & Format(Time, " hh:mm ") & Chr(13) & Chr(10)
        OutString = OutString & "年目标:" & njh & "辆 " & "年实际:" & nwc & " 辆" & Chr(13) & Chr(10)
        OutString = OutString & "月目标:" & yjh & "辆 " & "月实际:" & ywc & " 辆" & Chr(13) & Chr(10)
        OutString = OutString & "日目标:" & rjh & "辆 " & "日实际:" & rwc & " 辆" & Chr(13) & Chr(10)
        OutString = OutString & "节拍产量: " & jp & "秒/辆 " & Chr(13) & Chr(10)
        OutString = OutString & error_inf & Chr(14)
        Label1.Visible = True
        Label1.Caption = OutString
        On Error Resume Next
        If tcpClient.State <> sckClosed Then _
        tcpClient.Close
        tcpClient.Connect ip_adr, PORT
        EndTime = DateAdd("s", 4, Now)
        Do Until tcpClient.State = sckClosed Or Now > EndTime
        DoEvents
        Loop
End Sub


Public Sub 读设置()
    Open "setfile2" For Random As #1
    Get #1, , ip_adr
   Text2.Text = ip_adr
    Close #1
End Sub

Public Sub 写设置()
    Open "setfile2" For Random As #1
    Put #1, , ip_adr
    Close #1
End Sub
Private Sub 读数据()
    On Error Resume Next
    Open App.Path & "\data.txt" For Input As #1   ' 打开输入文件。
    njh = readone
    nwc = readone
    yjh = readone
    ywc = readone
    rjh = readone
    rwc = readone
    jp = readone
    If Not EOF(1) Then  ' 循环至文件尾。
        Input #1, error_inf ' 数据读入
    End If
    Close #1
    End Sub
Private Function readone()
    Dim Datastring, tmp
    If Not EOF(1) Then  ' 循环至文件尾。
asd:
        Input #1, Datastring  ' 数据读入
        On Error Resume Next
        tmp = CLng(Datastring)
        If Err.Number = 13 Then GoTo asd
        On Error GoTo 0
        If tmp < 100000 Then
            Datastring = " " & Datastring
        End If
        If tmp < 10000 Then
            Datastring = " " & Datastring
        End If
        If tmp < 1000 Then
            Datastring = " " & Datastring
        End If
        If tmp < 100 Then
            Datastring = " " & Datastring
        End If
         If tmp < 10 Then
            Datastring = " " & Datastring
        End If
       readone = Datastring
    End If
End Function
Private Sub tcpClient_Close()
    tcpClient.Close
End Sub

Private Sub tcpClient_Connect()
        tcpClient.SendData OutString
End Sub

Private Sub tcpClient_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)
    Print Description
End Sub

Private Sub tcpClient_SendComplete()
    tcpClient.Close
End Sub