Option Explicit

'===========================================================
'  *マシン制御クラス
'
'  Ver  1.0
'
'  #ref(Z_cMachineControl_1.0.txt)
'  #ref(cMachineControl_1.0.txt)
'
'  **コンストラクタ
'  Private Sub Class_Initialize()
'  **初期化
'  Public Function Initialize()
'  **ステータス取得
'  Public Function getStatus()
'
'  **コンピュータ名取得
'  Function getComputerName()
'  **環境変数取得
'  Function getEnv()
'  **ログインユーザ名取得
'  Function getLoginUserName()
'  **ＯＳ名取得
'  Function getOsName()
'
'  **終了
'  Public Function Terminate()
'  **デコンストラクタ
'  Private Sub Class_Terminate()
'  **Excel終了時処理
'  Private Sub foExcelApplication_WorkbookBeforeClose()
'  **フィールドクリア
'  Private Sub clearField()
'===========================================================

'Initialize済フラグ
Private fbInitialize As Boolean

Private WithEvents foExcelApplication As Excel.Application

'#
'# コンストラクタ
'#
Private Sub Class_Initialize()

  Set foExcelApplication = Excel.Application

  Call clearField

End Sub

'#
'# 初期化
'#   [戻り値]:
'#     Boolean
'#       True: 成功
'#       False:失敗
'#   [引  数]:
'#     なし
'#
Public Function Initialize( _
  ) As Boolean

  Dim lbRet As Boolean

  '#初期化済でないこと
  If (fbInitialize <> False) Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True

    fbInitialize = True
    
  End If
  
  Initialize = lbRet

End Function

'#
'# ステータス取得
'#   [戻り値]:
'#     String
'#       CSV形式でプライベート変数内容を返却
'#   [引  数]:
'#     なし
'#
Public Function getStatus( _
  ) As String

  Dim lsRet As String

  lsRet = _
    "fbInitialize=" & fbInitialize

  getStatus = lsRet

End Function

'# コンピュータ名取得
'#    [戻り値]:
'#      String
'#        OS名
'#    [引  数]:
'#      なし
Function getComputerName( _
  ) As String

  Dim lsRet As String

  lsRet = CreateObject("Wscript.network").ComputerName

  getComputerName = lsRet

End Function

'# 環境変数取得
'#    [戻り値]:
'#      String
'#        OS名
'#    [引  数]:
'#      isEnvName(String)
'#        環境変数名
Function getEnv( _
  isEnvName As String _
  ) As String

  Dim lsRet As String
  
  lsRet = ""
  If (isEnvName <> "") Then
    lsRet = Environ(isEnvName)
  End If

  getEnv = lsRet

End Function

'# ログインユーザ名取得
'#    [戻り値]:
'#      String
'#        ログインユーザ名
'#    [引  数]:
'#      なし
Function getLoginUserName( _
  ) As String

  Dim lsRet As String

  lsRet = CreateObject("WScript.Network").UserName

  getLoginUserName = lsRet

End Function

'# ＯＳ名取得
'#    [戻り値]:
'#      String
'#        OS名
'#    [引  数]:
'#      なし
Function getOsName( _
  ) As String

  Dim lsRet As String

  Dim lvOs1 As Variant
  Dim lvOs2 As Variant
  Const csOs1 = _
    "Windows (32-bit) NT 6.00" & _
    ",Windows (32-bit) NT 5.01" & _
    ",Windows (32-bit) NT 5.00" & _
    ",Windows (32-bit) 4.90" & _
    ",Windows (32-bit) 4.10" & _
    ",Windows (32-bit) 4.00" & _
    ",Macintosh (PowerPC) 10.13" & _
    ",Macintosh (PowerPC) 9.00"
  Const csOs2 = _
    "Windows VISTA" & _
    ",Windows XP" & _
    ",Windows 2000" & _
    ",Windows Me" & _
    ",Windows 98" & _
    ",Windows 95" & _
    ",Mac OS X" & _
    ",Mac OS 9"

  lvOs1 = SpilitString(csOs1, ",")
  lvOs2 = SpilitString(csOs2, ",")

  Dim lsOsvsn As String
  lsOsvsn = Application.OperatingSystem
  Dim liLoopCounter1 As Integer
  For liLoopCounter1 = 0 To UBound(lvOs1) Step 1
    If (lsOsvsn = lvOs1(liLoopCounter1)) Then
      Exit For
    End If
  Next liLoopCounter1
  
  If (liLoopCounter1 > UBound(lvOs1)) Then
    lsRet = "unknown"
  Else
    lsRet = lvOs2(liLoopCounter1)
  End If

  getOsName = lsRet

End Function




'#
'# 終了
'#   [戻り値]:
'#     Boolean
'#       True: 成功
'#       False:失敗
'#   [引  数]:
'#     なし
'#
Public Function Terminate( _
  ) As Boolean

  Dim lbRet As Boolean

  '#初期化済であること
  If (fbInitialize <> True) Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True

    Call clearField
  End If

  Terminate = lbRet

End Function

'#
'# デコンストラクタ
'#
Private Sub Class_Terminate()

  Set foExcelApplication = Nothing
  Call Me.Terminate

End Sub

'#
'# Excel終了時処理
'#
Private Sub foExcelApplication_WorkbookBeforeClose( _
  ByVal Wb As Workbook, Cancel As Boolean _
)

  Class_Terminate

End Sub

'#
'# フィールドクリア
'#
Private Sub clearField()
  
  fbInitialize = False

End Sub