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

Last change on this file since 426 was 388, checked in by イグトランス (egtra), 17 years ago

Stringなどで例外を投げるようにした。
#147の解決。
CType ASCII文字判定関数群の追加。

File size: 6.0 KB
Line 
1' System/Environment.ab
2
3#require <api_psapi.sbp>
4
5Declare Function _System_SetEnvironmentVariable Lib "kernel32" Alias _FuncName_SetEnvironmentVariable (lpName As LPCTSTR, lpValue As LPTSTR) As BOOL
6Declare Function _System_GetEnvironmentVariable Lib "kernel32" Alias _FuncName_GetEnvironmentVariable (lpName As PCTSTR, lpBuffer As PTSTR, nSize As DWord) As DWord
7
8Namespace System
9
10Namespace Detail
11 TypeDef PFNGetProcessMemoryInfo = *Function(Process As HANDLE, ByRef mc As PROCESS_MEMORY_COUNTERS, cb As DWord) As BOOL
12
13 Dim hasShutdownStarted As Boolean
14End Namespace
15
16Class Environment
17Public
18 ' Properties
19
20 Static Function CommandLine() As String
21 If Object.ReferenceEquals(cmdLine, Nothing) Then
22#ifdef __STRING_IS_NOT_UNICODE
23 cmdLine = New String(GetCommandLineA())
24#else
25 cmdLine = New String(GetCommandLineW())
26#endif
27 End If
28 Return cmdLine
29 End Function
30
31 Static Function CurrentDirectory() As String
32 Dim size = GetCurrentDirectory(0, 0)
33 Dim p = GC_malloc_atomic(SizeOf (TCHAR) * size) As PCTSTR
34 Dim len = GetCurrentDirectory(size, p)
35 If len < size Then
36 CurrentDirectory = New String(p, size As Long)
37 End If
38 End Function
39
40 Static Sub CurrentDirectory(cd As String)
41 SetCurrentDirectory(ToTCStr(cd))
42 End Sub
43
44 Static Function ExitCode() As Long
45 Return exitCode
46 End Function
47
48 Static Sub ExitCode(code As Long)
49 exitCode = code
50 End Sub
51
52 Static Function HasShutdownStarted() As Boolean
53 Return Detail.hasShutdownStarted
54 End Function
55
56 Static Function MachineName() As String
57 If Object.ReferenceEquals(machineName, Nothing) Then
58 Dim buf[MAX_COMPUTERNAME_LENGTH] As TCHAR
59 Dim len = (MAX_COMPUTERNAME_LENGTH + 1) As DWord
60 GetComputerName(buf, len)
61 machineName = New String(buf, len As Long)
62 End If
63 Return machineName
64 End Function
65
66 Static Function NewLine() As String
67 Return Ex"\r\n"
68 End Function
69
70 Static Function OSVersion() As OperatingSystem
71 If Object.ReferenceEquals(osVer, Nothing) Then
72 Dim vi As OSVERSIONINFO
73 GetVersionEx(vi)
74 osVer = New OperatingSystem(vi)
75 End If
76 Return osVer
77 End Function
78
79 Static Function ProcessorCount() As Long
80 If processorCount = 0 Then
81 Dim si As SYSTEM_INFO
82 GetSystemInfo(si)
83 processorCount = si.dwNumberOfProcessors
84 End If
85 Return processorCount
86 End Function
87
88 ' StackTrace
89
90 Static Function SystemDirectory() As String
91 If Object.ReferenceEquals(sysDir, Nothing) Then
92 Dim size = GetSystemDirectory(0, 0)
93 Dim p = GC_malloc_atomic(SizeOf (TCHAR) * size) As PTSTR
94 Dim len = GetSystemDirectory(p, size)
95 sysDir = New String(p, len As Long)
96 End If
97 Return sysDir
98 End Function
99
100 Static Function TickCount() As Long
101 Return GetTickCount() As Long
102 End Function
103
104 ' UserDomainName
105
106 ' UserInteractive
107
108 Static Function UserName() As String
109 If Object.ReferenceEquals(userName, Nothing) Then
110 Dim buf[UNLEN] As TCHAR
111 Dim len = (UNLEN + 1) As DWord
112 GetUserName(buf, len)
113 userName = New String(buf, len As Long)
114 End If
115 Return userName
116 End Function
117
118 ' Version
119
120Public
121 'NTでしか使用できない仕様
122 Static Function WorkingSet() As Int64
123 Dim hmodPSAPI = LoadLibrary("PSAPI.DLL")
124 If hmodPSAPI = 0 Then Return 0
125 Dim pGetProcessMemoryInfo = GetProcAddress(hmodPSAPI, ToMBStr("GetProcessMemoryInfo")) As Detail.PFNGetProcessMemoryInfo
126 If pGetProcessMemoryInfo <> 0 Then
127 Dim mc As PROCESS_MEMORY_COUNTERS
128 If pGetProcessMemoryInfo(GetCurrentProcess(), mc, Len (mc)) <> FALSE Then
129 WorkingSet = mc.WorkingSetSize
130 End If
131 End If
132 FreeLibrary(hmodPSAPI)
133 End Function
134
135 ' Methods
136
137 Static Sub Exit(exitCode As Long)
138 Environment.exitCode = exitCode
139 End
140 End Sub
141
142 Static Function ExpandEnvironmentVariables(s As String) As String
143 Dim src = ToTCStr(s)
144 Dim size = ExpandEnvironmentStrings(src, 0, 0)
145 Dim dst = GC_malloc_atomic(SizeOf (TCHAR) * size) As PTSTR
146 ExpandEnvironmentStrings(src, dst, size)
147 ExpandEnvironmentVariables = New String(dst, size - 1)
148 End Function
149
150 Static Sub FailFast(message As String)
151 FatalAppExit(0, ToTCStr(message))
152 End Sub
153
154 ' GetCommandLineArgs
155
156 Static Function GetEnvironmentVariable(variable As String) As String
157 Dim tcsVariable = ToTCStr(variable)
158 Dim size = _System_GetEnvironmentVariable(tcsVariable, 0, 0)
159 Dim p = GC_malloc_atomic(SizeOf (TCHAR) * size) As PTSTR
160 Dim len = _System_GetEnvironmentVariable(tcsVariable, p, size)
161 GetEnvironmentVariable = New String(p, len As Long)
162 End Function
163
164 ' GetEnvironmentVariables
165
166 Static Function GetFolderPath(f As Environment_SpecialFolder) As String
167' If ... Then
168' Throw New ArgumentException
169' End If
170 Dim x As Long
171 x = f
172 Return ActiveBasic.Windows.GetFolderPath(x)
173 End Function
174
175 ' GetLogicalDrives
176
177 Static Sub SetEnvironmentVariable(variable As String, value As String)
178 _System_SetEnvironmentVariable(ToTCStr(variable), ToTCStr(value))
179 End Sub
180
181Private
182 Static cmdLine = Nothing As String
183 Static exitCode = 0 As Long
184 Static machineName = Nothing As String
185 Static osVer = Nothing As OperatingSystem
186 Static processorCount = 0 As Long
187 Static sysDir = Nothing As String
188 Static userName = Nothing As String
189End Class
190
191Enum Environment_SpecialFolder
192 Desktop = CSIDL_DESKTOP
193 Programs = CSIDL_PROGRAMS
194 Personal = CSIDL_PERSONAL
195 MyDocuments = CSIDL_PERSONAL
196 Favorites = CSIDL_FAVORITES
197 Startup = CSIDL_STARTUP
198 Recent = CSIDL_RECENT
199 SendTo = CSIDL_SENDTO
200 StartMenu = CSIDL_STARTMENU
201 MyMusic = CSIDL_MYMUSIC
202 DesktopDirectory = CSIDL_DESKTOPDIRECTORY
203 MyComputer = CSIDL_DRIVES
204 Templates = CSIDL_TEMPLATES
205 ApplicationData = CSIDL_APPDATA '4.71
206 LocalApplicationData = CSIDL_LOCAL_APPDATA
207 InternetCache = CSIDL_INTERNET_CACHE
208 Cookies = CSIDL_COOKIES
209 History = CSIDL_HISTORY
210 CommonApplicationData = CSIDL_COMMON_APPDATA '5.0
211 System = CSIDL_SYSTEM
212 CommonProgramFiles = CSIDL_PROGRAM_FILES
213 ProgramFiles = CSIDL_PROGRAM_FILES
214 MyPictures = CSIDL_MYPICTURES
215End Enum
216
217End Namespace 'System
Note: See TracBrowser for help on using the repository browser.