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

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

#_fullcompileで検出されたエラーの修正(明らかに判るもののみ)

File size: 3.6 KB
RevLine 
[142]1' System/Environment.ab
2
[237]3#require <api_psapi.sbp>
[142]4#require <Classes/System/OperatingSystem.ab>
5
6Class Environment
7Public
8 ' Properties
9
10 Static Function CommandLine() As String
[237]11 If Object.ReferenceEquals(cmdLine, Nothing) Then
[142]12#ifdef __STRING_IS_NOT_UNICODE
13 cmdLine = New String(GetCommandLineA())
14#else
15 cmdLine = New String(GetCommandLineW())
16#endif
17 End If
18 Return cmdLine
19 End Function
20
21 Static Function CurrentDirectory() As String
22 Dim size = GetCurrentDirectory(0, 0)
23 Dim p = _System_malloc(SizeOf (TCHAR) * size) As PCTSTR
[208]24 Dim len = GetCurrentDirectory(size, p)
25 If len < size Then
26 CurrentDirectory = New String(p, size As Long)
27 _System_free(p)
28 End If
[142]29 End Function
30
31 Static Sub CurrentDirectory(cd As String)
32 SetCurrentDirectory(ToTCStr(cd))
33 End Sub
34
35 Static Function ExitCode() As Long
36 Return exitCode
37 End Function
38
39 Static Sub ExitCode(code As Long)
40 exitCode = code
41 End Sub
42
[173]43 Static Function HasShutdownStarted() As Boolean
[142]44 Return False
[173]45 End Function
[142]46
47 ' MachineName
48
49 Static Function NewLine() As String
50 Return Ex"\r\n"
51 End Function
52
53 Static Function OSVersion() As OperatingSystem
[237]54 If Object.ReferenceEquals(osVer, Nothing) Then
[142]55 Dim vi As OSVERSIONINFO
[233]56 GetVersionEx(vi)
[142]57 osVer = New OperatingSystem(vi)
58 End If
59 Return osVer
60 End Function
61
62 Static Function ProcessorCount() As Long
63 If processorCount = 0 Then
64 Dim si As SYSTEM_INFO
65 GetSystemInfo(si)
66 processorCount = si.dwNumberOfProcessors
67 End If
68 Return processorCount
69 End Function
70
71 ' StackTrace
72
73 Static Function SystemDirectory() As String
[237]74 If Object.ReferenceEquals(sysDir, Nothing) Then
[142]75 Dim size = GetSystemDirectory(0, 0)
[237]76 Dim p = _System_malloc(SizeOf (TCHAR) * size) As PTSTR
77 Dim len = GetSystemDirectory(p, size)
[208]78 sysDir = New String(p, len As Long)
[142]79 _System_free(p)
80 End IF
81 Return sysDir
82 End Function
83
84 Static Function TickCount() As Long
85 Return GetTickCount() As Long
86 End Function
87
88 ' UserDomainName
89
90 ' UserInteractive
91
92 ' UserName
93
94 ' Version
95
96 Static Function WorkingSet() As Int64
[237]97 TypeDef PFNGetProcessMemoryInfo = *Function(Process As HANDLE, ByRef mc As PROCESS_MEMORY_COUNTERS, cb As DWord) As BOOL
98 Dim pGetProcessMemoryInfo As PFNGetProcessMemoryInfo
[142]99 Dim hmodPSAPI = LoadLibrary("PSAPI.DLL")
100 If hmodPSAPI = 0 Then Return 0
[237]101 pGetProcessMemoryInfo = GetProcAddress(hmodPSAPI, ToMBStr("GetProcessMemoryInfo")) As PFNGetProcessMemoryInfo
[142]102 If pGetProcessMemoryInfo <> 0 Then
[237]103 Dim mc As PROCESS_MEMORY_COUNTERS
[142]104 If pGetProcessMemoryInfo(GetCurrentProcess(), mc, Len (mc)) <> FALSE Then
105 WorkingSet = mc.WorkingSetSize
[237]106
[142]107 End If
108 End If
109 FreeLibrary(hmodPSAPI)
110 End Function
111
112 ' Methods
113
114 Static Sub Exit(exitCode As Long)
115 Environment.exitCode = exitCode
116 End
117 End Sub
118
119 Static Function ExpandEnvironmentVariables(s As String) As String
120 Dim src = ToTCStr(s)
121 Dim size = ExpandEnvironmentStrings(src, 0, 0)
[237]122 Dim dst = _System_malloc(SizeOf (TCHAR) * size) As PTSTR
[142]123 ExpandEnvironmentStrings(src, dst, size)
[208]124 ExpandEnvironmentVariables = New String(dst, size - 1)
[142]125 _System_free(dst)
126 End Function
127
128 Static Sub FailFast(message As String)
[208]129 FatalAppExit(0, ToTCStr(message))
[142]130 End Sub
131
132 ' GetCommandLineArgs
133
134 ' GetEnvironmentVariable
135
136 ' GetEnvironmentVariables
137
138 ' GetLogicalDrives
139
140 ' SetEnvironmentVariable
141
142Private
[152]143 Static cmdLine = Nothing As String
[142]144 Static exitCode = 0 As Long
145 Static osVer = Nothing As OperatingSystem
146 Static processorCount = 0 As Long
147 Static sysDir = Nothing As String
148End Class
Note: See TracBrowser for help on using the repository browser.