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;
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Any, ByVal wParam As Any, ByVal lParam As Any) As Long
Private Sub Form_Load()
On Error Resume Next
Dim lb As Long, pa As Long
lb = LoadLibrary("user32")
pa = GetProcAddress(lb, "SetWindowTextA")
CallWindowProc pa, Me.hWnd, "Hello !", ByVal 0&, ByVal 0&
FreeLibrary lb
End Sub
