VERSION 5.00
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmLog 
   BorderStyle     =   1  '固定(実線)
   Caption         =   "Log"
   ClientHeight    =   6360
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7305
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6360
   ScaleWidth      =   7305
   StartUpPosition =   3  'Windows の既定値
   Begin VB.CommandButton cmdClear 
      Caption         =   "&Clear"
      Height          =   405
      Left            =   1380
      TabIndex        =   10
      Top             =   5910
      Width           =   1215
   End
   Begin TabDlg.SSTab SSTab1 
      Height          =   4785
      Left            =   90
      TabIndex        =   7
      Top             =   1050
      Width           =   7095
      _ExtentX        =   12515
      _ExtentY        =   8440
      _Version        =   393216
      Style           =   1
      TabHeight       =   520
      TabCaption(0)   =   "Error"
      TabPicture(0)   =   "Log.frx":0000
      Tab(0).ControlEnabled=   -1  'True
      Tab(0).Control(0)=   "grdErr"
      Tab(0).Control(0).Enabled=   0   'False
      Tab(0).ControlCount=   1
      TabCaption(1)   =   "Operation"
      TabPicture(1)   =   "Log.frx":001C
      Tab(1).ControlEnabled=   0   'False
      Tab(1).Control(0)=   "grdOpe"
      Tab(1).ControlCount=   1
      TabCaption(2)   =   "Control"
      TabPicture(2)   =   "Log.frx":0038
      Tab(2).ControlEnabled=   0   'False
      Tab(2).Control(0)=   "grdCtrl"
      Tab(2).ControlCount=   1
      Begin MSFlexGridLib.MSFlexGrid grdErr 
         Height          =   4305
         Left            =   90
         TabIndex        =   8
         Top             =   390
         Width           =   6915
         _ExtentX        =   12197
         _ExtentY        =   7594
         _Version        =   393216
         Cols            =   36
         AllowUserResizing=   1
      End
      Begin MSFlexGridLib.MSFlexGrid grdOpe 
         Height          =   4305
         Left            =   -74910
         TabIndex        =   9
         Top             =   390
         Width           =   6915
         _ExtentX        =   12197
         _ExtentY        =   7594
         _Version        =   393216
         Cols            =   6
         AllowUserResizing=   1
      End
      Begin MSFlexGridLib.MSFlexGrid grdCtrl 
         Height          =   4305
         Left            =   -74910
         TabIndex        =   11
         Top             =   390
         Width           =   6915
         _ExtentX        =   12197
         _ExtentY        =   7594
         _Version        =   393216
         Cols            =   6
         AllowUserResizing=   1
      End
   End
   Begin VB.CommandButton cmdGet 
      Caption         =   "&Get"
      Height          =   405
      Left            =   90
      TabIndex        =   6
      Top             =   5910
      Width           =   1215
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "Exit"
      Height          =   405
      Left            =   5970
      TabIndex        =   4
      Top             =   5910
      Width           =   1215
   End
   Begin VB.Frame Frame1 
      Caption         =   "Connection"
      Height          =   855
      Left            =   90
      TabIndex        =   0
      Top             =   120
      Width           =   7095
      Begin VB.CommandButton cmdConnect 
         Caption         =   "&Connect"
         Height          =   375
         Left            =   4440
         TabIndex        =   2
         Top             =   300
         Width           =   1215
      End
      Begin VB.CommandButton cmdDisconnect 
         Caption         =   "&Disconnect"
         Height          =   375
         Left            =   5760
         TabIndex        =   3
         Top             =   300
         Width           =   1215
      End
      Begin VB.ComboBox cmbParameter 
         Height          =   300
         Left            =   1320
         TabIndex        =   1
         Top             =   360
         Width           =   3015
      End
      Begin VB.Label Label2 
         Alignment       =   1  '右揃え
         Caption         =   "Parameter : "
         Height          =   255
         Left            =   240
         TabIndex        =   5
         Top             =   360
         Width           =   975
      End
   End
End
Attribute VB_Name = "frmLog"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Const CTRL_MAX = 8 ' 制御軸数

Private caoEng As New CaoEngine
Private caoCtrls As CaoControllers
Private caoCtrl  As CaoController
Attribute caoCtrl.VB_VarHelpID = -1

' ----------------------------------------------------
Private Sub Form_Load()

    With cmbParameter
        .Clear
        .AddItem "eth:192.168.0.1:4112" ' <- Change this for your controller IP setting. "eth:<controller IP>:4112
        .AddItem "com:1:38400:N:8:1" ' <- Change this for your controller RS-232C setting. "com:<COM port no.>:<speed>:N:8:1"
        .ListIndex = 0
    End With
       
    cmdGet.Enabled = False
    
    Set caoEng = New CaoEngine
    Set caoCtrls = caoEng.Workspaces(0).Controllers

    cmdClear_Click

End Sub

' ----------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)

    cmdDisconnect_Click
    
    Set caoCtrls = Nothing
    Set caoEng = Nothing
    
End Sub

' ----------------------------------------------------
Private Sub cmdGet_Click()

    On Error GoTo ErrJump
    
    Dim bRet As Boolean
    
    bRet = getFile("@LOG_ERROR")
    If bRet = False Then
        MsgBox "Can't get Error log!", vbCritical
    Else
        bRet = LoadErrorLog(App.Path + "\" + "@LOG_ERROR")
    End If
    
    If bRet = True Then
        bRet = getFile("@LOG_OPERATION")
        If bRet = False Then
            MsgBox "Can't get Operation log!", vbCritical
        Else
            LoadOperationLog (App.Path + "\" + "@LOG_OPERATION")
        End If
    End If
    
    If bRet = True Then
        bRet = getFile("@LOG_CONTROL")
        If bRet = False Then
            MsgBox "Can't get Control log!", vbCritical
        Else
            LoadControlLog (App.Path + "\" + "@LOG_CONTROL")
        End If
    End If
    
    Exit Sub
ErrJump:
    MsgBox Err.Description, vbCritical
    
End Sub

' ----------------------------------------------------
Private Function getFile(ByVal filename$) As Boolean

    getFile = False

    Dim bAdded As Boolean
    bAdded = False
    
    On Error GoTo ErrSkip
    
    Dim caoFl  As CaoFile
    Set caoFl = caoCtrl.AddFile(filename)
    bAdded = True
    
    Dim vntData As Variant
    Dim bytData() As Byte
    Dim strData As String

    If Not caoFl Is Nothing Then
        vntData = caoFl.Value
        
        Select Case VarType(vntData)
        Case vbString
            strData = vntData
            SaveToTextFile App.Path + "\" + filename, strData
        Case vbArray + vbByte
            bytData = vntData
            SaveToBinFile App.Path + "\" + filename, bytData
        End Select
    End If

    getFile = True
    
DoExit:
    If bAdded = True Then
        caoCtrl.Files.Remove caoFl.Index
        bAdded = False
    End If
    
    Set caoFl = Nothing

    Exit Function
ErrSkip:
    MsgBox Err.Description
    Err.Clear
    GoTo DoExit

End Function

' ----------------------------------------------------
Private Sub cmdClear_Click()

    With grdErr
        .Clear
        .FormatString = "No.|Date|Time|Module|Code|Description|Level"
        .Rows = 2
    End With
    With grdOpe
        .Clear
        .Rows = 2
        .FormatString = "No.|Date|Time|Module|Code|Description"
    End With
    With grdCtrl
        .Clear
        .Rows = 2
        Dim sFmt$, sJn$, i&
        sFmt = "No.|"
        For i = 1 To CTRL_MAX
            sJn = "J" + CStr(i)
            sFmt = sFmt + sJn + "-Inst|" + sJn + "-Real|" + sJn + "-Elec|" + sJn + "-Load|"
        Next i
        sFmt = sFmt + "Resitance|ProgramNo|LineNo"
        .FormatString = sFmt
    End With
    
End Sub


' ----------------------------------------------------
Private Sub cmdConnect_Click()
    
    On Error GoTo ErrProc
    
    Dim sConn As String
    
    cmdDisconnect_Click
    
    sConn = "Conn=" & cmbParameter.Text
    
    Set caoCtrl = caoCtrls.Add("", "CaoProv.DENSO.NetwoRC", "", sConn)
    
    cmdGet.Enabled = True
    
    cmdClear_Click

    Exit Sub
ErrProc:
    MsgBox Err.Description
    
End Sub

' ----------------------------------------------------
Private Sub cmdDisconnect_Click()
    
    If Not caoCtrl Is Nothing Then
        caoCtrls.Remove caoCtrl.Index
        Set caoCtrl = Nothing
    End If
    
    cmdGet.Enabled = False
    
End Sub

' ----------------------------------------------------
Private Sub cmdExit_Click()
    Unload Me
End Sub

' ----------------------------------------------------
Private Sub LoadFromTextFile(fn As String, buf As String)

    Dim fd As Integer

    fd = FreeFile
    Open fn For Input As fd
        buf = StrConv(InputB(LOF(fd), #fd), vbUnicode)
    Close fd

End Sub

' ----------------------------------------------------
Private Sub SaveToTextFile(fn As String, buf As String)

    Dim fd As Integer

    fd = FreeFile
    Open fn For Output As fd
        Print #fd, buf;
    Close fd

End Sub

' ----------------------------------------------------
Private Sub LoadFromBinFile(fn As String, bytData() As Byte)

    Dim fd As Integer
    Dim fl As Long

    fd = FreeFile
    fl = FileLen(fn)
    ReDim bytData(0 To fl - 1)
    Open fn For Binary Access Read As fd
        Get #fd, , bytData
    Close fd

End Sub

' ----------------------------------------------------
Private Sub SaveToBinFile(fn As String, bytData() As Byte)

    Dim fd As Integer

    fd = FreeFile
    Open fn For Binary Access Write As fd
        Put #fd, , bytData
    Close fd

End Sub

' ----------------------------------------------------
Private Function LoadErrorLog(ByVal sFilePath As String) As Boolean

    Dim myDate As String
    Dim myTime As String
    Dim myMod As String
    Dim myCode As Integer
    Dim myMsg As String
    Dim myLvl As Integer
    Dim myVal As Long
    
    Dim i As Integer
    Dim n As Integer
    Dim iVal As Integer
    Dim sVal As String
    Dim lVal As Long
    
    Dim FileProv As New FileProvider 'ﾌｧｲﾙ化用
    
    LoadErrorLog = False
    If FileProv.DoOpen(sFilePath) <> 0 Then Exit Function 'ｵｰﾌﾟﾝ
    
    Dim imax As Integer
    
    With frmLog.grdErr
        imax = FileProv.Blocks + 1
        
        .Clear
        .FormatString = "No.|Date|Time|Module|Code|Description|Level"
        .Rows = imax
    
        For i = 1 To imax
            '=============================================
            n = i - 1
            '----------------------------------- ["YYYY/MM/DD"]
            '先頭だけｴﾗｰﾁｪｯｸ
            If FileProv.DoGetValue(n, iVal, 0) < 0 Then Exit For 'wYear
            If iVal > 70 Then '19xx
                myDate = "19" + Format(iVal, "00") + "/"
            Else ' 20xx
                myDate = "20" + Format(iVal, "00") + "/"
            End If
            FileProv.DoGetValue n, iVal, 2 'wMonth
            myDate = myDate + Format(iVal, "00") + "/"
            'FileProv.DoGetValue n, iVal, 4 'wDayOfWeek '未使用
            
            FileProv.DoGetValue n, iVal, 6 'wDay
            myDate = myDate + Format(iVal, "00")
            '----------------------------------- ["HH:MM:SS"]
            FileProv.DoGetValue n, iVal, 8 'wHour
            myTime = Format(iVal, "00") + ":"
            FileProv.DoGetValue n, iVal, 10 'wMinute
            myTime = myTime + Format(iVal, "00") + ":"
            FileProv.DoGetValue n, iVal, 12 'wSecond
            myTime = myTime + Format(iVal, "00")
            'FileProv.DoGetValue n, iVal, 14 'wMilliseconds '未使用
            
            '----------------------------------- ["ｴﾗｰｺｰﾄﾞ" = "XXXX"]
            FileProv.DoGetValue n, iVal, 16 'code
            myCode = iVal
            '----------------------------------- ["ｴﾗｰﾒｯｾｰｼﾞ"]
            FileProv.DoGetValue n, sVal, 20, 128 'msg
            myMsg = sVal
            '----------------------------------- ["ﾓｼﾞｭｰﾙ"]
            FileProv.DoGetValue n, sVal, 148, 64 'src
            myMod = sVal
            '----------------------------------- ["ｴﾗｰﾚﾍﾞﾙ"]
            FileProv.DoGetValue n, iVal, 212 'level ' aa bb 00 00 = aa bb のみ取得
            myLvl = iVal
            '=============================================
            .TextMatrix(i, 0) = CStr(i)
            .TextMatrix(i, 1) = myDate
            .TextMatrix(i, 2) = myTime
            .TextMatrix(i, 3) = myMod
            .TextMatrix(i, 4) = Hex$(myCode)
            .TextMatrix(i, 5) = myMsg
            .TextMatrix(i, 6) = CStr(myLvl)
        Next i
    End With
    
    FileProv.DoClose
    FileProv.DoDestroy
    
    LoadErrorLog = True

End Function

' ----------------------------------------------------
Private Function LoadOperationLog(ByVal sFilePath As String) As Boolean

    Dim myDate As String
    Dim myTime As String
    Dim myMod As String
    Dim myCode As Integer
    Dim myMsg As String
    Dim myLvl As Integer
    Dim myVal As Long
    
    Dim i As Integer
    Dim n As Integer
    Dim iVal As Integer
    Dim sVal As String
    Dim lVal As Long
    Dim stmp As String
    
    Dim FileProv As New FileProvider 'ﾌｧｲﾙ化用
    
    LoadOperationLog = False
    If FileProv.DoOpen(sFilePath) <> 0 Then Exit Function 'ｵｰﾌﾟﾝ
    
    Dim imax As Integer
    
    With frmLog.grdOpe
        imax = FileProv.Blocks + 1
        
        .Clear
        .FormatString = "No.|Date|Time|Module|Code|Description"
        .Rows = imax
    
        For i = 1 To imax
            '=============================================
            n = i - 1
            '----------------------------------- ["YYYY/MM/DD"]
            '先頭だけｴﾗｰﾁｪｯｸ
            If FileProv.DoGetValue(n, iVal, 0) < 0 Then Exit For 'wYear
            If iVal > 70 Then '19xx
                myDate = "19" + Format(iVal, "00") + "/"
            Else ' 20xx
                myDate = "20" + Format(iVal, "00") + "/"
            End If
            FileProv.DoGetValue n, iVal, 2 'wMonth
            myDate = myDate + Format(iVal, "00") + "/"
            'FileProv.DoGetValue n, iVal, 4 'wDayOfWeek '未使用
            FileProv.DoGetValue n, iVal, 6 'wDay
            myDate = myDate + Format(iVal, "00")
            '----------------------------------- ["HH:MM:SS"]
            FileProv.DoGetValue n, iVal, 8 'wHour
            myTime = Format(iVal, "00") + ":"
            FileProv.DoGetValue n, iVal, 10 'wMinute
            myTime = myTime + Format(iVal, "00") + ":"
            FileProv.DoGetValue n, iVal, 12 'wSecond
            myTime = myTime + Format(iVal, "00")
            'FileProv.DoGetValue n, iVal, 14 'wMilliseconds '未使用
            '----------------------------------- ["ｺｰﾄﾞ" = "XXXX"]
            FileProv.DoGetValue n, iVal, 16 'code
            myCode = iVal
            '----------------------------------- ["ﾒｯｾｰｼﾞ"]
            FileProv.DoGetValue n, sVal, 20, 128 'msg
            myMsg = sVal
            '----------------------------------- ["ｿｰｽ"]
            FileProv.DoGetValue n, sVal, 148, 64 'src
            myMod = sVal
            '=============================================
            .TextMatrix(i, 0) = CStr(i)
            .TextMatrix(i, 1) = myDate
            .TextMatrix(i, 2) = myTime
            .TextMatrix(i, 3) = myMod
            If myCode = 0 Then stmp = vbNullString Else stmp = Hex$(myCode)
            .TextMatrix(i, 4) = stmp
            .TextMatrix(i, 5) = myMsg
        Next i
    End With
    
    FileProv.DoClose
    FileProv.DoDestroy
    
    LoadOperationLog = True

End Function

' ----------------------------------------------------
Private Function LoadControlLog(ByVal sFilePath As String) As Boolean
    
    Dim myInst() As Single
    Dim myReal() As Single
    Dim myElec() As Integer
    Dim myLoad() As Single
    Dim myReg As Single
    Dim myProgNo As Long
    Dim myLineNo As Long
    
    Dim i As Integer
    Dim j As Integer
    Dim jnt As Integer
    Dim jnt4 As Integer
    Dim n As Integer
    Dim iVal As Integer
    Dim sVal As String
    Dim lVal As Long
    Dim stmp As String
    Dim sFmt$, sJn$
    
    Dim FileProv As New FileProvider 'ﾌｧｲﾙ化用
    
    LoadControlLog = False
    If FileProv.DoOpen(sFilePath) <> 0 Then Exit Function 'ｵｰﾌﾟﾝ
    
    ReDim myInst(CTRL_MAX)
    ReDim myReal(CTRL_MAX)
    ReDim myElec(CTRL_MAX)
    ReDim myLoad(CTRL_MAX)

    Dim imax As Integer
    
    With frmLog.grdCtrl
        imax = FileProv.Blocks
        
        .Clear
        sFmt = "No.|"
        For i = 1 To CTRL_MAX
            sJn = "J" + CStr(i)
            sFmt = sFmt + sJn + "-Inst|" + sJn + "-Real|" + sJn + "-Elec|" + sJn + "-Load|"
        Next i
        sFmt = sFmt + "Resitance|ProgramNo|LineNo"
        .FormatString = sFmt
        .Rows = imax + 1
    
        For i = 1 To imax
            
            '=============================================
            n = i - 1
            '-----------------------------------
            '先頭だけｴﾗｰﾁｪｯｸ
            If FileProv.DoGetValue(n, myInst(), 0, CTRL_MAX) < 0 Then Exit For
            FileProv.DoGetValue n, myReal(), 32, CTRL_MAX
            Dim laVal() As Long
            ReDim laVal(CTRL_MAX)
            FileProv.DoGetValue n, laVal(), 64, CTRL_MAX
            For j = 0 To CTRL_MAX - 1
                laVal(j) = laVal(j) And &HFFFF& '上位16ﾋﾞｯﾄを捨てる
                If (laVal(j) And &H8000&) Then '符号ﾋﾞｯﾄが立っていたら
                    myElec(j) = -((laVal(j) Xor &HFFFF&) + 1)
                Else
                    myElec(j) = laVal(j)
                End If
            Next j
            FileProv.DoGetValue n, myLoad(), 96, CTRL_MAX
            FileProv.DoGetValue n, myReg, 128
            FileProv.DoGetValue n, myProgNo, 132
            FileProv.DoGetValue n, myLineNo, 136
            '=============================================
            
            .TextMatrix(i, 0) = CStr(i)
            For jnt = 0 To CTRL_MAX - 1
                jnt4 = jnt * 4 + 1
                .TextMatrix(i, jnt4) = LStr(myInst(jnt)) 'Rad **NOT DEG**
                .TextMatrix(i, jnt4 + 1) = LStr(myReal(jnt)) 'Rad **NOT DEG**
                .TextMatrix(i, jnt4 + 2) = LStr(myElec(jnt))
                .TextMatrix(i, jnt4 + 3) = LStr(myLoad(jnt))
            Next jnt
            .TextMatrix(i, 4 * CTRL_MAX + 1) = LStr(myReg)
            .TextMatrix(i, 4 * CTRL_MAX + 2) = LStr(myProgNo)
            .TextMatrix(i, 4 * CTRL_MAX + 3) = LStr(myLineNo)
        Next i
    End With
    
    FileProv.DoClose
    FileProv.DoDestroy
    
    LoadControlLog = True

End Function

'-----------------------------------------------------------
Public Function LLng(ByRef expression) As Long
    
    LLng = CLng(Val(expression))

End Function

'-----------------------------------------------------------------------------
Public Function LInt(ByRef expression) As Integer
    
    LInt = CInt(Val(expression))

End Function

'-----------------------------------------------------------------------------
Public Function LByte(ByRef expression) As Byte
    
    LByte = CByte(Val(expression))

End Function

'-----------------------------------------------------------------------------
Public Function LDbl(ByRef expression) As Double
    
    LDbl = CDbl(Val(expression))

End Function

'-----------------------------------------------------------------------------
Public Function LSng(ByRef expression) As Single
    
    LSng = CSng(Val(expression))

End Function

'-----------------------------------------------------------------------------
Public Function LBool(ByRef expression) As Boolean
    
    LBool = CBool(Val(expression))

End Function

'-----------------------------------------------------------------------------
Public Function LVar(ByRef expression) As Variant
    
    LVar = CVar(Val(expression))

End Function

'-----------------------------------------------------------
Public Function LStr(ByRef expression) As String
    
    On Error Resume Next

    LStr = expression
    LStr = LTrim$(Str(expression))

End Function