' 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
		If Object.ReferenceEquals(cmdLine, Nothing) Then
#ifdef UNICODE
			cmdLine = New String(GetCommandLineW())
#else
			cmdLine = New String(GetCommandLineA())
#endif
		End If
		Return cmdLine
	End Function

	Static Function CurrentDirectory() As String
		Dim size = GetCurrentDirectory(0, 0)
		Dim p = GC_malloc_atomic(SizeOf (TCHAR) * size) As PCTSTR
		Dim len = GetCurrentDirectory(size, p)
		If len < size Then
			CurrentDirectory = New String(p, len As Long)
		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 = GC_malloc_atomic(SizeOf (TCHAR) * size) As PTSTR
			Dim len = GetSystemDirectory(p, size)
			sysDir = New String(p, len As Long)
		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 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 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