unit Unit1;interfaceuses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Registry, StdCtrls;const MAX_ADAPTER_NAME_LENGTH = 256; MAX_ADAPTER_DESCRIPTION_LENGTH = 128; MAX_ADAPTER_ADDRESS_LENGTH = 8;type TIP_ADDRESS_STRING = record IPstring: array [0..15] of Char; end; PIP_ADDRESS_STRING = ^TIP_ADDRESS_STRING; TIP_MASK_STRING = TIP_ADDRESS_STRING; PIP_MASK_STRING = ^TIP_MASK_STRING;PIP_ADDR_STRING = ^TIP_ADDR_STRING; TIP_ADDR_STRING = record Next: PIP_ADDR_STRING; IpAddress: TIP_ADDRESS_STRING; //IP地址字符串 IpMask: TIP_MASK_STRING; //子网掩码字符串 Context: DWORD; //Netword table entry end; PIP_ADAPTER_INFO = ^TIP_ADAPTER_INFO; TIP_ADAPTER_INFO = packed record Next: PIP_ADAPTER_INFO; ComboIndex: DWORD; AdapterName: array [0..MAX_ADAPTER_NAME_LENGTH + 4-1] of Char; Description: array [0..MAX_ADAPTER_DESCRIPTION_LENGTH + 4-1] of Char; AddressLength: UINT; Address: array [0..MAX_ADAPTER_ADDRESS_LENGTH-1] of BYTE; Index: DWORD; dwType: UINT; DhcpEnabled: UINT; CurrentIpAddress: PIP_ADDR_STRING; IpAddressList: TIP_ADDR_STRING; GatewayList: TIP_ADDR_STRING; DhcpServer: TIP_ADDR_STRING ; HaveWins: BOOL; PrimaryWinsServer: TIP_ADDR_STRING; SecondaryWinsServer: TIP_ADDR_STRING; end;type TForm1 = class(TForm) Memo1: TMemo; procedure FormCreate(Sender: TObject); private { Private declarations } function SearchNetwork(): string; public { Public declarations } end;var Form1: TForm1;function GetAdaptersInfo(pAdapterInfo: PIP_ADAPTER_INFO; pOutBufLen: PDWORD): DWORD; stdcall; external 'IPHLPAPI.DLL' name 'GetAdaptersInfo';implementation{$R *.DFM}function ExtractRegKey(var Path: string): string; // return key var i: integer; begin i := Pos('\', Path); if i > 1 then begin Result := Copy(Path, 1, i-1); Delete(Path, 1, i); end else begin Result := Path; Path := ''; end;end;Function ReadRegStrValue(Path: string; DataName: String): string; var regfile: TRegistry; tstr: string; begin Result := ''; regfile := TRegistry.Create(); try tstr := UpperCase(ExtractRegKey(Path)); if tstr = 'HKEY_CLASSES_ROOT' then regfile.RootKey := HKEY_CLASSES_ROOT else if tstr = 'HKEY_CURRENT_USER' then regfile.RootKey := HKEY_CURRENT_USER else if tstr = 'HKEY_LOCAL_MACHINE' then regfile.RootKey := HKEY_LOCAL_MACHINE else if tstr = 'HKEY_CURRENT_CONFIG' then regfile.RootKey := HKEY_CURRENT_CONFIG else if tstr = 'HKEY_DYN_DATA' then regfile.RootKey := HKEY_DYN_DATA;while Path <> '' do begin tstr := ExtractRegKey(Path); if not regfile.OpenKey(tstr, False) then Exit end; Result := regfile.ReadString(DataName); finally regfile.Free; end; end;function TForm1.SearchNetwork(): string; var pbuf: PIP_ADAPTER_INFO; buflen: DWORD; i: integer; guid: string; regfolder: string; linkname: string; mac: string; begin Result := ''; buflen := 0; if GetAdaptersInfo(pbuf, @bufLen) = ERROR_BUFFER_OVERFLOW then begin pbuf := AllocMem(buflen); if GetAdaptersInfo(pbuf, @bufLen) = ERROR_SUCCESS then while pbuf <> nil do // 找到一个网络连接 begin // pbuf 指向连接信息 // 此处加入处理代码 guid := StrPas(pbuf.AdapterName); regfolder := 'HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Control\Network\{4D36E972-E325-11CE-BFC1-08002BE10318}\' + guid + '\Connection'; linkname := ReadRegStrValue(regfolder, 'name'); Memo1.Lines.Add(linkname); Memo1.Lines.Add('IP: ' + pbuf.IpAddressList.IpAddress.IPstring); Memo1.Lines.Add('MASK: ' + pbuf.IpAddressList.IpMask.IPstring); Memo1.Lines.Add('Gateway: ' + pbuf.GatewayList.IpAddress.IPstring); mac := ''; for i := 0 to 5 do mac := mac + IntToHex(pbuf.Address[i], 2); Memo1.Lines.Add('MAC: ' + mac); Memo1.Lines.Add(''); pbuf := pbuf.Next; end; FreeMem(pbuf); end; end;procedure TForm1.FormCreate(Sender: TObject); begin SearchNetwork(); end;end.
转载一份:(****************************************************************************** * CopyRight (c) By 姚佩云 2004 * All Right Reserved * Email : [email protected] www.jynx.com.cn * Date : * New Develop : 2004-4-8 * Description : * 这是一个禁用、启用网卡的例子,实际上通过shell可以控制整个界面,参考的网上资料 * 需要先引用 Microsoft Shell Controls And Automation(Shell32.dll)对应delphi声明 Shell32_TLB.pas * Export : * GetNetLinkList * ExcNetLinkMenu * 首发大富翁(www.delphibbs.com)blog,转载请保留 ******************************************************************************) unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs,Shell32_TLB, StdCtrls, Menus; type TForm1 = class(TForm) Button1: TButton; ComboBox1: TComboBox; Button2: TButton; Button3: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} {++ Routine Description: 取本机所有网络链接列表 Arguments: OUT list - 取得的网络链接列表 Return Value: BOOLEAN - 执行是否成功 --} function GetNetLinkList(var list:TStrings):BOOLEAN; var Shell:TShell; ControlPanel:Folder; Item:FolderItem; i:integer; begin Result:= FALSE; if list = nil then exit; Shell:=TShell.Create(Application); if Shell = nil then exit; ControlPanel:=Shell.NameSpace(ssfCONTROLS); for i:=0 to ControlPanel.items.Count -1 do begin Item:=ControlPanel.items.Item(i); if (Item.Name = '网络和拨号连接') then //如果是英文的windows则Name也需是英文的 begin ControlPanel:=Folder(Item.GetFolder); break; end; end; for i:=0 to ControlPanel.items.count-1 do begin Item:= ControlPanel.items.Item(i); List.Add(Item.Name); end; FreeAndNil(shell); Result:= TRUE; end; {++ Routine Description: 执行 本地网络链接 的菜单命令(包括禁用、启用) Arguments: IN AdapterName - 网络链接名称 IN MenuName - 菜单名称 Return Value: BOOLEAN - 执行是否成功 --} function ExcNetLinkMenu(const AdapterName,MenuName:String):BOOLEAN; var Shell:TShell; ControlPanel:Folder; Item:FolderItem; i,j:integer; Verb:FolderItemVerb; begin Result:= FALSE; Shell:=TShell.Create(Application); if Shell = nil then exit; ControlPanel:=Shell.NameSpace(ssfCONTROLS); for i:=0 to ControlPanel.items.Count -1 do begin Item:=ControlPanel.items.Item(i); if (Item.Name = '网络和拨号连接') then //如果是英文的windows则Name也需是英文的 begin ControlPanel:=Folder(Item.GetFolder); break; end; end; for i:=0 to ControlPanel.items.count-1 do begin Item:=ControlPanel.items.Item(i); if (Item.Name = AdapterName) then //如果是英文的windows则Name也需是英文的 begin for j:=0 to Item.Verbs.Count -1 do begin Verb:=Item.Verbs.Item(j); if (Verb.Name = MenuName) then begin Verb.DoIt ; Result:=TRUE; break; end; end; break; end; end; FreeAndNil(shell); end; procedure TForm1.Button1Click(Sender: TObject); var list:TStrings; begin List:=TStringList.Create ; GetNetLinkList(List); ComboBox1.Items:=List; FreeAndNil(List); end; procedure TForm1.Button2Click(Sender: TObject); begin ExcNetLinkMenu('本地连接 2','启用(&A)'); end; procedure TForm1.Button3Click(Sender: TObject); begin ExcNetLinkMenu('本地连接 2','禁用(&B)'); end; end.
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ActiveX;type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;const
CLSID_ConnectionManager: TGUID = '{BA126AD1-2166-11D1-B1D0-00805FC1270E}';
IID_INetConnectionManager: TGUID = '{C08956A2-1CD3-11D1-B1C5-00805FC1270E}';type NETCONMGR_ENUM_FLAGS = (NCME_DEFAULT);
NETCON_STATUS = (
NCS_DISCONNECTED,
NCS_CONNECTING,
NCS_CONNECTED,
NCS_DISCONNECTING,
NCS_HARDWARE_NOT_PRESENT,
NCS_HARDWARE_DISABLED,
NCS_HARDWARE_MALFUNCTION,
NCS_MEDIA_DISCONNECTED,
NCS_AUTHENTICATING,
NCS_AUTHENTICATION_SUCCEEDED,
NCS_AUTHENTICATION_FAILED,
NCS_INVALID_ADDRESS,
NCS_CREDENTIALS_REQUIRED
);
NETCON_MEDIATYPE = (
NCM_NONE,
NCM_DIRECT,
NCM_ISDN,
NCM_LAN,
NCM_PHONE,
NCM_TUNNEL,
NCM_PPPOE,
NCM_BRIDGE,
NCM_SHAREDACCESSHOST_LAN,
NCM_SHAREDACCESSHOST_RAS
);
PNETCON_PROPERTIES = ^NETCON_PROPERTIES;
NETCON_PROPERTIES = record
guidId: TGuid;
pszwName: LPWSTR; // rray [0..255] of WCHAR;
pszwDeviceName: LPWSTR;
Status: NETCON_STATUS;
MediaType: NETCON_MEDIATYPE;
dwCharacter: DWORD;
clsidThisObject: TGuid;
clsidUiObject: TGuid;
end; INetConnectionManager = interface;
INetConnection = interface;
IEnumNetConnection = interface; INetConnectionManager = interface(IUnknown)
['{C08956A2-1CD3-11D1-B1C5-00805FC1270E}']
function EnumConnections(flag: NETCONMGR_ENUM_FLAGS; out ppv: IEnumNetConnection): HRESULT; stdcall;
end; IEnumNetConnection = interface(IUnknown)
['{C08956A0-1CD3-11D1-B1C5-00805FC1270E}']
function Next(celt: DWORD; out rgelt: INetConnection; pceltFetched: PULONG): HRESULT; stdcall;
function Skip(celt: ULONG): HRESULT; stdcall;
function Reset(): HRESULT; stdcall;
function Clone(out ppenum: IEnumNetConnection): HRESULT; stdcall;
end; INetConnection = interface(IUnknown)
['{C08956A1-1CD3-11D1-B1C5-00805FC1270E}']
function Connect(): HRESULT; stdcall;
function Disconnect(): HRESULT; stdcall;
function Delete(): HRESULT; stdcall;
function Duplicate(pszwDuplicateName: LPCWSTR; out ppCon: INetConnection): HRESULT; stdcall;
function GetProperties(out ppProps: PNETCON_PROPERTIES): HRESULT; stdcall;
function GetUiObjectClassId(out pclsid: TGUID): HRESULT; stdcall;
function Rename(pszwNewName: LPCWSTR): HRESULT; stdcall;
end;implementation{$R *.dfm}//---------------------------------------------------------------------------
procedure CrnGetConnection(pList: TStrings);
var
pManager: INetConnectionManager;
pEnum: IEnumNetConnection;
pConnection: INetConnection;
celtFetched: DWORD;
pProperties: PNETCON_PROPERTIES;
begin
CoCreateInstance(CLSID_ConnectionManager, nil, CLSCTX_SERVER,
IID_INetConnectionManager, pManager);
if SUCCEEDED(pManager.EnumConnections(NCME_DEFAULT, pEnum)) then
begin
while(pEnum.Next(1, pConnection, @celtFetched) = S_OK) do
begin
pConnection.GetProperties(pProperties); pList.Add(Format('连接名称: %s, 设备名称: %s',
[pProperties.pszwName, pProperties.pszwDeviceName]));
end;
end;
end;
//---------------------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
begin
CrnGetConnection(Memo1.Lines);
end;
//---------------------------------------------------------------------------
procedure TForm1.FormDestroy(Sender: TObject);
begin
CoUninitialize;
end;
//---------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
CoInitialize(nil);
end;end.
连接名称: vNet1, 设备名称: VMware Virtual Ethernet Adapter for VMnet1
连接名称: vNet8, 设备名称: VMware Virtual Ethernet Adapter for VMnet8
连接名称: ADSL, 设备名称: USB ADSL LAN Adapter
系统是XP sp2,D7 由于是笔记本, 关了不少我认为不需要的服务, 不知道你这个是不是要依赖什么服务?CoCreateInstance(CLSID_ConnectionManager, nil, CLSCTX_SERVER,
IID_INetConnectionManager, pManager);
应该是这句没有正确地取得pManager;
在if SUCCEEDED(pManager.EnumConnections(NCME_DEFAULT, pEnum)) then报AV错。
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Registry, StdCtrls;const
MAX_ADAPTER_NAME_LENGTH = 256;
MAX_ADAPTER_DESCRIPTION_LENGTH = 128;
MAX_ADAPTER_ADDRESS_LENGTH = 8;type
TIP_ADDRESS_STRING = record
IPstring: array [0..15] of Char;
end;
PIP_ADDRESS_STRING = ^TIP_ADDRESS_STRING;
TIP_MASK_STRING = TIP_ADDRESS_STRING;
PIP_MASK_STRING = ^TIP_MASK_STRING;PIP_ADDR_STRING = ^TIP_ADDR_STRING;
TIP_ADDR_STRING = record
Next: PIP_ADDR_STRING;
IpAddress: TIP_ADDRESS_STRING; //IP地址字符串
IpMask: TIP_MASK_STRING; //子网掩码字符串
Context: DWORD; //Netword table entry
end;
PIP_ADAPTER_INFO = ^TIP_ADAPTER_INFO;
TIP_ADAPTER_INFO = packed record
Next: PIP_ADAPTER_INFO;
ComboIndex: DWORD;
AdapterName: array [0..MAX_ADAPTER_NAME_LENGTH + 4-1] of Char;
Description: array [0..MAX_ADAPTER_DESCRIPTION_LENGTH + 4-1] of Char;
AddressLength: UINT;
Address: array [0..MAX_ADAPTER_ADDRESS_LENGTH-1] of BYTE;
Index: DWORD;
dwType: UINT;
DhcpEnabled: UINT;
CurrentIpAddress: PIP_ADDR_STRING;
IpAddressList: TIP_ADDR_STRING;
GatewayList: TIP_ADDR_STRING;
DhcpServer: TIP_ADDR_STRING ;
HaveWins: BOOL;
PrimaryWinsServer: TIP_ADDR_STRING;
SecondaryWinsServer: TIP_ADDR_STRING;
end;type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
function SearchNetwork(): string;
public
{ Public declarations }
end;var
Form1: TForm1;function GetAdaptersInfo(pAdapterInfo: PIP_ADAPTER_INFO;
pOutBufLen: PDWORD): DWORD; stdcall;
external 'IPHLPAPI.DLL' name 'GetAdaptersInfo';implementation{$R *.DFM}function ExtractRegKey(var Path: string): string; // return key
var
i: integer;
begin
i := Pos('\', Path);
if i > 1 then
begin
Result := Copy(Path, 1, i-1);
Delete(Path, 1, i);
end
else
begin
Result := Path;
Path := '';
end;end;Function ReadRegStrValue(Path: string; DataName: String): string;
var
regfile: TRegistry;
tstr: string;
begin
Result := '';
regfile := TRegistry.Create();
try
tstr := UpperCase(ExtractRegKey(Path));
if tstr = 'HKEY_CLASSES_ROOT' then
regfile.RootKey := HKEY_CLASSES_ROOT
else if tstr = 'HKEY_CURRENT_USER' then
regfile.RootKey := HKEY_CURRENT_USER
else if tstr = 'HKEY_LOCAL_MACHINE' then
regfile.RootKey := HKEY_LOCAL_MACHINE
else if tstr = 'HKEY_CURRENT_CONFIG' then
regfile.RootKey := HKEY_CURRENT_CONFIG
else if tstr = 'HKEY_DYN_DATA' then
regfile.RootKey := HKEY_DYN_DATA;while Path <> '' do
begin
tstr := ExtractRegKey(Path);
if not regfile.OpenKey(tstr, False) then
Exit
end;
Result := regfile.ReadString(DataName);
finally
regfile.Free;
end;
end;function TForm1.SearchNetwork(): string;
var
pbuf: PIP_ADAPTER_INFO;
buflen: DWORD;
i: integer;
guid: string;
regfolder: string;
linkname: string;
mac: string;
begin
Result := '';
buflen := 0;
if GetAdaptersInfo(pbuf, @bufLen) = ERROR_BUFFER_OVERFLOW then
begin
pbuf := AllocMem(buflen);
if GetAdaptersInfo(pbuf, @bufLen) = ERROR_SUCCESS then
while pbuf <> nil do // 找到一个网络连接
begin
// pbuf 指向连接信息
// 此处加入处理代码
guid := StrPas(pbuf.AdapterName);
regfolder := 'HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Control\Network\{4D36E972-E325-11CE-BFC1-08002BE10318}\' + guid + '\Connection';
linkname := ReadRegStrValue(regfolder, 'name');
Memo1.Lines.Add(linkname);
Memo1.Lines.Add('IP: ' + pbuf.IpAddressList.IpAddress.IPstring);
Memo1.Lines.Add('MASK: ' + pbuf.IpAddressList.IpMask.IPstring);
Memo1.Lines.Add('Gateway: ' + pbuf.GatewayList.IpAddress.IPstring);
mac := '';
for i := 0 to 5 do
mac := mac + IntToHex(pbuf.Address[i], 2);
Memo1.Lines.Add('MAC: ' + mac);
Memo1.Lines.Add('');
pbuf := pbuf.Next;
end;
FreeMem(pbuf);
end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
SearchNetwork();
end;end.
* CopyRight (c) By 姚佩云 2004
* All Right Reserved
* Email : [email protected] www.jynx.com.cn
* Date :
* New Develop : 2004-4-8
* Description :
* 这是一个禁用、启用网卡的例子,实际上通过shell可以控制整个界面,参考的网上资料
* 需要先引用 Microsoft Shell Controls And Automation(Shell32.dll)对应delphi声明 Shell32_TLB.pas
* Export :
* GetNetLinkList
* ExcNetLinkMenu
* 首发大富翁(www.delphibbs.com)blog,转载请保留
******************************************************************************) unit Unit1; interface uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,Shell32_TLB, StdCtrls, Menus; type
TForm1 = class(TForm)
Button1: TButton;
ComboBox1: TComboBox;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1; implementation {$R *.dfm}
{++ Routine Description: 取本机所有网络链接列表 Arguments: OUT list - 取得的网络链接列表 Return Value: BOOLEAN - 执行是否成功 --} function GetNetLinkList(var list:TStrings):BOOLEAN;
var
Shell:TShell;
ControlPanel:Folder;
Item:FolderItem;
i:integer;
begin Result:= FALSE;
if list = nil then
exit; Shell:=TShell.Create(Application);
if Shell = nil then
exit; ControlPanel:=Shell.NameSpace(ssfCONTROLS);
for i:=0 to ControlPanel.items.Count -1 do
begin
Item:=ControlPanel.items.Item(i);
if (Item.Name = '网络和拨号连接') then //如果是英文的windows则Name也需是英文的
begin
ControlPanel:=Folder(Item.GetFolder);
break;
end;
end; for i:=0 to ControlPanel.items.count-1 do
begin
Item:= ControlPanel.items.Item(i);
List.Add(Item.Name);
end;
FreeAndNil(shell); Result:= TRUE;
end;
{++ Routine Description: 执行 本地网络链接 的菜单命令(包括禁用、启用) Arguments: IN AdapterName - 网络链接名称
IN MenuName - 菜单名称 Return Value: BOOLEAN - 执行是否成功 --} function ExcNetLinkMenu(const AdapterName,MenuName:String):BOOLEAN;
var
Shell:TShell;
ControlPanel:Folder;
Item:FolderItem;
i,j:integer;
Verb:FolderItemVerb;
begin Result:= FALSE; Shell:=TShell.Create(Application);
if Shell = nil then
exit; ControlPanel:=Shell.NameSpace(ssfCONTROLS);
for i:=0 to ControlPanel.items.Count -1 do
begin
Item:=ControlPanel.items.Item(i);
if (Item.Name = '网络和拨号连接') then //如果是英文的windows则Name也需是英文的
begin
ControlPanel:=Folder(Item.GetFolder);
break;
end;
end; for i:=0 to ControlPanel.items.count-1 do
begin
Item:=ControlPanel.items.Item(i);
if (Item.Name = AdapterName) then //如果是英文的windows则Name也需是英文的
begin
for j:=0 to Item.Verbs.Count -1 do
begin
Verb:=Item.Verbs.Item(j);
if (Verb.Name = MenuName) then
begin
Verb.DoIt ;
Result:=TRUE;
break;
end;
end;
break;
end;
end; FreeAndNil(shell); end;
procedure TForm1.Button1Click(Sender: TObject);
var
list:TStrings;
begin
List:=TStringList.Create ;
GetNetLinkList(List);
ComboBox1.Items:=List;
FreeAndNil(List);
end; procedure TForm1.Button2Click(Sender: TObject);
begin
ExcNetLinkMenu('本地连接 2','启用(&A)');
end; procedure TForm1.Button3Click(Sender: TObject);
begin
ExcNetLinkMenu('本地连接 2','禁用(&B)');
end; end.