[CTuKC]

Вопрос такой: как выудить из видовса, каки устройства подключены к компьютеру? Т.е. тип процессора, имя, жесткий диск... ну в общем все устройства... Естественно, что надо будет использовать API функции... нашел всего лишь несколько, но они отдельные... хотелось бы массовое что то.... Хотел бы написать что - то типа диспетчера устройств

[~ SaM ~]

Эх!Даю куски своей лабораторной работы со второго курса!

//Узнаем тип процессора

Код:

1 2 3 4 5

function GetProcessorType:integer; var sysInfo:TSystemInfo; begin GetSystemInfo(sysInfo); Result:=sysInfo.dwProcessorType; end;

//Чтобы узнать общий объем физической и виртуальной памяти
//достаточно воспользоваться API функцией GlobalMemoryStatus.

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25

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;

//Сетевая карта

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35

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;

//Имя компа

Код:

1 2 3 4 5 6 7

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;

[CTuKC]

Спасибо.... Желательно больше функций... конкретно интересуют такие функции из модуля SetupAPI (нужны описания их, а то в справке описания кот наплакал):

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13

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';

Любая информация по ним будет драгоценной... По моему, эти функции выдают больше информации...
Конечно можно считывать из реестра, однако там тоже по моему тёмный лес...

[~ SaM ~]

Лови!

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84

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. Автор не я.

[~ SaM ~]

Пробовал этот код для определения ИК портов, Блютузов - работает, но тебе надо будет залезть в МСДН и посмотреть необходимые guidы

[CTuKC]

Сообщение от ~ SaM ~

Пробовал этот код для определения ИК портов, Блютузов - работает, но тебе надо будет залезть в МСДН и посмотреть необходимые guidы

Нашел GUIDы..... Все вроде работает... однако надо разобраться с устрйоствами.. выдает то что не надо в принципе....

И еще вопросик.. Как программно отключить\ включить\ удалить девайс... Как и в диспетчере оборудования =)) что то по докам полазил.. там только извлечение USB флехи... однако хотелось бы для всех устройств)

[~ SaM ~]

Я что-то не понимаю.....ты спрашивал как определить/отключить/включить устройства - и ты это получил!!!Почему не честно????Если ты сам хотел это сделать, то зачем писал на форум???

Написано это все на Delphi7...Во вложении все, что необходимо+код(который на форуме)+PrintScreen! Если что пиши!

[CTuKC]

Да всё ок... Просто так, ну самому хотелось всё составить... нужны были только доки.... но тебе БОЛЬШУЩЩЕЕ СПАСИБО!!!! Оч. сильно помог, особенно спасибо за SetupAPI - модуль. Нигде найти не мог! Еще раз спасибо)

[CTuKC]

... встала проблема.. а как опредлить ресурсы устройства??? ни в реестре.. ни в одной из констант ресурсов не нашел... вроде бы те же функции получения подробной информации надо брать.. или я ошибаюсь? помогите плз)

[CTuKC]

Сообщение от CTuKC

... встала проблема.. а как опредлить ресурсы устройства??? ни в реестре.. ни в одной из констант ресурсов не нашел... вроде бы те же функции получения подробной информации надо брать.. или я ошибаюсь? помогите плз)

Ну хоть подскажите, какие функции об ресурсах устройств вернут инфу.. пусть даже из ХИД классов!!! прерывание, память... ну по типу диспетчера устройств)))

[~ SaM ~]

Мне только сейчас начали преподавать предмет" обработка ресурсов устройств и их использование в ООП"!!! Поэтому пока не могу помочь...Что было -отдал!! По видеокартам, винтам и звуковухам где-то видел в универе на серваке! Во вторник гляну - если найду - напишу!

[~ SaM ~]

Мне только сейчас начали преподавать предмет "обработка ресурсов устройств и их использование в ООП"!!! Поэтому пока не могу помочь, т.к. не знаю!...Что было -отдал!! По видеокартам, винтам и звуковухам где-то видел в универе на серваке! Во вторник гляну - если найду - напишу!