source: trunk/ab5.0/ablib/src/Classes/System/Environment.ab@ 629

' System/Environment.ab

#require <api_psapi.sbp>

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
#ifdef UNICODE
            CommandLine = New String(GetCommandLineW())
#else
            CommandLine = New String(GetCommandLineA())
#endif
    End Function

    Static Function CurrentDirectory() As String
        Dim size = GetCurrentDirectory(0, 0)
        Dim buf = New Text.StringBuilder
        buf.Length = size As Long
        Dim len = GetCurrentDirectory(size, StrPtr(buf))
        If len < size Then
            CurrentDirectory = buf.ToString
        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
        Dim len = (MAX_COMPUTERNAME_LENGTH + 1) As DWord
        Dim buf = New Text.StringBuilder
        With buf
            .Length = MAX_COMPUTERNAME_LENGTH
            GetComputerName(StrPtr(buf), len)
            .Length = len
            MachineName = .ToString
        End With
    End Function

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

    Static Function OSVersion() As OperatingSystem
        Dim vi As OSVERSIONINFO
        vi.dwOSVersionInfoSize = Len(vi)
        GetVersionEx(vi)
        OSVersion = New OperatingSystem(vi)
    End Function

    Static Function ProcessorCount() As Long
        Dim si As SYSTEM_INFO
        GetSystemInfo(si)
        ProcessorCount = si.dwNumberOfProcessors
    End Function

    ' StackTrace

    Static Function SystemDirectory() As String
        Dim size = GetSystemDirectory(0, 0)
        Dim buf = New Text.StringBuilder
        With buf
            .Length = size
            Dim len = GetSystemDirectory(StrPtr(buf), len)
            .Length = len
            SystemDirectory = .ToString
        End With
    End Function

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

    ' UserDomainName

    ' UserInteractive

    Static Function UserName() As String
        Dim len = (MAX_COMPUTERNAME_LENGTH + 1) As DWord
        Dim buf = New Text.StringBuilder
        With buf
            .Length = MAX_COMPUTERNAME_LENGTH
            GetUserName(StrPtr(buf), len)
            .Length = len
            UserName = .ToString
        End With
    End Function

    ' Version

Public
    'NTでしか使用できない仕様
    Static Function WorkingSet() As SIZE_T
        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
        If ActiveBasic.IsNothing(s) Then
            Throw New ArgumentNullException("s")
        End If
        Dim src = ToTCStr(s)
        Dim size = ExpandEnvironmentStrings(src, 0, 0)
        Dim dst = New Text.StringBuilder
        dst.Length = size As Long
        ExpandEnvironmentStrings(src, StrPtr(dst), size)
        dst.Length = (size - 1) As Long
        ExpandEnvironmentVariables = dst.ToString
    End Function

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

    ' GetCommandLineArgs

    Static Function GetEnvironmentVariable(variable As String) As String
        If ActiveBasic.IsNothing(variable) Then
            Throw New ArgumentNullException("variable")
        End If
        Dim tcsVariable = ToTCStr(variable)
        Dim size = _System_GetEnvironmentVariable(tcsVariable, 0, 0)
        Dim buf = New Text.StringBuilder
        buf.Length = size As Long
        buf.Length  = _System_GetEnvironmentVariable(tcsVariable, StrPtr(buf), size)
        GetEnvironmentVariable = buf.ToString
    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)
        If ActiveBasic.IsNothing(variable) Then
            Throw New ArgumentNullException("variable")
        End If
        _System_SetEnvironmentVariable(ToTCStr(variable), ToTCStr(value))
    End Sub

Private
    Static exitCode = 0 As Long
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