source: Include/Classes/System/Environment.ab@ 286

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

StringのResizeを呼ぶコンストラクタでメモリ確保されない場合を排除、ほか微修正

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