HOME [MENU]

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "IDSClient"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' IDSClient v1.1
'
' (c) COOL MAGIC TOKYO - https://coolmagic.guy.jp/computer/download/index_en.html
' 0-clause BSD license included below
'
'---------------------------------------------------------------------------------
' Copyright (C) 2023 by "COOL MAGIC TOKYO" shop@coolmagic.guy.jp
'
' Permission to use, copy, modify, and/or distribute this software for any purpose
' with or without fee is hereby granted.
'
' THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH
' REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
' FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,
' INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
' OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER
' TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
' THIS SOFTWARE.

Option Explicit

Private rest As RestClient
Private statusCode
Private responce As Dictionary

Private Const PATH_GETVALUE = "api/v1/getvalue"
Private Const PATH_PUTVALUE = "api/v1/putvalue"

Public url
Public proxyHost
Public credentialUser
Public credentialPassword

Public Sub Class_Initialize()
    Set rest = New RestClient
    proxyHost = ""
    credentialUser = ""
    credentialPassword = ""
    statusCode = 0
    
End Sub

Public Sub Class_Terminate()
    Set rest = Nothing

End Sub

'--------------------------------------------------------------------------------
'   GetValue
'
Public Function GetValue(controller, item)
    On Error GoTo GetValueError
    
    GetValue = Null
    statusCode = 0
    Set responce = Nothing
    
    If Right(url, 1) <> "/" Then url = url & "/"
    rest.url = url & PATH_GETVALUE
    SetProxy
    
    Dim params As New Dictionary   '�uMicrosoft Scripting Runtime�v���Q�Ɛݒ�
    params.Add "controller", controller
    params.Add "item", item

    Set responce = rest.RequestGet(params)
    statusCode = rest.GetStatus
    
    If responce Is Nothing Then Exit Function

    Dim result, success
    result = responce("result")
    If result <> "OK" Then Exit Function
    success = responce("success")
    If Not success Then Exit Function

    GetValue = responce("value")
    
GetValueError:
    If Err <> 0 Then MsgBox Error(Err), vbExclamation, "GetValueError"
    On Error Resume Next
    Err.Clear
    Exit Function
        
End Function

'--------------------------------------------------------------------------------
'   PutValue
'
Public Function PutValue(controller, item, value) As Boolean
    On Error GoTo PutValueError
    
    PutValue = False
    statusCode = 0
    Set responce = Nothing
    
    If Right(url, 1) <> "/" Then url = url & "/"
    rest.url = url & PATH_PUTVALUE
    SetProxy
    
    Dim JsonObject As Object
    Set JsonObject = New Dictionary
    JsonObject.Add "controller", controller
    JsonObject.Add "item", item
    JsonObject.Add "value", value
    
    Set responce = rest.RequestPost(JsonObject)
    statusCode = rest.GetStatus
    
    If responce Is Nothing Then Exit Function

    Dim result, success
    result = responce("result")
    If result <> "OK" Then Exit Function
    success = responce("success")
    If Not success Then Exit Function
    
    PutValue = True
    
PutValueError:
    If Err <> 0 Then MsgBox Error(Err), vbExclamation, "PutValueError"
    On Error Resume Next
    Err.Clear
    Exit Function
        
End Function

'--------------------------------------------------------------------------------
'   SetProxy
'
Private Sub SetProxy()
    rest.proxyHost = proxyHost
    rest.credentialUser = credentialUser
    rest.credentialPassword = credentialPassword

End Sub

'--------------------------------------------------------------------------------
'   GetStatus
'
Public Function GetStatus()
    GetStatus = statusCode

End Function

'--------------------------------------------------------------------------------
'   GetResponce
'
Public Function GetResponce() As Dictionary
    Set GetResponce = responce

End Function

'--------------------------------------------------------------------------------
'   GetResponceJson
'
Public Function GetResponceJson()
    GetResponceJson = JsonConverter.ConvertToJson(responce)

End Function


 

Return

HOME [MENU]