untmain.pas

通过Delphi编程

unit untMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SetupAPI, ComCtrls, ImgList, ExtCtrls;

type
  TForm1 = class(TForm)
    btn1: TButton;
    lv1: TListView;
    il1: TImageList;
    btnAbout: TButton;
    Panel1: TPanel;
    procedure btn1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnAboutClick(Sender: TObject);
  private
    function DeviceClassName(Guid: TGUID): string;
    function DeviceFirendName(DeviceInfoSet: Cardinal;
      DeviceInfoData: PSP_DEVINFO_DATA; var Name: string): Boolean;

    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ImageList: SP_CLASSIMAGELIST_DATA;
  
implementation

{$R *.dfm}

procedure TForm1.btn1Click(Sender: TObject);
var
  hDevInfo: Cardinal;
  DeviceInfoData: SP_DEVINFO_DATA;
  DriverInfoData: SP_DRVINFO_DATA;
  i : DWORD;
  Name: string;
  list: TListItem;
  ImageIndex: Integer;
begin
  lv1.Clear;
  ImageList.cbSize := SizeOf(SP_CLASSIMAGELIST_DATA);
  DriverInfoData.cbSize := SizeOf(SP_DRVINFO_DATA);
  SetupDiGetClassImageList(@ImageList);
  il1.Handle := ImageList.ImageList;
  lv1.SmallImages := il1;
  hDevInfo := SetupDiGetClassDevs(nil,
    0, 0, DIGCF_PRESENT or DIGCF_ALLCLASSES);
  if (hDevInfo = INVALID_HANDLE_VALUE) then Exit;
  DeviceInfoData.cbSize := SizeOf(SP_DEVINFO_DATA);
  i := 0;
  while SetupDiEnumDeviceInfo(hDevInfo, i, @DeviceInfoData) do
  begin
    DeviceFirendName(hDevInfo, @DeviceInfoData, Name);

    SetupDiGetClassImageIndex(@ImageList, @DeviceInfoData.ClassGuid,
      @ImageIndex);

    list := lv1.Items.Add;
    list.ImageIndex := ImageIndex;
    list.Caption := GUIDToString(DeviceInfoData.ClassGuid);
    list.SubItems.Add(DeviceClassName(DeviceInfoData.ClassGuid));
    list.SubItems.Add(Name);

    Inc(i);

  end;
  SetupDiDestroyDeviceInfoList(hDevInfo);
end;

function TForm1.DeviceClassName(Guid: TGUID): string;
var
  ClassName: PChar;
  ClassNameSzie: Cardinal;
begin
  ClassNameSzie := 0;
  GetMem(ClassName, ClassNameSzie);
  while not SetupDiClassNameFromGuid(@Guid, ClassName,
    ClassNameSzie, @ClassNameSzie) do
  begin
    if (GetLastError() = ERROR_INSUFFICIENT_BUFFER) then
    begin
      if ClassName <> nil then FreeMem(ClassName);
      GetMem(ClassName, ClassNameSzie);
    end else
      Break;
  end;
  Result := StrPas(ClassName);
  if ClassName <> nil then FreeMem(ClassName);
end;

function TForm1.DeviceFirendName(DeviceInfoSet: Cardinal;
  DeviceInfoData: PSP_DEVINFO_DATA; var Name: string): Boolean;
var
  DataT, buffersize: DWORD;
  buffer: PChar;
begin
  buffersize := 256;
  buffer := AllocMem(buffersize);
  Result := False;
  if not SetupDiGetDeviceRegistryProperty(DeviceInfoSet, DeviceInfoData,
    SPDRP_FRIENDLYNAME, @DataT, PByte(buffer), buffersize, @buffersize) then
  begin
    Result := SetupDiGetDeviceRegistryProperty(DeviceInfoSet, DeviceInfoData,
      SPDRP_DEVICEDESC, @DataT, PByte(buffer), buffersize, @buffersize)
  end
  else
    Result := True;
  if Result then
    Name := StrPas(buffer)
  else
    Name := 'Unknow';
  FreeMem(buffer);
end;  

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SetupDiDestroyClassImageList(@ImageList);
end;

procedure TForm1.btnAboutClick(Sender: TObject);
const
  About = '关于';
  Creator = 'Moufersoft Studio (Moufer) ';
  Daytime = '2006-1-27 0:13:03';
  Mail = '[e-mail]';
  Bolg = 'http://bolg.moufersoft.com/';
  Newline = #13 + #10;
begin
  MessageBox(Handle,
    Creator + Newline +
    Daytime + Newline +
    Mail + Newline +
    Bolg ,
    About,
    MB_ICONINFORMATION);
end;

end.