|
|
Регистрация | << Правила форума >> | 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
|
|||
|
|||
Я что-то не понимаю.....ты спрашивал как определить/отключить/включить устройства - и ты это получил!!!Почему не честно????Если ты сам хотел это сделать, то зачем писал на форум???
Написано это все на Delphi7...Во вложении все, что необходимо+код(который на форуме)+PrintScreen! Если что пиши! |
#8
|
|||
|
|||
Да всё ок... Просто так, ну самому хотелось всё составить... нужны были только доки.... но тебе БОЛЬШУЩЩЕЕ СПАСИБО!!!! Оч. сильно помог, особенно спасибо за SetupAPI - модуль. Нигде найти не мог! Еще раз спасибо)
|
#9
|
|||
|
|||
... встала проблема.. а как опредлить ресурсы устройства??? ни в реестре.. ни в одной из констант ресурсов не нашел... вроде бы те же функции получения подробной информации надо брать.. или я ошибаюсь? помогите плз)
|
#10
|
|||
|
|||
Цитата:
|
#11
|
|||
|
|||
Мне только сейчас начали преподавать предмет" обработка ресурсов устройств и их использование в ООП"!!! Поэтому пока не могу помочь...Что было -отдал!! По видеокартам, винтам и звуковухам где-то видел в универе на серваке! Во вторник гляну - если найду - напишу!
Последний раз редактировалось ~ SaM ~, 25.11.2007 в 18:11. |
#12
|
|||
|
|||
Мне только сейчас начали преподавать предмет "обработка ресурсов устройств и их использование в ООП"!!! Поэтому пока не могу помочь, т.к. не знаю!...Что было -отдал!! По видеокартам, винтам и звуковухам где-то видел в универе на серваке! Во вторник гляну - если найду - напишу!
|