vdfsplat / AppSrc / cSystemInfo.pkg @ 65
History | View | Annotate | Download (8.42 KB)
| 1 |
// |
|---|---|
| 2 |
// This code is based on the sysinfo.src program written by Vincent Oorsprong |
| 3 |
// and was put into the DAW forums here: |
| 4 |
// http://support.dataaccess.com/forums/showthread.php?t=42786 |
| 5 |
// |
| 6 |
// As per MSDN a few changes have been made like using the GetNativeSystemInfo call. |
| 7 |
// |
| 8 |
|
| 9 |
Use Windows.Pkg |
| 10 |
Use Dferror.Pkg |
| 11 |
|
| 12 |
Type SYSTEM_INFO |
| 13 |
Field SYSTEM_INFO.wProcessorArchitecture As Word |
| 14 |
Field SYSTEM_INFO.wReserved As Word |
| 15 |
Field SYSTEM_INFO.dwPageSize As Dword |
| 16 |
Field SYSTEM_INFO.lpMinimumApplicationAddress As Pointer |
| 17 |
Field SYSTEM_INFO.lpMaximumApplicationAddress As Pointer |
| 18 |
Field SYSTEM_INFO.dwActiveProcessorMask As Dword |
| 19 |
Field SYSTEM_INFO.dwNumberOfProcessors As Dword |
| 20 |
Field SYSTEM_INFO.dwProcessorType As Dword |
| 21 |
Field SYSTEM_INFO.dwAllocationGranularity As Dword |
| 22 |
Field SYSTEM_INFO.wProcessorLevel As Word |
| 23 |
Field SYSTEM_INFO.wProcessorRevision As Word |
| 24 |
End_Type // SYSTEM_INFO |
| 25 |
|
| 26 |
External_Function GetNativeSystemInfoEf "GetNativeSystemInfo" Kernel32.Dll Pointer lpSystemInfo Returns Integer |
| 27 |
|
| 28 |
#IFNDEF PROCESSOR_INTEL_386 |
| 29 |
Define PROCESSOR_INTEL_386 For 386 |
| 30 |
Define PROCESSOR_INTEL_486 For 486 |
| 31 |
Define PROCESSOR_INTEL_PENTIUM For 586 |
| 32 |
Define PROCESSOR_MIPS_R4000 For 4000 // incl R4101 & R3910 for Windows CE |
| 33 |
Define PROCESSOR_ALPHA_21064 For 21064 |
| 34 |
Define PROCESSOR_PPC_601 For 601 |
| 35 |
Define PROCESSOR_PPC_603 For 603 |
| 36 |
Define PROCESSOR_PPC_604 For 604 |
| 37 |
Define PROCESSOR_PPC_620 For 620 |
| 38 |
Define PROCESSOR_HITACHI_SH3 For 10003 // Windows CE |
| 39 |
Define PROCESSOR_HITACHI_SH3E For 10004 // Windows CE |
| 40 |
Define PROCESSOR_HITACHI_SH4 For 10005 // Windows CE |
| 41 |
Define PROCESSOR_MOTOROLA_821 For 821 // Windows CE |
| 42 |
Define PROCESSOR_SHx_SH3 For 103 // Windows CE |
| 43 |
Define PROCESSOR_SHx_SH4 For 104 // Windows CE |
| 44 |
Define PROCESSOR_STRONGARM For 2577 // Windows CE - 0xA11 |
| 45 |
Define PROCESSOR_ARM720 For 1824 // Windows CE - 0x720 |
| 46 |
Define PROCESSOR_ARM820 For 2080 // Windows CE - 0x820 |
| 47 |
Define PROCESSOR_ARM920 For 2336 // Windows CE - 0x920 |
| 48 |
Define PROCESSOR_ARM_7TDMI For 70001 // Windows CE |
| 49 |
|
| 50 |
Define PROCESSOR_ARCHITECTURE_INTEL For 0 |
| 51 |
Define PROCESSOR_ARCHITECTURE_MIPS For 1 |
| 52 |
Define PROCESSOR_ARCHITECTURE_ALPHA For 2 |
| 53 |
Define PROCESSOR_ARCHITECTURE_PPC For 3 |
| 54 |
Define PROCESSOR_ARCHITECTURE_SHX For 4 |
| 55 |
Define PROCESSOR_ARCHITECTURE_ARM For 5 |
| 56 |
Define PROCESSOR_ARCHITECTURE_IA64 For 6 |
| 57 |
Define PROCESSOR_ARCHITECTURE_ALPHA64 For 7 |
| 58 |
Define PROCESSOR_ARCHITECTURE_AMD64 For 9 // x64 (AMD or Intel) |
| 59 |
Define PROCESSOR_ARCHITECTURE_UNKNOWN For |CI$FFFF |
| 60 |
#ENDIF |
| 61 |
|
| 62 |
Class cSystemInfo is a cObject |
| 63 |
|
| 64 |
|
| 65 |
Procedure Construct_Object |
| 66 |
Forward send Construct_Object |
| 67 |
Property Integer piProcessorArchitecture PROCESSOR_ARCHITECTURE_UNKNOWN |
| 68 |
Property Integer piProcessorCount 0 |
| 69 |
Property Integer piProcessorType 0 |
| 70 |
Property Integer piProcessorLevel 0 |
| 71 |
Property Integer piProcessorRevision 0 |
| 72 |
End_Procedure // Construct_Object |
| 73 |
|
| 74 |
|
| 75 |
Procedure DoGetSystemInfo |
| 76 |
String sSystemInfo |
| 77 |
Integer iVoid iProcessorArchitecture iProcessorType iProcessorLevel iProcessorRevision iProcessorCount |
| 78 |
|
| 79 |
ZeroType SYSTEM_INFO To sSystemInfo |
| 80 |
|
| 81 |
Move (GetNativeSystemInfoEf (AddressOf (sSystemInfo))) To iVoid |
| 82 |
|
| 83 |
GetBuff From sSystemInfo At SYSTEM_INFO.wProcessorArchitecture To iProcessorArchitecture |
| 84 |
|
| 85 |
GetBuff From sSystemInfo At SYSTEM_INFO.dwNumberOfProcessors To iProcessorCount |
| 86 |
|
| 87 |
GetBuff From sSystemInfo At SYSTEM_INFO.dwProcessorType To iProcessorType |
| 88 |
|
| 89 |
GetBuff From sSystemInfo At SYSTEM_INFO.wProcessorLevel To iProcessorLevel |
| 90 |
Case Begin |
| 91 |
Case (iProcessorArchitecture = PROCESSOR_ARCHITECTURE_INTEL) |
| 92 |
Case Begin |
| 93 |
Case (iProcessorLevel = 3) |
| 94 |
//Showln "Intel 80386" |
| 95 |
Case Break |
| 96 |
Case (iProcessorLevel = 4) |
| 97 |
//Showln "Intel 80486" |
| 98 |
Case Break |
| 99 |
Case (iProcessorLevel = 5) |
| 100 |
//Showln "Intel Pentium" |
| 101 |
Case Break |
| 102 |
Case (iProcessorLevel = 6) |
| 103 |
//Showln "Intel Pentium Pro or Pentium II" |
| 104 |
Case Break |
| 105 |
Case Else |
| 106 |
//Showln "Intel MSDN unspecified " iProcessorLevel |
| 107 |
Case Break |
| 108 |
Case End |
| 109 |
Case Break |
| 110 |
Case (iProcessorArchitecture = PROCESSOR_ARCHITECTURE_IA64) |
| 111 |
//Showln "Intel 64 bits" |
| 112 |
Case Break |
| 113 |
Case (iProcessorArchitecture = PROCESSOR_ARCHITECTURE_MIPS) |
| 114 |
If ((iProcessorLevel iAnd $FF) = 4) Begin |
| 115 |
//Showln "MIPS R4000" |
| 116 |
End |
| 117 |
Else Begin |
| 118 |
//Showln "MIPS MSDN unspecified " iProcessorLevel |
| 119 |
End |
| 120 |
Case Break |
| 121 |
Case (iProcessorArchitecture = PROCESSOR_ARCHITECTURE_ALPHA) |
| 122 |
Case Begin |
| 123 |
Case (iProcessorLevel = 21064) |
| 124 |
//Showln "Alpha 21064" |
| 125 |
Case Break |
| 126 |
Case (iProcessorLevel = 21066) |
| 127 |
//Showln "Alpha 21066" |
| 128 |
Case Break |
| 129 |
Case (iProcessorLevel = 21164) |
| 130 |
//Showln "Alpha 21164" |
| 131 |
Case Break |
| 132 |
Case Else |
| 133 |
//Showln "Alpha MSDN unspecified" |
| 134 |
Case Break |
| 135 |
Case End |
| 136 |
Case Break |
| 137 |
Case (iProcessorArchitecture = PROCESSOR_ARCHITECTURE_PPC) |
| 138 |
Case Begin |
| 139 |
Case (iProcessorLevel = 1) |
| 140 |
//Showln "PPC 601" |
| 141 |
Case Break |
| 142 |
Case (iProcessorLevel = 3) |
| 143 |
//Showln "PPC 603" |
| 144 |
Case Break |
| 145 |
Case (iProcessorLevel = 4) |
| 146 |
//Showln "PPC 604" |
| 147 |
Case Break |
| 148 |
Case (iProcessorLevel = 6) |
| 149 |
//Showln "PPC 603+" |
| 150 |
Case Break |
| 151 |
Case (iProcessorLevel = 9) |
| 152 |
//Showln "PPC 604+" |
| 153 |
Case Break |
| 154 |
Case (iProcessorLevel = 20) |
| 155 |
//Showln "PPC 620" |
| 156 |
Case Break |
| 157 |
Case Else |
| 158 |
//Showln "PPC MSDN unspecified" |
| 159 |
Case Break |
| 160 |
Case End |
| 161 |
Case Break |
| 162 |
Case Else |
| 163 |
//Showln "Architecture MSDN unspecified, processor level " iProcessorLevel |
| 164 |
Case Break |
| 165 |
Case End |
| 166 |
|
| 167 |
GetBuff From sSystemInfo At SYSTEM_INFO.wProcessorRevision To iProcessorRevision |
| 168 |
//Show "ProcessorRevision; " |
| 169 |
Case Begin |
| 170 |
Case (iProcessorType = PROCESSOR_INTEL_386) |
| 171 |
Case (iProcessorType = PROCESSOR_INTEL_486) |
| 172 |
If ((iProcessorRevision / $000000FF) = $FF) Begin |
| 173 |
//Showln "Model " ((iProcessorRevision iAnd $000000FF) - $0A) ", stepping " (iProcessorRevision iAnd $0000000F) |
| 174 |
End |
| 175 |
Else Begin |
| 176 |
//Showln "Model " (iProcessorRevision / $000000FF) "A, minor stepping " (iProcessorRevision iAnd $000000FF) |
| 177 |
End |
| 178 |
Case Break |
| 179 |
Case (iProcessorType = PROCESSOR_INTEL_PENTIUM) |
| 180 |
//Showln "Model " (iProcessorRevision / $000000FF) ", stepping " (iProcessorRevision iAnd $000000FF) |
| 181 |
Case Break |
| 182 |
Case (iProcessorType = PROCESSOR_MIPS_R4000) |
| 183 |
//Showln "Processor revision " (iProcessorRevision iAnd $000000FF) |
| 184 |
Case Break |
| 185 |
Case (iProcessorType = PROCESSOR_ALPHA_21064) |
| 186 |
//Showln "Model A+" (iProcessorRevision / $000000FF) ", Pass " (iProcessorRevision iAnd $000000FF) |
| 187 |
Case Break |
| 188 |
Case (iProcessorType = PROCESSOR_PPC_601) |
| 189 |
Case (iProcessorType = PROCESSOR_PPC_603) |
| 190 |
Case (iProcessorType = PROCESSOR_PPC_604) |
| 191 |
Case (iProcessorType = PROCESSOR_PPC_620) |
| 192 |
//Showln (iProcessorRevision / $000000FF) "." (iProcessorRevision iAnd $000000FF) |
| 193 |
Case Break |
| 194 |
Case Else |
| 195 |
//Showln "Unkown type: " iProcessorRevision |
| 196 |
Case Break |
| 197 |
Case End |
| 198 |
Set piProcessorArchitecture To iProcessorArchitecture |
| 199 |
Set piProcessorCount To iProcessorCount |
| 200 |
Set piProcessorType To iProcessorType |
| 201 |
Set piProcessorLevel To iProcessorLevel |
| 202 |
Set piProcessorRevision To iProcessorRevision |
| 203 |
End_Procedure // DoGetSystemInfo |
| 204 |
|
| 205 |
|
| 206 |
Procedure End_Construct_Object |
| 207 |
Send DoGetSystemInfo |
| 208 |
Forward send End_Construct_Object |
| 209 |
End_Procedure |
| 210 |
End_Class // cSystemInfo |
| 211 |
|