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

Last change on this file since 368 was 337, checked in by dai, 17 years ago

index.abを一つにまとめた。

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