1 unit CommonUnit;
2
3 interface
4
5 uses
6 Windows, SysUtils, DateUtils;
7
8 Const
9 CPUVendorIDs: array [0 .. 5] of string = ('GenuineIntel', 'UMC UMC UMC',
10 'AuthenticAMD', 'CyrixInstead', 'NexGenDriven', 'CentaurHauls');
11 // 将CPU厂家信息转换成字串形式
12 CPUVendors: array [0 .. 5] of string = ('Intel', 'UMC', 'AMD', 'Cyrix',
13 'NexGen', 'CentaurHauls');
14
15 type
16 TVendor = array [0 .. 11] of AnsiChar;
17
18 { 将AnsiString的乱码转换成能正常显示的Utf8编码的字符串 }
19 function DecodeUtf8Str(const S: string): WideString;
20 function DateToInt64(date: TDateTime): Int64;
21 function Int64ToDate(num: Int64): TDateTime;
22
23 function GetCPUID: string;
24 function GetIdeSerialNumber: string;
25 function GetCPUVendor: TVendor;
26 function GetCPUV: string;
27
28 implementation
29
30 function DecodeUtf8Str(const S: string): WideString;
31 var
32 lenSrc, lenDst: Integer;
33 begin
34 lenSrc := Length(S);
35 if (lenSrc = 0) then
36 Exit;
37 lenDst := MultiByteToWideChar(CP_UTF8, 0, Pointer(S), lenSrc, nil, 0);
38 SetLength(Result, lenDst);
39 MultiByteToWideChar(CP_UTF8, 0, Pointer(S), lenSrc, Pointer(Result), lenDst);
40 end;
41
42 function DateToInt64(date: TDateTime): Int64;
43 var
44 Bias: Integer;
45 a1, a2: Extended;
46 T1, T2: TDateTime;
47 TS, TS2: TTimeStamp;
48 pTime: _TIME_ZONE_INFORMATION;
49 begin
50 GetTimeZoneInformation(pTime); // 获取时区
51 Bias := pTime.Bias;
52 T1 := IncMinute(date, Bias);
53 T2 := EncodeDateTime(1970, 1, 1, 0, 0, 0, 0);
54 TS := DateTimeToTimeStamp(T1);
55 TS2 := DateTimeToTimeStamp(T2);
56 a1 := TimeStampToMSecs(TS);
57 a2 := TimeStampToMSecs(TS2);
58
59 Result := StrToInt64Def(FloatToStr(a1 - a2), 0);
60 end;
61
62 function Int64ToDate(num: Int64): TDateTime;
63 var
64 Bias: Integer;
65 a1, a2: Extended;
66 T1, T2: TDateTime;
67 TS, TS2: TTimeStamp;
68 pTime: _TIME_ZONE_INFORMATION;
69 begin
70 GetTimeZoneInformation(pTime); // 获取时区
71 Bias := pTime.Bias;
72 // Bias := Bias + pTime.DaylightBias;
73 T2 := EncodeDateTime(1970, 1, 1, 0, 0, 0, 0);
74 TS2 := DateTimeToTimeStamp(T2);
75 a2 := TimeStampToMSecs(TS2);
76 a1 := StrToFloat(IntToStr(num));
77 TS := MSecsToTimeStamp(a1 + a2);
78 T1 := TimeStampToDateTime(TS);
79 T1 := IncMinute(T1, -Bias);
80 Result := T1;
81 end;
82
83 function GetCPUID: string;
84 procedure SetCPU(Handle: THandle; CPUNO: Integer);
85 var
86 ProcessAffinity: Cardinal;
87 _SystemAffinity: Cardinal;
88 begin
89 GetProcessAffinityMask(Handle, ProcessAffinity, _SystemAffinity);
90 ProcessAffinity := CPUNO;
91 SetProcessAffinityMask(Handle, ProcessAffinity);
92 end;
93
94 const
95 CPUINFO = '%s-%.8x%.8x';
96 var
97 iEax: Integer;
98 iEbx: Integer;
99 iEcx: Integer;
100 iEdx: Integer;
101 begin
102 SetCPU(GetCurrentProcess, 1);
103 asm
104 push ebx
105 push ecx
106 push edx
107 mov eax, 1
108 DW $A20F// cpuid
109 mov iEax, eax
110 mov iEbx, ebx
111 mov iEcx, ecx
112 mov iEdx, edx
113 pop edx
114 pop ecx
115 pop ebx
116 end
117 ;
118
119 Result := Format(CPUINFO, [GetCPUV, iEdx,iEax]);
120 end;
121
122 function GetCPUV: string;
123 var
124 Vendor: string;
125 VendorID, I: Integer;
126 begin
127 Vendor := GetCPUVendor;
128 {for I := 0 to High(CPUVendorIDs) do
129 begin
130 If Vendor = CPUVendorIDs[I] then
131 begin
132 Vendor := CPUVendorIDs[I];
133 VendorID := I;
134 break;
135 end;
136 end; }
137 Result := Vendor;
138 end;
139
140 // 获取CPU厂家信息，返回值为TVendor类型
141 function GetCPUVendor: TVendor;assembler;register;
142 asm
143 PUSH EBX
144 PUSH EDI
145 MOV EDI,EAX
146 MOV EAX,0
147 DW $A20F // CPUID指令
148 MOV EAX,EBX
149 XCHG EBX,ECX
150 MOV ECX,4
151 @1:
152 STOSB
153 SHR EAX,8
154 LOOP @1
155 MOV EAX,EDX
156 MOV ECX,4
157 @2:
158 STOSB
159 SHR EAX,8
160 LOOP @2
161 MOV EAX,EBX
162 MOV ECX,4
163 @3:
164 STOSB
165 SHR EAX,8
166 LOOP @3
167 POP EDI
168 POP EBX
169 end;
170
171 function GetIdeSerialNumber: string; // 获取硬盘的出厂系列号；
172 var
173 RootPath: array [0 .. 20] of char;
174 VolName: array [0 .. 255] of char;
175 SerialNumber: DWORD;
176 MaxCLength: DWORD;
177 FileSysFlag: DWORD;
178 FileSysName: array [0 .. 255] of char;
179 begin
180 RootPath := 'C:\';
181
182 GetVolumeInformation(RootPath, VolName, 255, @SerialNumber, MaxCLength,
183 FileSysFlag, FileSysName, 255);
184 Result := Format('%s', [IntToHex(SerialNumber, 8)]);
185 end;
186
187 end.
