|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Устройства в Windows
Вопрос такой: как выудить из видовса, каки устройства подключены к компьютеру? Т.е. тип процессора, имя, жесткий диск... ну в общем все устройства... Естественно, что надо будет использовать API функции... нашел всего лишь несколько, но они отдельные... хотелось бы массовое что то.... Хотел бы написать что - то типа диспетчера устройств
|
#2
|
|||
|
|||
Эх!Даю куски своей лабораторной работы со второго курса!
//Узнаем тип процессора Код:
function GetProcessorType:integer; var sysInfo:TSystemInfo; begin GetSystemInfo(sysInfo); Result:=sysInfo.dwProcessorType; end; //Чтобы узнать общий объем физической и виртуальной памяти //достаточно воспользоваться API функцией GlobalMemoryStatus. Код:
procedure TForm1.Button1Click(Sender: TObject); var MemoryStatus: TMemoryStatus; begin Memo1.Lines.Clear; MemoryStatus.dwLength := SizeOf(MemoryStatus) ; GlobalMemoryStatus(MemoryStatus) ; with MemoryStatus do begin Memo1.Lines.Add(IntToStr(dwMemoryLoad) + '% использованно памяти') ; Memo1.Lines.Add(IntToStr(dwTotalPhys) + ' Всего физической памяти (в байтах)') ; Memo1.Lines.Add(IntToStr(dwAvailPhys) + ' Доступно физической памяти (в байтах)') ; Memo1.Lines.Add(IntToStr(dwTotalPageFile) + ' Всего виртуальной памяти (в байтах)') ; Memo1.Lines.Add(IntToStr(dwAvailPageFile) + ' Доступно виртуальной памяти (в байтах) ') ; Memo1.Lines.Add(IntToStr(dwTotalVirtual) + ' Адресное виртуальное простанство текущего процесса') ; Memo1.Lines.Add(IntToStr(dwAvailVirtual) + ' Доступно байт виртуального адресного пространства текущего процесса') ; end; end; //Сетевая карта Код:
function GetNetworkConnections: String; var ByteWritten, NeedBytes: DWORD; lpConnections, lpTmpCon: PRasEntryName; dwError: DWORD; I: Integer; begin Result := ''; ByteWritten := 0; NeedBytes := SizeOf(TRasEntryName); lpConnections := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, NeedBytes); if lpConnections <> nil then try lpConnections^.dwSize := NeedBytes; dwError := RasEnumEntries(nil, nil, lpConnections, @NeedBytes, @ByteWritten); if dwError = ERROR_BUFFER_TOO_SMALL then begin lpConnections := HeapReAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, lpConnections, NeedBytes); dwError := RasEnumEntries(nil, nil, lpConnections, @NeedBytes, @ByteWritten); end; if dwError = ERROR_SUCCESS then if ByteWritten <> 0 then begin lpTmpCon := lpConnections; for I := 0 to ByteWritten - 1 do begin Result := Result + ' - ' + lpTmpCon^.szEntryName + sLineBreak; Inc(lpTmpCon); end; end; finally HeapFree(GetProcessHeap, 0, lpConnections); end; end; //Имя компа Код:
function GetComputerNetName: string; var buffer: array[0..255] of char; size: dword; begin size := 256; if GetComputerName(buffer, size) then Result := buffer else Result := '' end; |
#3
|
|||
|
|||
Спасибо.... Желательно больше функций... конкретно интересуют такие функции из модуля SetupAPI (нужны описания их, а то в справке описания кот наплакал):
Код:
function SetupDiCreateDeviceInfoList(ClassGuid:PGuid; hwndParent:cardinal):Pointer; stdcall; external 'setupapi.dll'; function SetupDiGetClassDevsExA(ClassGuid:PGuid; Enumerator:PChar; hwndParent:cardinal; Flags:DWord; DeviceInfoSet:Pointer; MachineName:PChar; Reserved:DWord):Pointer; stdcall; external 'setupapi.dll'; function SetupDiGetDeviceRegistryPropertyA(DeviceInfoSet:Pointer; DeviceInfoData:PSP_DEVINFO_DATA; Property_:DWord; PropertyRegDataType:Pointer; PropertyBuffer:Pointer; PropertyBufferSize:cardinal; RequiredSize:Pointer):longbool; stdcall; external 'setupapi.dll'; function SetupDiEnumDeviceInfo(DeviceInfoSet:Pointer; MemberIndex:DWord; var DeviceInfoData:SP_DEVINFO_DATA):longbool; stdcall; external 'setupapi.dll'; function SetupDiDestroyDeviceInfoList(DeviceInfoSet:Pointer):longbool; stdcall; external 'setupapi.dll'; Конечно можно считывать из реестра, однако там тоже по моему тёмный лес... |
#4
|
|||
|
|||
Лови!
Код:
type SP_DEVINFO_DATA=record cbSize:DWord; ClassGuid:TGuid; DevInst:DWord; Reserved:LongInt; end; PSP_DEVINFO_DATA=^SP_DEVINFO_DATA; PGuid=^TGuid; const DIGCF_ALLCLASSES=$00000004; DIGCF_PRESENT=$00000002; DIGCF_PROFILE=$00000008; DIGCF_DEVICEINTERFACE=$00000010; SPDRP_DEVICEDESC=$00000000; function SetupDiCreateDeviceInfoList(ClassGuid:PGuid; hwndParent:cardinal):Pointer; stdcall; external 'setupapi.dll'; function SetupDiGetClassDevsExA(ClassGuid:PGuid; Enumerator:PChar; hwndParent:cardinal; Flags:DWord; DeviceInfoSet:Pointer; MachineName:PChar; Reserved:DWord):Pointer; stdcall; external 'setupapi.dll'; function SetupDiGetDeviceRegistryPropertyA(DeviceInfoSet:Pointer; DeviceInfoData:PSP_DEVINFO_DATA; Property_:DWord; PropertyRegDataType:Pointer; PropertyBuffer:Pointer; PropertyBufferSize:cardinal; RequiredSize:Pointer): longbool; stdcall; external 'setupapi.dll'; function SetupDiEnumDeviceInfo(DeviceInfoSet:Pointer; MemberIndex:DWord; var DeviceInfoData:SP_DEVINFO_DATA):longbool; stdcall; external 'setupapi.dll'; function SetupDiDestroyDeviceInfoList(DeviceInfoSet:Pointer):longbool; stdcall; external 'setupapi.dll'; procedure TForm1.Button2Click(Sender: TObject); var hAllDevices, hDev:Pointer; k:Integer; Data:SP_DEVINFO_DATA; dwInfo, dwRequired, sz:DWord; buf:PChar; g:TGuid; s:string; begin hDev:=SetupDiCreateDeviceInfoList(nil, 0); k:=GetLastError; ShowMessage(IntToStr(k)); g:=StringToGuid('{4D36E96D-E325-11CE-BFC1-08002BE10318}'); hAllDevices:=SetupDiGetClassDevsExA(@g, nil, 0, DIGCF_PRESENT {or DIGCF_ALLCLASSES}, hDev, nil, 0); k:=GetLastError; ShowMessage(IntToStr(k)); FillChar(Data, SizeOf(SP_DEVINFO_DATA), 0); Data.cbSize:=SizeOf(SP_DEVINFO_DATA); dwInfo:=0; If not SetupDiEnumDeviceInfo(hAllDevices, dwInfo, Data) then ShowMessage('Error'); While SetupDiEnumDeviceInfo(hAllDevices, dwInfo, Data) do begin dwRequired:=0; If (not SetupDiGetDeviceRegistryPropertyA(hAllDevices, @Data, SPDRP_DEVICEDESC, nil, nil, 0, @dwRequired)) and (GetLastError=ERROR_INSUFFICIENT_BUFFER) then begin sz:=dwRequired; buf:=StrAlloc(100); FillChar(buf^, 100, #0); If SetupDiGetDeviceRegistryPropertyA(hAllDevices, @Data, SPDRP_DEVICEDESC, nil, @buf^, 100, @dwRequired) then begin s:=string(buf); Memo1.Lines.Add(s); end; StrDispose(buf); end; inc(dwInfo); end; SetupDiDestroyDeviceInfoList(hAllDevices); SetupDiDestroyDeviceInfoList(hDev); end; Для того, чтобы показало все устройства - поставь вместо {4D36E96D-E325-11CE-BFC1-08002BE10318} nil, т.к. этот guide для определения модемов. P.S. Автор не я. |
#5
|
|||
|
|||
Пробовал этот код для определения ИК портов, Блютузов - работает, но тебе надо будет залезть в МСДН и посмотреть необходимые guidы
|
#6
|
|||
|
|||
Цитата:
И еще вопросик.. Как программно отключить\ включить\ удалить девайс... Как и в диспетчере оборудования =)) что то по докам полазил.. там только извлечение USB флехи... однако хотелось бы для всех устройств) |
#7
|
|||
|
|||
//Часть первая(просто весь код не влазит в одно сообщение)
Код:
uses ......, ComCtrls, StdCtrls, SetupAPI, ExtCtrls, Menus; const SetupApiModuleName = 'cfgmgr32.dll'; REGSTR_VAL_NODISPLAYCLASS = 'NoDisplayClass'; CR_SUCCESS = $00000000; DN_HAS_PROBLEM = $00000400; DN_DISABLEABLE = $00002000; DN_NO_SHOW_IN_DM = $40000000; CM_PROB_DISABLED = $00000016; CM_PROB_HARDWARE_DISABLED = $0000001D; function CM_Get_DevNode_Status(pulStatus: PULong; pulProblemNumber: PULong; dnDevInst: DWord; ulFlags: ULong): DWord; stdcall; external SetupApiModuleName name 'CM_Get_DevNode_Status'; type TForm1 = class(TForm) TreeView: TTreeView; ImageList: TImageList; MainMenu: TMainMenu; mFile: TMenuItem; mExit: TMenuItem; mChange: TMenuItem; mEnableDevice: TMenuItem; mDisableDevice: TMenuItem; mOptions: TMenuItem; mRefreshDisplay: TMenuItem; mShowHiddenDevices: TMenuItem; mN: TMenuItem; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure mExitClick(Sender: TObject); procedure mRefreshDisplayClick(Sender: TObject); procedure mShowHiddenDevicesClick(Sender: TObject); procedure TreeViewChange(Sender: TObject; Node: TTreeNode); procedure TreeViewDblClick(Sender: TObject); procedure ChangeEnableDevice(Sender: TObject); procedure ChangeDisableDevice(Sender: TObject); private { Private declarations } DevInfo: hDevInfo; ClassImageListData: TSPClassImageListData; ShowHidden: Boolean; function IsDisableable(SelectedItem: DWord; hDevInfo: hDevInfo): Boolean; function IsDisabled(SelectedItem: DWord; hDevInfo: hDevInfo): Boolean; function StateChange(NewState: DWord; SelectedItem: DWord; hDevInfo: hDevInfo): Boolean; function GetRegistryProperty(PnPHandle: HDEVINFO;DevData: TSPDevInfoData; Prop: DWORD; Buffer: PChar; dwLength: DWord): Boolean; function ConstructDeviceName(DeviceInfoSet: hDevInfo; DeviceInfoData: TSPDevInfoData; Buffer: PChar; dwLength: DWord): Boolean; function IsClassHidden(ClassGuid: TGuid): Boolean; function EnumAddDevices(ShowHidden: Boolean; hwndTree: TTreeView; DevInfo: hDevInfo): Boolean; function GetClassImageIndex(ClassGuid: TGuid; Index: PInt): Boolean; public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} function TForm1.IsDisableable(SelectedItem: DWord; hDevInfo: hDevInfo): Boolean; var DeviceInfoData: TSPDevInfoData; Status, Problem: DWord; begin DeviceInfoData.cbSize := SizeOf(TSPDevInfoData); if (not SetupDiEnumDeviceInfo(hDevInfo, SelectedItem, DeviceInfoData)) then begin Result := false; exit; end; if (CM_Get_DevNode_Status(@Status, @Problem, DeviceInfoData.DevInst, 0) <> CR_SUCCESS) then begin Result := false; exit; end; Result := ((Status and DN_DISABLEABLE = DN_DISABLEABLE) and not (CM_PROB_HARDWARE_DISABLED = Problem)); end; function TForm1.IsDisabled(SelectedItem: DWord; hDevInfo: hDevInfo): Boolean; var DeviceInfoData: TSPDevInfoData; Status, Problem: DWord; begin DeviceInfoData.cbSize := SizeOf(TSPDevInfoData); if (not SetupDiEnumDeviceInfo(hDevInfo, SelectedItem, DeviceInfoData)) then begin Result := false; exit; end; if (CM_Get_DevNode_Status(@Status, @Problem, DeviceInfoData.DevInst, 0) <> CR_SUCCESS) then begin Result := false; exit; end; Result := ((Status and DN_HAS_PROBLEM = DN_HAS_PROBLEM) and (CM_PROB_DISABLED = Problem)); end; function TForm1.StateChange(NewState: DWord; SelectedItem: DWord; hDevInfo: hDevInfo): Boolean; var PropChangeParams: TSPPropChangeParams; DeviceInfoData: TSPDevInfoData; begin PropChangeParams.ClassInstallHeader.cbSize := SizeOf(TSPClassInstallHeader); DeviceInfoData.cbSize := SizeOf(TSPDevInfoData); if (not SetupDiEnumDeviceInfo(hDevInfo, SelectedItem, DeviceInfoData)) then begin Result := false; ShowMessage('EnumDeviceInfo'); exit; end; PropChangeParams.ClassInstallHeader.InstallFunction := DIF_PROPERTYCHANGE; PropChangeParams.Scope := DICS_FLAG_GLOBAL; PropChangeParams.StateChange := NewState; if (not SetupDiSetClassInstallParams(hDevInfo, @DeviceInfoData, PSPClassInstallHeader(@PropChangeParams), SizeOf(PropChangeParams))) then begin Result := false; ShowMessage('SetClassInstallParams'); exit; end; if (not SetupDiCallClassInstaller(DIF_PROPERTYCHANGE, hDevInfo, @DeviceInfoData)) then begin Result := false; ShowMessage('SetClassInstallParams'); exit; end; Result := true; end; function TForm1.GetClassImageIndex(ClassGuid: TGuid; Index: PInt): Boolean; begin Result := SetupDiGetClassImageIndex(ClassImageListData, ClassGuid, Index^); end; function TForm1.GetRegistryProperty(PnPHandle: hDevInfo; DevData: TSPDevInfoData; Prop: DWord; Buffer: PChar; dwLength: DWord): Boolean; var aBuffer: array[0..256] of Char; begin dwLength := 0; aBuffer[0] := #0; SetupDiGetDeviceRegistryProperty(PnPHandle, DevData, Prop, Prop, PBYTE(@aBuffer[0]), SizeOf(aBuffer), dwLength); StrCopy(Buffer, aBuffer); Result := Buffer^ <> #0; end; function TForm1.ConstructDeviceName(DeviceInfoSet: hDevInfo; DeviceInfoData: TSPDevInfoData; Buffer: PChar; dwLength: DWord): Boolean; const UnknownDevice = '<Unknown Device>'; begin if (not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_FRIENDLYNAME, Buffer, dwLength)) then begin if (not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_DEVICEDESC, Buffer, dwLength)) then begin if (not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_CLASS, Buffer, dwLength)) then begin if (not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_CLASSGUID, Buffer, dwLength)) then begin dwLength := DWord(SizeOf(UnknownDevice)); Buffer := Pointer(LocalAlloc(LPTR, Cardinal(dwLength))); StrCopy(Buffer, UnknownDevice); end; end; end; end; Result := true; end; function TForm1.IsClassHidden(ClassGuid: TGuid): Boolean; var bHidden: Boolean; hKeyClass: HKey; begin bHidden := false; hKeyClass := SetupDiOpenClassRegKey(@ClassGuid, KEY_READ); if (hKeyClass <> 0) then begin bHidden := (RegQueryValueEx(hKeyClass, REGSTR_VAL_NODISPLAYCLASS, nil, nil, nil, nil) = ERROR_SUCCESS); RegCloseKey(hKeyClass); end; Result := bHidden; end; function TForm1.EnumAddDevices(ShowHidden: Boolean; hwndTree: TTreeView; DevInfo: hDevInfo): Boolean; var i, Status, Problem: DWord; pszText: PChar; DeviceInfoData: TSPDevInfoData; iImage: Integer; begin TTreeView(hWndTree).Items.BeginUpdate; DeviceInfoData.cbSize := SizeOf(TSPDevInfoData); TTreeView(hWndTree).Items.Clear; i := 0; while SetupDiEnumDeviceInfo(DevInfo, i, DeviceInfoData) do begin inc(i); if (CM_Get_DevNode_Status(@Status, @Problem, DeviceInfoData.DevInst, 0) <> CR_SUCCESS) then begin ShowMessage('CM_Get_DevNode_Status :: uenable.pas'); break; end; if (not (ShowHidden or not(Boolean(Status and DN_NO_SHOW_IN_DM) or IsClassHidden(DeviceInfoData.ClassGuid)))) then begin break; end; GetMem(pszText, 256); try ConstructDeviceName(DevInfo, DeviceInfoData, pszText, DWord(nil)); if (GetClassImageIndex(DeviceInfoData.ClassGuid, @iImage)) then begin with TTreeView(hWndTree).Items.AddObject(nil, pszText, nil) do begin TTreeView(hWndTree).Items[i-1].ImageIndex := iImage; TTreeView(hWndTree).Items[i-1].SelectedIndex := iImage; end; if (Problem = CM_PROB_DISABLED) then // Красный (X) begin TTreeView(hWndTree).Items[i-1].OverlayIndex := IDI_DISABLED_OVL - IDI_CLASSICON_OVERLAYFIRST; end else begin if (Boolean(Problem)) then // Желтый (!) begin TTreeView(hWndTree).Items[i-1].OverlayIndex := IDI_PROBLEM_OVL - IDI_CLASSICON_OVERLAYFIRST; end; end; if (Status and DN_NO_SHOW_IN_DM = DN_NO_SHOW_IN_DM) then begin TTreeView(hWndTree).Items[i-1].Cut := true; end; end; finally FreeMem(pszText); end; end; TTreeView(hWndTree).Items.EndUpdate; Result := true; end; |
#8
|
|||
|
|||
//И вторая(продолжение)
Код:
procedure TForm1.FormCreate(Sender: TObject); begin if (not LoadSetupAPI) then begin ShowMessage('Could not load SetupAPI.dll'); exit; end; DevInfo := nil; ShowHidden := false; DevInfo := SetupDiGetClassDevs(nil, nil, 0, DIGCF_PRESENT or DIGCF_ALLCLASSES); if (DevInfo = Pointer(INVALID_HANDLE_VALUE)) then begin ShowMessage('GetClassDevs'); exit; end; ClassImageListData.cbSize := SizeOf(TSPClassImageListData); if (not SetupDiGetClassImageList(ClassImageListData)) then begin ShowMessage('GetClassImageList'); exit; end; ImageList.Handle := ClassImageListData.ImageList; TreeView.Images := ImageList; EnumAddDevices(ShowHidden, TreeView, DevInfo); end; procedure TForm1.FormDestroy(Sender: TObject); begin SetupDiDestroyDeviceInfoList(DevInfo); SetupDiDestroyClassImageList(ClassImageListData); UnloadSetupApi; end; procedure TForm1.mExitClick(Sender: TObject); begin Close; end; procedure TForm1.mRefreshDisplayClick(Sender: TObject); begin EnumAddDevices(ShowHidden, TreeView, DevInfo); end; procedure TForm1.mShowHiddenDevicesClick(Sender: TObject); begin ShowHidden := not ShowHidden; MainMenu.Items[2][2].Checked := ShowHidden; EnumAddDevices(ShowHidden, TreeView, DevInfo); end; procedure TForm1.TreeViewChange(Sender: TObject; Node: TTreeNode); begin with MainMenu, TreeView.Selected do begin Items[1][0].enabled := false; Items[1][1].enabled := false; if (IsDisabled(Index, DevInfo)) then begin Items[1][0].enabled := true end else begin if (IsDisableable(Index, DevInfo)) then Items[1][1].enabled := true end; end; end; procedure TForm1.TreeViewDblClick(Sender: TObject); begin with TreeView.Selected do begin if (IsDisabled(Index, DevInfo)) then begin ChangeEnableDevice(Self);; end else begin if (IsDisableable(Index, DevInfo)) then ChangeDisableDevice(Self); end; end; end; procedure TForm1.ChangeEnableDevice(Sender: TObject); begin if (MessageBox(Handle, 'Включить устройство?', 'Change Device Status', MB_OKCANCEL) = IDOK) then begin if (StateChange(DICS_ENABLE, TreeView.Selected.Index, DevInfo)) then EnumAddDevices(ShowHidden, TreeView, DevInfo); end; end; procedure TForm1.ChangeDisableDevice(Sender: TObject); begin if (MessageBox(Handle, 'Отрубить устройство?', 'Change Device Status', MB_OKCANCEL) = IDOK) then begin if (StateChange(DICS_DISABLE, TreeView.Selected.Index, DevInfo)) then EnumAddDevices(ShowHidden, TreeView, DevInfo); end; end; |
#9
|
|||
|
|||
Спс... Это что, код готовый??))) ну если да, то так нечестно, но спасибо... кста.. я не могу в делфи 2006 подключить setupapi.... jedi ставил.. толку нет... где его взять, этот setupapi????
|
#10
|
|||
|
|||
Я что-то не понимаю.....ты спрашивал как определить/отключить/включить устройства - и ты это получил!!!Почему не честно????Если ты сам хотел это сделать, то зачем писал на форум???
Написано это все на Delphi7...Во вложении все, что необходимо+код(который на форуме)+PrintScreen! Если что пиши! |
#11
|
|||
|
|||
Да всё ок... Просто так, ну самому хотелось всё составить... нужны были только доки.... но тебе БОЛЬШУЩЩЕЕ СПАСИБО!!!! Оч. сильно помог, особенно спасибо за SetupAPI - модуль. Нигде найти не мог! Еще раз спасибо)
|
#12
|
|||
|
|||
... встала проблема.. а как опредлить ресурсы устройства??? ни в реестре.. ни в одной из констант ресурсов не нашел... вроде бы те же функции получения подробной информации надо брать.. или я ошибаюсь? помогите плз)
|
#13
|
|||
|
|||
Цитата:
|
#14
|
|||
|
|||
Мне только сейчас начали преподавать предмет" обработка ресурсов устройств и их использование в ООП"!!! Поэтому пока не могу помочь...Что было -отдал!! По видеокартам, винтам и звуковухам где-то видел в универе на серваке! Во вторник гляну - если найду - напишу!
Последний раз редактировалось ~ SaM ~, 25.11.2007 в 18:11. |
#15
|
|||
|
|||
Мне только сейчас начали преподавать предмет "обработка ресурсов устройств и их использование в ООП"!!! Поэтому пока не могу помочь, т.к. не знаю!...Что было -отдал!! По видеокартам, винтам и звуковухам где-то видел в универе на серваке! Во вторник гляну - если найду - напишу!
|