getpcinfo.~pas

用于计算机中心的PC机管理,通过WMI获取本单位PC的名称,IP地址,网卡地址,硬盘序列号,CPU序列号,硬盘大小,内存大小等信息.然后转换成EXCEL表格发送到管理员的EMAIL中.

unit getpcinfo;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,Registry,ComObj,nb30,IdWinsock, IdBaseComponent,
  IdComponent, IdIPWatch, IdDateTimeStamp, Psock, NMsmtp, ExtCtrls,Types,
  DB, WmiDataSet, WmiConnection, Mask;

type

  PASTAT = ^TASTAT;
  TASTAT = record
  adapter : TAdapterStatus;
  name_buf : TNameBuffer;
  end;

  ComputerInfo = record
      cpudescription:string;
      cpuCurrentClockSpeed:string;
      cpuDataWidth:string;
      cpuManufacturer:string;
      cpuProcessorId:string;
      MACAddress:string;
      NetDiscrip:string;
      IPAddress:string;
      WINSPrimaryServer:string;
      WINSSecondaryServer:string;
      DNSServerSearchOrder:string;
      DefaultIPGateway:string;
      DiskType:string;
      DiskID:string;
      DiskSize:string;
      MemSize:string;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    infolist: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Button2: TButton;
    SMTP1: TNMSMTP;
    Panel1: TPanel;
    WmiConnection1: TWmiConnection;
    WmiQuery1: TWmiQuery;
    Label3: TLabel;
    Label4: TLabel;
    Edit1: TEdit;
    MaskEdit1: TMaskEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
     procedure huoquMem;
     procedure GetDiskSize;
     procedure GetNetWork;
     procedure GetCpuinfo;
    { Public declarations }
  end;

var
  Form1: TForm1;
  s_cpuid,localdir:string;
  s_pcyjid,s_ossn:string;
  s_cputype,s_ipaddress,riqi:string;
  s_macaddress,s_macaddress1:string;
  s_hdid,s_hdid1,s_hdid2,pc_name,s_miaoshu:string;
  s_hdsize:array[0..3] of string;
  s_memsize:array[0..3] of string;
  s_hdSN,s_domain,s_nameserver:string;
  s_pcInfo:array[0..8] of ComputerInfo;
var
 CXlsBof: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
 CXlsEof: array[0..1] of Word = ($0A, 00);
 CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
 CXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
 CXlsRk: array[0..4] of Word = ($27E, 10, 0, 0, 0);
 CXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);

Type
 TDS2Excel = Class(TObject)
 Private
   FCol: word;
   FRow: word;
   Stream: TStream;
   FWillWriteHead: boolean;

   procedure IncColRow;
   procedure WriteBlankCell;
   procedure WriteFloatCell(const AValue: Double);
   procedure WriteIntegerCell(const AValue: Integer);
   procedure WriteStringCell(const AValue: string);
   procedure WritePrefix;
   procedure WriteSuffix;
   procedure WriteTitle;
   procedure WriteDataCell;
   procedure Save2Stream(aStream: TStream);
 Public
   procedure Save2File(WillWriteHead: Boolean);
   Constructor Create;
 end;
implementation

{$R *.dfm}
type
  TCPUID = array[1..16] of BYTE;

Constructor TDS2Excel.Create;
begin
 inherited Create;
end;

procedure TDS2Excel.IncColRow;
begin
 if FCol = 22 then
 begin
   Inc(FRow);
   FCol :=0;
 end
 else
   Inc(FCol);
end;

procedure TDS2Excel.WriteBlankCell;
begin
 CXlsBlank[2] := FRow;
 CXlsBlank[3] := FCol;
 Stream.WriteBuffer(CXlsBlank, SizeOf(CXlsBlank));
 IncColRow;
end;

procedure TDS2Excel.WriteFloatCell(const AValue: Double);
begin
 CXlsNumber[2] := FRow;
 CXlsNumber[3] := FCol;
 Stream.WriteBuffer(CXlsNumber, SizeOf(CXlsNumber));
 Stream.WriteBuffer(AValue, 8);
 IncColRow;
end;

procedure TDS2Excel.WriteIntegerCell(const AValue: Integer);
var
 V: Integer;
begin
 CXlsRk[2] := FRow;
 CXlsRk[3] := FCol;
 Stream.WriteBuffer(CXlsRk, SizeOf(CXlsRk));
 V := (AValue shl 2) or 2;
 Stream.WriteBuffer(V, 4);
 IncColRow;
end;

procedure TDS2Excel.WriteStringCell(const AValue: string);
var
 L: Word;
begin
 L := Length(AValue);
 CXlsLabel[1] := 8 + L;
 CXlsLabel[2] := FRow;
 CXlsLabel[3] := FCol;
 CXlsLabel[5] := L;
 Stream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
 Stream.WriteBuffer(Pointer(AValue)^, L);
 IncColRow;
end;

procedure TDS2Excel.WritePrefix;
begin
 Stream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
end;

procedure TDS2Excel.WriteSuffix;
begin
 Stream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
end;

procedure TDS2Excel.WriteTitle;
var
 n: word;
begin
// for n := 0 to FDataSet.FieldCount - 1 do

  WriteStringCell('计算机名称');
  WriteStringCell('计算机域名');
  WriteStringCell('计算机工作组');
  WriteStringCell('计算机描述');
  WriteStringCell('采集日期');
  WriteStringCell('CPU描述');
  WriteStringCell('CPU时钟速度');
  WriteStringCell('CPU数据宽度');
  WriteStringCell('CPU厂家');
  WriteStringCell('CPU序列号');
  WriteStringCell('网卡地址');
  WriteStringCell('网卡描述');
  WriteStringCell('IP地址');
  WriteStringCell('WINS主服务器');
  WriteStringCell('WINS第二服务器');
  WriteStringCell('DNS服务器查找顺序');
  WriteStringCell('默认网关');
  WriteStringCell('硬盘类型');
  WriteStringCell('硬盘序列号');
  WriteStringCell('硬盘大小');
  WriteStringCell('内存大小');
  WriteStringCell('微机序列号');
  WriteStringCell('操作系统注册号');
end;

procedure TDS2Excel.WriteDataCell;
var
 n: word;
 i:integer;
begin
 WritePrefix;
 if FWillWriteHead then WriteTitle;
  WriteStringCell(pc_name);
  WriteStringCell(s_nameserver);
  WriteStringCell(s_domain);
  WriteStringCell(s_miaoshu);
  WriteStringCell(riqi);
  FCol:=21;
  WriteStringCell(s_pcyjid);
  WriteStringCell(s_ossn);

  for i:=0 to 8 do
  begin
      FRow:=1+i;
      FCol:=5;
      WriteStringCell(s_pcinfo[i].cpudescription);
      FCol:=6;
      WriteStringCell(s_pcinfo[i].cpuCurrentClockSpeed );
      FCol:=7;
      WriteStringCell(s_pcinfo[i].cpuDataWidth );
      FCol:=8;
      WriteStringCell(s_pcinfo[i].cpuManufacturer);
      FCol:=9;
      WriteStringCell(s_pcinfo[i].cpuProcessorId);
      FCol:=10;
      WriteStringCell(s_pcinfo[i].MACAddress);
      FCol:=11;
      WriteStringCell(s_pcinfo[i].NetDiscrip );
      FCol:=12;
      WriteStringCell(s_pcinfo[i].IPAddress );
      FCol:=13;
      WriteStringCell(s_pcinfo[i].WINSPrimaryServer );
      FCol:=14;
      WriteStringCell(s_pcinfo[i].WINSSecondaryServer );
      FCol:=15;
      WriteStringCell(s_pcinfo[i].DNSServerSearchOrder );
      FCol:=16;
      WriteStringCell(s_pcinfo[i].DefaultIPGateway );
      FCol:=17;
      WriteStringCell(s_pcinfo[i].DiskType );
      FCol:=18;
      WriteStringCell(s_pcinfo[i].DiskID );
      FCol:=19;
      WriteStringCell(s_pcinfo[i].DiskSize);
      FCol:=20;
      WriteStringCell(s_pcinfo[i].MemSize );
  end;

 WriteSuffix;
end;

procedure TDS2Excel.Save2Stream(aStream: TStream);
begin
 FCol := 0;
 FRow := 0;
 Stream := aStream;
 WriteDataCell;
end;


procedure TDS2Excel.Save2File(WillWriteHead: Boolean);
var
 SaveDialog1: TSaveDialog;
 aFileStream:TFileStream;

begin
 FWillWriteHead := WillWriteHead;
{ SaveDialog1 := TSaveDialog.Create(nil);
 Try
   SaveDialog1.Filter := 'Excel文档|*.xls';
   SaveDialog1.InitialDir := 'c:\';
   SaveDialog1.FileName :=pc_name;
   if not SaveDialog1.Execute then exit;
   if FileExists(SaveDialog1.FileName+'.xls') then DeleteFile(SaveDialog1.FileName+'.xls');
   aFileStream := TFileStream.Create(SaveDialog1.FileName+'.xls', fmCreate);
   Try
       Save2Stream(aFileStream);
   Finally
       aFileStream.Free;
   end;
 Finally
   SaveDialog1.Free;
 end;}
   if FileExists(localdir+trim(pc_name)+'.xls') then DeleteFile(localdir+trim(pc_name)+'.xls');
   aFileStream := TFileStream.Create(localdir+trim(pc_name)+'.xls', fmCreate);
   Try
       Save2Stream(aFileStream);
   Finally
       aFileStream.Free;
   end;
end;

procedure getnames;
var
  size:cardinal;
  name:Pchar;
begin
  size :=255;
  getmem(name,size);
  getcomputername(name,size);
  pc_name:=strPas(name);
end;
//==============================================
function GetWinVersion :integer;
var
  version:TOSVersionInfo;
begin
  result:=-1;
  Version.dwOSVersionInfoSize :=sizeof(TOSVersionInfo);
  Getversionex(version);
  case Version.dwPlatformId  of
  VER_PLATFORM_WIN32_NT:
  begin
    result:=0;
  end;