Como posso lista o Componetes de um pc?

Rotina que lista as placas de redes, seus IP, Gateway e Subnet Masks.


unit USock;

interface

uses Windows, Winsock;

{

This function enumerates all TCP/IP interfaces and
returns a CRLF separated string containing:

IP, NetMask, BroadCast-Address, Up/Down status,
Broadcast support, Loopback

If you feed this string to a wide TMEMO (to its memo.lines.text
property) you will see cleary the results.

To use this you need Win98/ME/2K, 95 OSR 2 or NT service
pack #3 because WinSock 2 is used (WS2_32.DLL)

}

function EnumInterfaces(var sInt: string): Boolean;

{ Imported function WSAIOCtl from Winsock 2.0 - Winsock 2 is }
{ available only in Win98/ME/2K and 95 OSR2, NT srv pack 3 }

function WSAIoctl(s: TSocket; cmd: DWORD; lpInBuffer: PCHAR; dwInBufferLen:
DWORD;
lpOutBuffer: PCHAR; dwOutBufferLen: DWORD;
lpdwOutBytesReturned: LPDWORD;
lpOverLapped: POINTER;
lpOverLappedRoutine: POINTER): Integer; stdcall; external ´WS2_32.DLL´;

{ Constants taken from C header files }

const SIO_GET_INTERFACE_LIST = $4004747F;
IFF_UP = $00000001;
IFF_BROADCAST = $00000002;
IFF_LOOPBACK = $00000004;
IFF_POINTTOPOINT = $00000008;
IFF_MULTICAST = $00000010;

type sockaddr_gen = packed record
AddressIn: sockaddr_in;
filler: packed array[0..7] of char;
end;

type INTERFACE_INFO = packed record
iiFlags: u_long; // Interface flags
iiAddress: sockaddr_gen; // Interface address
iiBroadcastAddress: sockaddr_gen; // Broadcast address
iiNetmask: sockaddr_gen; // Network mask
end;

implementation

{-------------------------------------------------------------------

1. Open WINSOCK
2. Create a socket
3. Call WSAIOCtl to obtain network interfaces
4. For every interface, get IP, MASK, BROADCAST, status
5. Fill a CRLF separated string with this info
6. Finito

--------------------------------------------------------------------}

function EnumInterfaces(var sInt: string): Boolean;
var s: TSocket;
wsaD: WSADATA;
NumInterfaces: Integer;
BytesReturned, SetFlags: u_long;
pAddrInet: SOCKADDR_IN;
pAddrString: PCHAR;
PtrA: pointer;
Buffer: array[0..20] of INTERFACE_INFO;
i: Integer;
begin
result := true; // Initialize
sInt := ´´;

WSAStartup($0101, wsaD); // Start WinSock
// You should normally check
// for errors here :)

s := Socket(AF_INET, SOCK_STREAM, 0); // Open a socket
if (s = INVALID_SOCKET) then exit;

try // Call WSAIoCtl
PtrA := @bytesReturned;
if (WSAIoCtl(s, SIO_GET_INTERFACE_LIST, nil, 0, @Buffer, 1024, PtrA, nil,
nil)
<> SOCKET_ERROR)
then
begin // If ok, find out how
// many interfaces exist

NumInterfaces := BytesReturned div SizeOf(INTERFACE_INFO);

for i := 0 to NumInterfaces - 1 do // For every interface
begin
pAddrInet := Buffer[i].iiAddress.addressIn; // IP ADDRESS
pAddrString := inet_ntoa(pAddrInet.sin_addr);
sInt := sInt + ´ IP=´ + pAddrString + ´,´;
pAddrInet := Buffer[i].iiNetMask.addressIn; // SUBNET MASK
pAddrString := inet_ntoa(pAddrInet.sin_addr);
sInt := sInt + ´ Mask=´ + pAddrString + ´,´;
pAddrInet := Buffer[i].iiBroadCastAddress.addressIn; // Broadcast addr
pAddrString := inet_ntoa(pAddrInet.sin_addr);
sInt := sInt + ´ Broadcast=´ + pAddrString + ´,´;

SetFlags := Buffer[i].iiFlags;
if (SetFlags and IFF_UP) = IFF_UP then
sInt := sInt + ´ Interface UP,´ // Interface up/down
else
sInt := sInt + ´ Interface DOWN,´;

if (SetFlags and IFF_BROADCAST) = IFF_BROADCAST then // Broadcasts
sInt := sInt + ´ Broadcasts supported,´ // supported or
else // not supported
sInt := sInt + ´ Broadcasts NOT supported,´;

if (SetFlags and IFF_LOOPBACK) = IFF_LOOPBACK then // Loopback or
sInt := sInt + ´ Loopback interface´
else
sInt := sInt + ´ Network interface´; // normal

sInt := sInt + #1310; // CRLF between
// each interface
end;
end;
except
end;
//
// Close sockets
//
CloseSocket(s);
WSACleanUp;
result := false;
end;

end.


Exemplo de uso:

procedure TForm1.Button1Click(Sender: TObject);
Var s : String;
begin
EnumInterfaces(s);
Memo1.Lines.Text := s;
end;

Ass: Max..

Desculpe mas se vc tiver como me mandar um codigo fonte que possa listar todos os componentes e os seus respectivos numeros de serie eu vou ficar muito grato!
Valeu!
ASS:
JJ_MALKA

Neste SITE que eu adquiri esse código não utilizei ainda mas achei interesante, agora é com você.

http://lib.seven.com.br/menu.asp?codcat=1

Vá neste Site e se comunique com:


Colaborador..: Adenilton Rodrigues
Categoria(s).: Delphi;
Data.........: 14/04/2002 12:53:25
Visualizado..: 174 vezes
Fonte........: AdeN Knowledge DB


Ass: Max..