Imports System.Net                      'TcpClient
Imports System.Net.Sockets              'TcpClient
Imports System.Text                     'Encoding


Public Class Form1


    Dim netStream As NetworkStream


    Dim MsgBuf As String


	Dim MsgFlg As Integer

	Dim objExcel As Object      'EXCEL Object
	Dim objBook As Object       'WorkBook Object
	Dim objSheet As Object      'WorkSheet Object
	Dim yHan As Long            'EXCEL yHan
	Dim xHan As Long            'EXCEL xHan
	Dim yLine As Long           'EXCEL xLine
	Dim xLine As Long           'EXCEL yLine
	Dim MAXUNIT As Long         'UNIT Num
	Dim MAXCH As Long           'CHANNEL Num
	Dim SAMPLE As Long          'Interval
	Dim MAXNUM As Long          'Data Num
	Dim unit As Long
	Dim ch As Long
	Dim num As Long


    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        '*******************************************************************************
        ' LAN SAMPLE PROGRAM NO.3
        '
        ' This program connects to 8423 and take the value of each CH and attach to EXCEL.  
        '   
        ' A data acquisition interval is able to set up it at later intervals than one second.  
        ' EXCEL needs to be installed.  
        ' GetTickCount of WinAPI is being used.  
        '*******************************************************************************




        'EXCEL WorkSheet
        On Error GoTo Err_Sheet
Chk_Err_Sheet:
        objSheet = objBook.worksheets(TextBox6.Text)
        GoTo No_Err_Sheet
Err_Sheet:


        On Error GoTo Err_Excel
Chk_Err_Excel:
        objSheet = objBook.worksheets.Add
        TextBox6.Text = objSheet.Name


No_Err_Sheet:


        'EXCEL ch disp cell
        On Error GoTo Err_Han
Chk_Err_Han:
        '
        yHan = objSheet.Range(TextBox9.Text).Row
        '
        xHan = objSheet.Range(TextBox9.Text).Column
        GoTo No_Err_Han
Err_Han:
        TextBox9.Text = "A1"
        GoTo Chk_Err_Han
No_Err_Han:



        'EXCEL data disp cell
        On Error GoTo Err_Cell
Chk_Err_Cell:
        '
        yLine = objSheet.Range(TextBox7.Text).Row
        '
        xLine = objSheet.Range(TextBox7.Text).Column
        GoTo No_Err_Cell
Err_Cell:
        TextBox7.Text = "A2"
        GoTo Chk_Err_Cell
No_Err_Cell:



        TextBox1.Text = "Start"

        SAMPLE = (TextBox3.Text * 1000) 'Interval (ms)

        MAXUNIT = 1                  'UNIT Num.

        MAXCH = TextBox4.Text           'CHANNEL Num.

        MAXNUM = TextBox8.Text          'DATA Num.


        num = 0                     'Data Counter


        '8423 Setting
        'HEADER OFF
        SendMsgCrLf(":HEAD OFF")

        'display Time and Channel
        For unit = 1 To MAXUNIT
            For ch = 1 To MAXCH
                If (unit = 1 And ch = 1) Then
                    objSheet.Cells(yHan, xLine).Value = "TIME"
                End If
                objSheet.Cells(yHan, xHan + ((unit - 1) * MAXCH) + ch).Value = "U" + Str$(unit) + " CH" + Str$(ch)
            Next ch
        Next unit


        'Timer action start
        start_timer()

        'Get Data
        get_data()


        GoTo No_Err_Excel


Err_Excel:
        TextBox1.Text = "It is not able to measure.  Is Excel Started?  "


No_Err_Excel:

    End Sub


    Private Sub get_data()

        Dim RecciveStr As String     'Receive Strings

        'Send Command to 8423
        SendMsgCrLf(":MEM:GETREAL")

        For unit = 1 To MAXUNIT
            For ch = 1 To MAXCH

                GetMsg2CrLf(":MEM:VREAL? UNIT" + Str$(unit) + ",CH" + Str$(ch))

                'Receive Query from 8423
                RecciveStr = MsgBuf

                'Write to EXCEL
                If (unit = 1 And ch = 1) Then
                    objSheet.Cells(yLine, xLine).Value = TimeOfDay
                End If
                objSheet.Cells(yLine, xLine + ((unit - 1) * MAXCH) + ch).Value = RecciveStr

            Next ch
        Next unit

        'Scroll Cell
        objSheet.Cells(yLine, 1).Show()

        'Increment Cell
        yLine = yLine + 1
        TextBox7.Text = objSheet.Cells(yLine, xLine).address(rowAbsolute:=False, columnAbsolute:=False)

        'Increment Data Counter
        num = num + 1


        'Check Data Counter
        If MAXNUM <> 0 And MAXNUM = num Then
            stop_timer()
        End If

    End Sub


    Private Sub start_timer()

        'Timer Start
        Timer1.Interval = SAMPLE
        Timer1.Enabled = True

    End Sub


    Private Sub stop_timer()

        'Timer Stop
        Timer1.Enabled = False

        TextBox1.Text = "Stop"

    End Sub


    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick

        'Get Data
        get_data()

    End Sub


    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click

        'Stop Button
        stop_timer()

    End Sub


    Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click

        'EXCEL Create
        objExcel = CreateObject("Excel.application")

        objExcel.Visible = True

        'EXCEL Select Workbook
        On Error GoTo Err_Book
Chk_Err_Book:
        objBook = objExcel.workbooks.open(TextBox5.Text)
        GoTo No_Err_Book
Err_Book:
        objBook = objExcel.workbooks.Add
        TextBox5.Text = "c:\" + objBook.Name
No_Err_Book:

    End Sub


    Private Sub Form_Load()


        '    txtIP = GetSetting("samp3", "Startup", "Set1", "192.168.1.2")
        '    txtPort = GetSetting("samp3", "Startup", "Set2", "8802")
        '    TextBox3 = GetSetting("samp3", "Startup", "Set3", "1")
        '    TextBox4 = GetSetting("samp3", "Startup", "Set4", "15")
        '    TextBox5 = GetSetting("samp3", "Startup", "Set5", "c:\Book1")
        '    TextBox6 = GetSetting("samp3", "Startup", "Set6", "Sheet1")
        '    TextBox7 = GetSetting("samp3", "Startup", "Set7", "A2")
        '    TextBox8 = GetSetting("samp3", "Startup", "Set8", "0")
        '    TextBox9 = GetSetting("samp3", "Startup", "Set9", "A1")

    End Sub


    Private Sub Form_Unload(ByVal Cancel As Integer)

        '
        objExcel = Nothing
        objBook = Nothing
        objSheet = Nothing

        '
        '    SaveSetting "samp3", "Startup", "Set1", txtIP
        '    SaveSetting "samp3", "Startup", "Set2", txtPort
        '    SaveSetting "samp3", "Startup", "Set3", TextBox3
        '    SaveSetting "samp3", "Startup", "Set4", TextBox4
        '    SaveSetting "samp3", "Startup", "Set5", TextBox5
        '    SaveSetting "samp3", "Startup", "Set6", TextBox6
        '    SaveSetting "samp3", "Startup", "Set7", TextBox7
        '    SaveSetting "samp3", "Startup", "Set8", TextBox8
        '    SaveSetting "samp3", "Startup", "Set9", TextBox9

    End Sub


    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

        Dim client As New TcpClient(TextIp.Text, Val(TextPort.Text))    'Set Tcp Client

        netStream = client.GetStream()                     'Open Tcp Client
        netStream.WriteTimeout = 100000
        netStream.ReadTimeout = 100000

        'Do While (Winsock1.State <> sckConnected)
        '    If Winsock1.State = sckConnecting Then Text2.Text = "connecting"
        '    DoEvents()
        'Loop
        'If Winsock1.State = sckConnected Then Text2.Text = "LAN connect"

    End Sub

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click

        netStream.Close()                                  'Close Tcp Client

        'Do While (Winsock1.State <> sckClosed)
        '    If Winsock1.State = sckConnected Then Text2.Text = "disconecting"
        '    DoEvents()
        'Loop
        'If Winsock1.State = sckClosed Then Text2.Text = "LAN disconnect"

    End Sub

    Private Sub SendMsgCrLf(ByVal strMsg As String)

        strMsg = strMsg & vbCrLf
        netStream.Write(Encoding.ASCII.GetBytes(strMsg), 0, strMsg.Length)            'send message

    End Sub

    Private Sub GetMsg2CrLf(ByVal strMsg As String)
        Dim Check As Integer

        strMsg = strMsg & vbCrLf
        netStream.Write(Encoding.ASCII.GetBytes(strMsg), 0, strMsg.Length)            'send message

        MsgBuf = Nothing

        Do                                                    'wait receive command
            Check = netStream.ReadByte()

            If Chr(Check) = vbLf Then
                '                MsgBuf = MsgBuf & Chr(Check)
                Exit Do
            ElseIf Chr(Check) = vbCr Then
                '                MsgBuf = MsgBuf & Chr(Check)
            Else
                MsgBuf = MsgBuf & Chr(Check)
            End If
        Loop
        '        MsgBuf = MsgBuf & vbCrLf

    End Sub

End Class
