source: trunk/Include/Classes/System/Environment.ab@ 327

' System/Environment.ab

#require <api_psapi.sbp>
#require <Classes/System/OperatingSystem.ab>
#require <Classes/ActiveBasic/Windows/index.ab>

Declare Function _System_SetEnvironmentVariable Lib "kernel32" Alias _FuncName_SetEnvironmentVariable (lpName As LPCTSTR, lpValue As LPTSTR) As BOOL
Declare Function _System_GetEnvironmentVariable Lib "kernel32" Alias _FuncName_GetEnvironmentVariable (lpName As PCTSTR, lpBuffer As PTSTR, nSize As DWord) As DWord

Namespace System

Namespace Detail
    TypeDef PFNGetProcessMemoryInfo = *Function(Process As HANDLE, ByRef mc As PROCESS_MEMORY_COUNTERS, cb As DWord) As BOOL

    Dim hasShutdownStarted As Boolean
End Namespace

Class Environment
Public
    ' Properties

    Static Function CommandLine() As String
        If Object.ReferenceEquals(cmdLine, Nothing) Then
#ifdef __STRING_IS_NOT_UNICODE
            cmdLine = New String(GetCommandLineA())
#else
            cmdLine = New String(GetCommandLineW())
#endif
        End If
        Return cmdLine
    End Function

    Static Function CurrentDirectory() As String
        Dim size = GetCurrentDirectory(0, 0)
        Dim p = _System_malloc(SizeOf (TCHAR) * size) As PCTSTR
        Dim len = GetCurrentDirectory(size, p)
        If len < size Then
            CurrentDirectory = New String(p, size As Long)
            _System_free(p)
        End If
    End Function

    Static Sub CurrentDirectory(cd As String)
        SetCurrentDirectory(ToTCStr(cd))
    End Sub

    Static Function ExitCode() As Long
        Return exitCode
    End Function

    Static Sub ExitCode(code As Long)
        exitCode = code
    End Sub

    Static Function HasShutdownStarted() As Boolean
        Return Detail.hasShutdownStarted
    End Function

    Static Function MachineName() As String
        If Object.ReferenceEquals(machineName, Nothing) Then
            Dim buf[MAX_COMPUTERNAME_LENGTH] As TCHAR
            Dim len = (MAX_COMPUTERNAME_LENGTH + 1) As DWord
            GetComputerName(buf, len)
            machineName = New String(buf, len As Long)
        End If
        Return machineName
    End Function

    Static Function NewLine() As String
        Return Ex"\r\n"
    End Function

    Static Function OSVersion() As OperatingSystem
        If Object.ReferenceEquals(osVer, Nothing) Then
            Dim vi As OSVERSIONINFO
            GetVersionEx(vi)
            osVer = New OperatingSystem(vi)
        End If
        Return osVer
    End Function

    Static Function ProcessorCount() As Long
        If processorCount = 0 Then
            Dim si As SYSTEM_INFO
            GetSystemInfo(si)
            processorCount = si.dwNumberOfProcessors
        End If
        Return processorCount
    End Function

    ' StackTrace

    Static Function SystemDirectory() As String
        If Object.ReferenceEquals(sysDir, Nothing) Then
            Dim size = GetSystemDirectory(0, 0)
            Dim p = _System_malloc(SizeOf (TCHAR) * size) As PTSTR
            Dim len = GetSystemDirectory(p, size)
            sysDir = New String(p, len As Long)
            _System_free(p)
        End If
        Return sysDir
    End Function

    Static Function TickCount() As Long
        Return GetTickCount() As Long
    End Function

    ' UserDomainName

    ' UserInteractive

    Static Function UserName() As String
        If Object.ReferenceEquals(userName, Nothing) Then
            Dim buf[UNLEN] As TCHAR
            Dim len = (UNLEN + 1) As DWord
            GetUserName(buf, len)
            userName = New String(buf, len As Long)
        End If
        Return userName
    End Function

    ' Version

Public
    'NTでしか使用できない仕様
    Static Function WorkingSet() As Int64
        Dim hmodPSAPI = LoadLibrary("PSAPI.DLL")
        If hmodPSAPI = 0 Then Return 0
        Dim pGetProcessMemoryInfo = GetProcAddress(hmodPSAPI, ToMBStr("GetProcessMemoryInfo")) As Detail.PFNGetProcessMemoryInfo
        If pGetProcessMemoryInfo <> 0 Then
            Dim mc As PROCESS_MEMORY_COUNTERS
            If pGetProcessMemoryInfo(GetCurrentProcess(), mc, Len (mc)) <> FALSE Then
                WorkingSet = mc.WorkingSetSize
            End If
        End If
        FreeLibrary(hmodPSAPI)
    End Function

    ' Methods

    Static Sub Exit(exitCode As Long)
        Environment.exitCode = exitCode
        End
    End Sub

    Static Function ExpandEnvironmentVariables(s As String) As String
        Dim src = ToTCStr(s)
        Dim size = ExpandEnvironmentStrings(src, 0, 0)
        Dim dst = _System_malloc(SizeOf (TCHAR) * size) As PTSTR
        ExpandEnvironmentStrings(src, dst, size)
        ExpandEnvironmentVariables = New String(dst, size - 1)
        _System_free(dst)
    End Function

    Static Sub FailFast(message As String)
        FatalAppExit(0, ToTCStr(message))
    End Sub

    ' GetCommandLineArgs

    Static Function GetEnvironmentVariable(variable As String) As String
        Dim tcsVariable = ToTCStr(variable)
        Dim size = _System_GetEnvironmentVariable(tcsVariable, 0, 0)
        Dim p = _System_malloc(SizeOf (TCHAR) * size) As PTSTR
        Dim len = _System_GetEnvironmentVariable(tcsVariable, p, size)
        GetEnvironmentVariable = New String(p, len As Long)
        _System_free(p)
    End Function

    ' GetEnvironmentVariables

    Static Function GetFolderPath(f As Environment_SpecialFolder) As String
'       If ... Then
'           Throw New ArgumentException
'       End If
        Dim x As Long
        x = f
        Return ActiveBasic.Windows.GetFolderPath(x)
    End Function

    ' GetLogicalDrives

    Static Sub SetEnvironmentVariable(variable As String, value As String)
        _System_SetEnvironmentVariable(ToTCStr(variable), ToTCStr(value))
    End Sub

Private
    Static cmdLine = Nothing As String
    Static exitCode = 0 As Long
    Static machineName = Nothing As String
    Static osVer = Nothing As OperatingSystem
    Static processorCount = 0 As Long
    Static sysDir = Nothing As String
    Static userName = Nothing As String
End Class

Enum Environment_SpecialFolder
    Desktop = CSIDL_DESKTOP
    Programs = CSIDL_PROGRAMS
    Personal = CSIDL_PERSONAL
    MyDocuments = CSIDL_PERSONAL
    Favorites = CSIDL_FAVORITES
    Startup = CSIDL_STARTUP
    Recent = CSIDL_RECENT
    SendTo = CSIDL_SENDTO
    StartMenu = CSIDL_STARTMENU
    MyMusic = CSIDL_MYMUSIC
    DesktopDirectory = CSIDL_DESKTOPDIRECTORY
    MyComputer = CSIDL_DRIVES
    Templates = CSIDL_TEMPLATES
    ApplicationData = CSIDL_APPDATA '4.71
    LocalApplicationData = CSIDL_LOCAL_APPDATA
    InternetCache = CSIDL_INTERNET_CACHE
    Cookies = CSIDL_COOKIES
    History = CSIDL_HISTORY
    CommonApplicationData = CSIDL_COMMON_APPDATA '5.0
    System = CSIDL_SYSTEM
    CommonProgramFiles = CSIDL_PROGRAM_FILES
    ProgramFiles = CSIDL_PROGRAM_FILES
    MyPictures = CSIDL_MYPICTURES
End Enum

End Namespace 'System