Johnjces
asked on
Reset network card or how do I fully disable and re-enable (rlibby)
I have several chunks of code that is supposed to reset the network card. One piece of code uses the hnetcfg.dll (ActiveX) and works great, BUT, it only works under Windows XP and higher. I need 2000 support as well.
The other chunk was obtained from code and a component by Russell Libby (rlibby) which keeps the network icon active yet disables any network traffic. Not like a manual disable - enable, which resets the card or like the XP code using the ActiveX.
Snippets are below.
Does anyone have any code that will fully reset a NIC in 2000 and above?
Thanks!
John
The other chunk was obtained from code and a component by Russell Libby (rlibby) which keeps the network icon active yet disables any network traffic. Not like a manual disable - enable, which resets the card or like the XP code using the ActiveX.
Snippets are below.
Does anyone have any code that will fully reset a NIC in 2000 and above?
Thanks!
John
// The following is from rlibby using his netstate library.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, NetState, IpRtrMib;
type
TForm1 = class(TForm)
Button1: TButton;
NetAdapter1: TNetAdapter;
Memo1: TMemo;
Button2: TButton;
procedure NetAdapter1Connect(Sender: TObject; IntfAdapter: _MIB_IFROW);
procedure NetAdapter1Disconnect(Sender: TObject; IntfAdapter: _MIB_IFROW);
procedure NetAdapter1StateChange(Sender: TObject; IntfAdapter: _MIB_IFROW; LastState, LastAdminState: Cardinal);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure UpdateInfo(Memo: TMemo; Row: _MIB_IFROW);
begin
with Memo do
begin
Lines.Add(Format(' Name: %s', [InterfaceName(Row)]));
Lines.Add(Format(' Operational State: %d', [Row.dwOperStatus]));
Lines.Add(Format(' Admin State: %d', [Row.dwAdminStatus]));
end;
end;
procedure TForm1.NetAdapter1Connect(Sender: TObject; IntfAdapter: _MIB_IFROW);
begin
Memo1.Lines.Add(Format('%s connected', [InterfaceName(IntfAdapter)]));
UpdateInfo(Memo1, IntfAdapter);
end;
procedure TForm1.NetAdapter1Disconnect(Sender: TObject; IntfAdapter: _MIB_IFROW);
begin
Memo1.Lines.Add(Format('%s disconnected', [InterfaceName(IntfAdapter)]));
UpdateInfo(Memo1, IntfAdapter);
end;
procedure TForm1.NetAdapter1StateChange(Sender: TObject; IntfAdapter: _MIB_IFROW; LastState, LastAdminState: Cardinal);
begin
Memo1.Lines.Add(Format('%s state change', [InterfaceName(IntfAdapter)]));
UpdateInfo(Memo1, IntfAdapter);
if InterfaceIsConnected(IntfAdapter) then
Memo1.Lines.Add('-- Connected -- ')
else
Memo1.Lines.Add('-- Disconnected -- ');
end;
procedure TForm1.Button1Click(Sender: TObject);
var dwIndex: Integer;
begin
for dwIndex:=0 to Pred(NetAdapter1.IntfAdapterCount) do
NetAdapter1.DisableIntfAdapter(NetAdapter1[dwIndex]);
end;
procedure TForm1.Button2Click(Sender: TObject);
var dwIndex: Integer;
begin
for dwIndex:=0 to Pred(NetAdapter1.IntfAdapterCount) do
NetAdapter1.EnableIntfAdapter(NetAdapter1[dwIndex]);
end;
end.
//The following uses the Windows XP firewall control ActiveX, hnetcfg.dll and works but ONLY under XP. You // have to import the as an Active X hnetcfg.dll as NETCONLib_TLB and the dll is under system32.
uses
OleServer, NETCONLib_TLB, activeX, ComObj;
procedure TFPCClusterMain.ResetNIC(const aConnection: string);
var
pEnum: IEnumVariant;
vNetCon: OleVARIANT;
dwRetrieved: Cardinal;
pUser: NETCONLib_TLB.PUserType1;
begin
//enabled := false;
try
pEnum := ( NetSharingManager.EnumEveryConnection._NewEnum as IEnumVariant);
while (pEnum.Next(1, vNetCon, dwRetrieved) = S_OK) do
begin
(IUnknown(vNetCon) as INetConnection).GetProperties(pUser);
if pUser.pszwName = aConnection then
begin
(IUnknown(vNetCon) as INetConnection).Disconnect;
(IUnknown(vNetCon) as INetConnection).Connect;
delay(2000);
break;
end;
end;
finally
//enabled := true;
end;
end;
procedure TFPCClusterMain.GetConnectionList(Strings : TStrings);
var
pEnum: IEnumVariant;
vNetCon: OleVARIANT;
dwRetrieved: Cardinal;
pUser: NETCONLib_TLB.PUserType1;
NetCon : INetConnection;
begin
Strings.Clear;
pEnum := ( NetSharingManager.EnumEveryConnection._NewEnum as IEnumVariant);
while (pEnum.Next(1, vNetCon, dwRetrieved) = S_OK) do
begin
(IUnknown(vNetCon) as INetConnection).GetProperties(pUser);
NetCon := (IUnknown(vNetCon) as INetConnection);
if (pUser.Status in [NCS_CONNECTED,NCS_CONNECTING])//remove if you want disabled NIC cards also
and (pUser.MediaType in [NCM_LAN,NCM_SHAREDACCESSHOST_LAN,NCM_ISDN] ) then
begin
//we only want valid network cards that are enabled
Strings.Add(pUser.pszwName );
//IdList.Add(GuidToString(pUser.guidId));
end;
end;
end;
ASKER
Russell,
THANKS!!!
John
THANKS!!!
John
ASKER CERTIFIED SOLUTION
membership
Create a free account to see this answer
Signing up is free and takes 30 seconds. No credit card required.
ASKER
Russell,
Thanks! I will check it out. That is a heck of a lot of code to actually "Click" those menu items, eh? That was a lot of work and truly unexpected!
I was seeking and working on a much simpler alternative, but if this works in 2000 and up, I will be truly grateful!
John
Thanks! I will check it out. That is a heck of a lot of code to actually "Click" those menu items, eh? That was a lot of work and truly unexpected!
I was seeking and working on a much simpler alternative, but if this works in 2000 and up, I will be truly grateful!
John
ASKER
Maybe there still is a simpler way.... so some more info might be helpful.
I am assigning a non persistent virtual IP to my NIC. I can remove the virtual (secondary) IP without any problems and it is removed/disabled. However, if the network cable is unplugged and that event trapped, the IP cannot be removed. A Win32 error occurs. Even after plugging the cable back in, the IP cannot be removed. Something happens when the card is unplugged and even after plugging it back in. The only solution has been a reset of the NIC if I want to rid myself of this virtual IP.
If the cable is left alone, not unplugged, you can and delete all day long with no problems this virtual IP. SO when one disables and enables the NIC, the virtual IP, not being persistent, clears.
Tested on multiple PCs and hardware. This uses the IPHlp and all those units supplied through Jedi.
So, if you have any other ideas....
Thanks. Ā I'll get cracking on your code.
John
I am assigning a non persistent virtual IP to my NIC. I can remove the virtual (secondary) IP without any problems and it is removed/disabled. However, if the network cable is unplugged and that event trapped, the IP cannot be removed. A Win32 error occurs. Even after plugging the cable back in, the IP cannot be removed. Something happens when the card is unplugged and even after plugging it back in. The only solution has been a reset of the NIC if I want to rid myself of this virtual IP.
If the cable is left alone, not unplugged, you can and delete all day long with no problems this virtual IP. SO when one disables and enables the NIC, the virtual IP, not being persistent, clears.
Tested on multiple PCs and hardware. This uses the IPHlp and all those units supplied through Jedi.
So, if you have any other ideas....
Thanks. Ā I'll get cracking on your code.
John
ASKER
Russell,
Works great on Windows XP but does not work on Windows 2000. I get your
'Failed to aquire the "Network Connections" shell folder interface'
error.
John
Works great on Windows XP but does not work on Windows 2000. I get your
'Failed to aquire the "Network Connections" shell folder interface'
error.
John
Ok, try changing the NC_ROOT to "Network and Dial-up Connections" and then run it again on a 2K box.
If this runs through ok (it should), then the code can be modded to check running OS version. Also, how are you adding this virtual IP and what api are you using to try and remove it?
Russell
If this runs through ok (it should), then the code can be modded to check running OS version. Also, how are you adding this virtual IP and what api are you using to try and remove it?
Russell
ASKER
Using:
VVAddIPAddress(Address, Mask, IfIndex, NTEContext, NTEInstance); to add an IP (again non persistent)
and
VVDeleteIPAddress(NTEConte xt);
The API is the IPhelper stuff which includes:
IPExport, Ā IPHlpApi, Ā Iprtrmib, Ā IpTypes and Ā IpFunctions
I'll mess around with the NC_ROOT and get back with you.
John
PS. How in the world did you learn your way around the registry as well as you do?!
VVAddIPAddress(Address, Mask, IfIndex, NTEContext, NTEInstance); to add an IP (again non persistent)
and
VVDeleteIPAddress(NTEConte
The API is the IPhelper stuff which includes:
IPExport, Ā IPHlpApi, Ā Iprtrmib, Ā IpTypes and Ā IpFunctions
I'll mess around with the NC_ROOT and get back with you.
John
PS. How in the world did you learn your way around the registry as well as you do?!
ASKER
Alrighty,
Changed
NC_ROOT Ā = Ā 'Network Connections';
to
NC_ROOT Ā = Ā 'Network and Dial-up Connections';
No Joy on 2000. And of course no joy on XP.
hmmm... I certainly do not know where to go!
John
Changed
NC_ROOT Ā = Ā 'Network Connections';
to
NC_ROOT Ā = Ā 'Network and Dial-up Connections';
No Joy on 2000. And of course no joy on XP.
hmmm... I certainly do not know where to go!
John
Sorry John,
Don't have a Win2K box to test on, so all I can suggest is going to control panel and copying the exact text from the Network settings control panel item. If you can't debug / single step on the 2K box, you can also add a MessageBox in the GetNetworkFolder routine at:
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Check for "Network Connections"
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā MessageBox(0, PChar(StrRetToStr(lpValue) ), nil, MB_OK); // <--
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if (CompareText(StrRetToStr(l pValue), NC_ROOT) = 0) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā ...
this will tell you (a) if the code is at least enumerating the control panel items and (b) what names are getting parsed out of the shell items. As to the use of AddIpAddress/DeleteIPAddre ss routines, I can't find anything that specifically talks about the DeleteIPAddress failing if the cable is unplugged. The two suggestions I have:
- In this scenario, have you tried to re-AddIpAddress(...) on the address in question to see if that succeedes, which would allow you to call delete?
- You could call DisableMediaSense, which would eliminate the notifications.. problem is, it disables notification all adapters
Its a little tough as the netshell.dll and hnetcfg are not available on Win2K
Russell
Don't have a Win2K box to test on, so all I can suggest is going to control panel and copying the exact text from the Network settings control panel item. If you can't debug / single step on the 2K box, you can also add a MessageBox in the GetNetworkFolder routine at:
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Check for "Network Connections"
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā MessageBox(0, PChar(StrRetToStr(lpValue)
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if (CompareText(StrRetToStr(l
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā ...
this will tell you (a) if the code is at least enumerating the control panel items and (b) what names are getting parsed out of the shell items. As to the use of AddIpAddress/DeleteIPAddre
- In this scenario, have you tried to re-AddIpAddress(...) on the address in question to see if that succeedes, which would allow you to call delete?
- You could call DisableMediaSense, which would eliminate the notifications.. problem is, it disables notification all adapters
Its a little tough as the netshell.dll and hnetcfg are not available on Win2K
Russell
ASKER
I know!
Yes, I have closely scrutinized 2K and the control panel to make sure I spelled it correctly.
When I get home I will be able to step through it on a 2K box. Here I can only compile on XP but can test on a bunch of different machines.
I never thought about trying to re-add the address, as it still exists, but might be worth a try!
I'll let you know!
I'll accept but we can keep going as open discussion if need be.
Thanks Russell!
Yes, I have closely scrutinized 2K and the control panel to make sure I spelled it correctly.
When I get home I will be able to step through it on a 2K box. Here I can only compile on XP but can test on a bunch of different machines.
I never thought about trying to re-add the address, as it still exists, but might be worth a try!
I'll let you know!
I'll accept but we can keep going as open discussion if need be.
Thanks Russell!
ASKER
Simply above and beyond the call! More than I expected and I thank-you!
Thanks, and I hope you didn't feel like you had to close this question. I will look at it more tomorrow to see if there is anything else I can offer.
Russell
Russell
ASKER
I know I entered Network and Dial-up Connections and spelled it right.
I stepped through and in WIndows 2000 and it comes up as Network and Dial-up Connections! Arghhhh! I will mess with it later this evening.
I did not feel I had to close the Q. With all the help you did it was the least I could do! I just need to figure how "Network and Dial-up Connections" does not equal "Network and Dial-up Connections"!
Thanks again!
John
I stepped through and in WIndows 2000 and it comes up as Network and Dial-up Connections! Arghhhh! I will mess with it later this evening.
I did not feel I had to close the Q. With all the help you did it was the least I could do! I just need to figure how "Network and Dial-up Connections" does not equal "Network and Dial-up Connections"!
Thanks again!
John
ASKER
This AM I, (didn't do anything at home last night on it), I found that the unit is getting the network folder, but failing after that. Comparing "Network and Dial-up Ā Connections, with what I typed, (in case I changed something or fat fingered a key) comes up 0. All is OK.
It fails after that... just have to continue my debugging.
One thing however, is that 2000 does not have the following keys in its registry.
Ā '{93F2F68C-1D1B-11D3-A30E- 00C04F79AB D1}';
Ā '{0E700BE1-9DB6-11D1-A1CE- 00C04FD75D 13}';
... and this could be the source of the error.
I do not know the registry with this granularity and no nothing of any work around.
Thanks!
John
It fails after that... just have to continue my debugging.
One thing however, is that 2000 does not have the following keys in its registry.
Ā '{93F2F68C-1D1B-11D3-A30E-
Ā '{0E700BE1-9DB6-11D1-A1CE-
... and this could be the source of the error.
I do not know the registry with this granularity and no nothing of any work around.
Thanks!
John
One last shot, removed the extra column info and dropped it down to just IShellFolder. Gives you the connect / disconnect only. Also, the parse name (GUID) is extracted and compared, which should be the same for Win2K/XP/Vista "::{7007ACC7-3202-11D1-AAD 2-00805FC1 270E}"
As I said, last shot...
unit NetConnections;
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
//
// Ā Unit Ā Ā Ā Ā : Ā NetConnections
// Ā Author Ā Ā Ā : Ā rllibby
// Ā Date Ā Ā Ā Ā : Ā 06.12.2007
// Ā Description : Ā Shell (COM) based mechanism for enabling / disabling the
// Ā Ā Ā Ā Ā Ā Ā Ā Ā network connections on a PC.
//
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
interface
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
// Ā Include units
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
uses
Ā Windows, SysUtils, Classes, Forms, ComObj, ActiveX, ShlObj;
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
// Ā Constants
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
const
Ā NC_ROOT Ā Ā Ā Ā Ā = Ā '::{7007ACC7-3202-11D1-AAD 2-00805FC1 270E}';
Ā NC_ENABLE Ā Ā Ā Ā = Ā 16;
Ā NC_DISABLE Ā Ā Ā Ā = Ā 17;
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
// Ā Types
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
type
Ā ENetConnections Ā = Ā class(Exception);
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
// Ā Resource strings
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
resourcestring
Ā resAquire Ā Ā Ā Ā = Ā 'Failed to aquire the "Network Connections" shell folder interface';
Ā resLoaded Ā Ā Ā Ā = Ā 'The network collection item has not been loaded';
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
// Ā TPidlList
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
type
Ā TPidlList Ā Ā Ā Ā = Ā class(TObject)
Ā private
Ā Ā Ā // Private declarations
Ā Ā Ā FList: Ā Ā Ā Ā TList;
Ā protected
Ā Ā Ā // Protected declarations
Ā Ā Ā function Ā Ā Ā GetCount: Integer;
Ā Ā Ā function Ā Ā Ā GetItems(Index: Integer): PItemIDList;
Ā Ā Ā procedure Ā Ā Ā LoadFolder(Folder: IShellFolder);
Ā public
Ā Ā Ā // Public declarations
Ā Ā Ā constructor Ā Ā Create(Folder: IShellFolder);
Ā Ā Ā destructor Ā Ā Destroy; override;
Ā Ā Ā procedure Ā Ā Ā Clear;
Ā public
Ā Ā Ā // Public properties
Ā Ā Ā property Ā Ā Ā Count: Integer read GetCount;
Ā Ā Ā property Ā Ā Ā Items[Index: Integer]: PItemIDList read GetItems; default;
Ā end;
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
// Ā TNetConnection
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
type
Ā TNetConnection Ā Ā = Ā class(TCollectionItem)
Ā private
Ā Ā Ā // Private declarations
Ā Ā Ā FFolder: Ā Ā Ā IShellFolder;
Ā Ā Ā FItem: Ā Ā Ā Ā PItemIDList;
Ā Ā Ā function Ā Ā Ā ExecuteVerb(Verb: Word): HResult;
Ā protected
Ā Ā Ā // Protected declarations
Ā Ā Ā procedure Ā Ā Ā CheckLoaded;
Ā Ā Ā function Ā Ā Ā GetName: String;
Ā Ā Ā procedure Ā Ā Ā Load(Folder: IShellFolder; Item: PItemIDList);
Ā public
Ā Ā Ā // Public declarations
Ā Ā Ā constructor Ā Ā Create(Collection: TCollection); override;
Ā Ā Ā destructor Ā Ā Destroy; override;
Ā Ā Ā function Ā Ā Ā Connect: HResult;
Ā Ā Ā function Ā Ā Ā Disconnect: HResult;
Ā public
Ā Ā Ā // Public properties
Ā Ā Ā property Ā Ā Ā Name: String read GetName;
Ā end;
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
// Ā TNetConnections
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
type
Ā TNetConnections Ā = Ā class(TCollection)
Ā private
Ā Ā Ā // Private declarations
Ā Ā Ā FConnections: Ā TPidlList;
Ā Ā Ā FFolder: Ā Ā Ā IShellFolder;
Ā Ā Ā function Ā Ā Ā GetItem(Index: Integer): TNetConnection;
Ā Ā Ā procedure Ā Ā Ā SetItem(Index: Integer; Value: TNetConnection);
Ā protected
Ā Ā Ā // Protected declarations
Ā Ā Ā procedure Ā Ā Ā Load;
Ā public
Ā Ā Ā // Public declarations
Ā Ā Ā constructor Ā Ā Create;
Ā Ā Ā destructor Ā Ā Destroy; override;
Ā public
Ā Ā Ā // Public properties
Ā Ā Ā property Ā Ā Ā Items[Index: Integer]: TNetConnection read GetItem write SetItem; default;
Ā end;
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
// Ā Utility functions
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
function Ā GetNetworkFolder(out NetworkFolder: IShellFolder): Boolean;
function Ā CopyPIDL(Item: PItemIDList): PItemIDList;
function Ā CreatePIDL(Size: Integer): PItemIDList;
function Ā GetNextPIDL(Item: PItemIDList): PItemIDList;
function Ā GetPIDLSize(Item: PItemIDList): Integer;
function Ā StrRetToStr(StrRet: TStrRet): String;
procedure Ā StrRetFree(StrRet: TStrRet);
implementation
//// TNetConnection ////////////////////////// ////////// ////////// ////////// ////
constructor TNetConnection.Create(Coll ection: TCollection);
begin
Ā // Perform inherited
Ā inherited Create(Collection);
Ā // Set starting defaults
Ā FFolder:=nil;
Ā FItem:=nil;
end;
destructor TNetConnection.Destroy;
begin
Ā // Resource protection
Ā try
Ā Ā Ā // Free memory
Ā Ā Ā CoTaskMemFree(FItem);
Ā Ā Ā // Release the interface
Ā Ā Ā FFolder:=nil;
Ā finally
Ā Ā Ā // Perform inherited
Ā Ā Ā inherited Destroy;
Ā end;
end;
procedure TNetConnection.Load(Folder : IShellFolder; Item: PItemIDList);
begin
Ā // Persist the passed values
Ā FFolder:=Folder;
Ā FItem:=CopyPidl(Item);
end;
procedure TNetConnection.CheckLoaded ;
begin
Ā // Determine if we are in a loaded state, raise exception if not
Ā if (FFolder = nil) or (FItem = nil) then raise ENetConnections.CreateRes( @resLoaded );
end;
function TNetConnection.Connect: HResult;
begin
Ā // Perform the connect
Ā result:=ExecuteVerb(NC_ENA BLE);
end;
function TNetConnection.Disconnect: HResult;
begin
Ā // Perform the disconnect
Ā result:=ExecuteVerb(NC_DIS ABLE);
end;
function TNetConnection.ExecuteVerb (Verb: Word): HResult;
var Ā lpCmd: Ā Ā Ā Ā TCMInvokeCommandInfo;
Ā Ā Ā pvCtxMenu: Ā Ā IContextMenu;
Ā Ā Ā dwMark: Ā Ā Ā Ā LongWord;
begin
Ā // Check loaded state
Ā CheckLoaded;
Ā // Query for the conext menu
Ā result:=FFolder.GetUIObjec tOf(Applic ation.Hand le, 1, FItem, IContextMenu, nil, pvCtxMenu);
Ā // Check for success
Ā if Succeeded(result) then
Ā begin
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Clear the struct
Ā Ā Ā Ā FillChar(lpCmd, SizeOf(TCMInvokeCommandInf o), 0);
Ā Ā Ā Ā // Setup the command info struct
Ā Ā Ā Ā lpCmd.cbSize:=SizeOf(TCMIn vokeComman dInfo);
Ā Ā Ā Ā lpCmd.hwnd:=Application.Ha ndle;
Ā Ā Ā Ā lpCmd.lpVerb:=MakeIntResou rce(Verb);
Ā Ā Ā Ā lpCmd.nShow:=SW_SHOW;
Ā Ā Ā Ā // Execute
Ā Ā Ā Ā if (pvCtxMenu.InvokeCommand(l pCmd) = S_OK) then
Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā // Determine time to wait
Ā Ā Ā Ā Ā Ā dwMark:=GetTickCount + 5000;
Ā Ā Ā Ā Ā Ā // Spin message loop
Ā Ā Ā Ā Ā Ā while (dwMark >Ā GetTickCount) do
Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā // Process messages
Ā Ā Ā Ā Ā Ā Ā Application.ProcessMessage s;
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā end;
Ā Ā Ā finally
Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā pvCtxMenu:=nil;
Ā Ā Ā end;
Ā end;
end;
function TNetConnection.GetName: String;
var Ā lpName: Ā Ā Ā Ā TStrRet;
begin
Ā // Check loaded state
Ā CheckLoaded;
Ā // Get display name
Ā if (FFolder.GetDisplayNameOf( FItem, SHGDN_NORMAL or SHGDN_INFOLDER, lpName) = S_OK) then
Ā begin
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Return the name
Ā Ā Ā Ā result:=StrRetToStr(lpName );
Ā Ā Ā finally
Ā Ā Ā Ā // Free string memory
Ā Ā Ā Ā StrRetFree(lpName);
Ā Ā Ā end;
Ā end
Ā else
Ā Ā Ā // Failed to get name
Ā Ā Ā SetLength(result, 0);
end;
//// TNetConnections ////////////////////////// ////////// ////////// ////////// ///
constructor TNetConnections.Create;
begin
Ā // Perform inherited
Ā inherited Create(TNetConnection);
Ā // Aquire the network connections folder
Ā if not(GetNetworkFolder(FFold er)) then
Ā Ā Ā // Raise exception
Ā Ā Ā raise ENetConnections.CreateRes( @resAquire )
Ā else
Ā begin
Ā Ā Ā // Create pidl list from folder
Ā Ā Ā FConnections:=TPidlList.Cr eate(FFold er);
Ā Ā Ā // Load network connections from pidl
Ā Ā Ā Load;
Ā end;
end;
destructor TNetConnections.Destroy;
begin
Ā // Resource protection
Ā try
Ā Ā Ā // Release the interface
Ā Ā Ā FFolder:=nil;
Ā Ā Ā // Free connection list
Ā Ā Ā FConnections.Free;
Ā finally
Ā Ā Ā // Perform inherited
Ā Ā Ā inherited Destroy;
Ā end;
end;
function TNetConnections.GetItem(In dex: Integer): TNetConnection;
begin
Ā // Get the item at index
Ā result:=TNetConnection(inh erited GetItem(Index));
end;
procedure TNetConnections.SetItem(In dex: Integer; Value: TNetConnection);
begin
Ā // Set the item at index
Ā inherited SetItem(Index, Value);
end;
procedure TNetConnections.Load;
var Ā dwIndex: Ā Ā Ā Integer;
begin
Ā // Perform inherited clear;
Ā inherited Clear;
Ā // Walk the connection list and add the collection items
Ā for dwIndex:=0 to Pred(FConnections.Count) do
Ā begin
Ā Ā Ā // Perform the add and load
Ā Ā Ā TNetConnection(inherited Add).Load(FFolder, FConnections[dwIndex]);
Ā end;
end;
//// TPidlList ////////////////////////// ////////// ////////// ////////// /////////
constructor TPidlList.Create(Folder: IShellFolder);
begin
Ā // Perform inherited
Ā inherited Create;
Ā // Initial defaults
Ā FList:=TList.Create;
Ā // Load the list from the folder
Ā LoadFolder(Folder);
end;
destructor TPidlList.Destroy;
begin
Ā // Resource protection
Ā try
Ā Ā Ā // Clear the list
Ā Ā Ā Clear;
Ā Ā Ā // Free the lists
Ā Ā Ā FList.Free;
Ā finally
Ā Ā Ā // Perform inherited
Ā Ā Ā inherited Destroy;
Ā end;
end;
function TPidlList.GetCount: Integer;
begin
Ā // Return count of pidls
Ā result:=FList.Count;
end;
function TPidlList.GetItems(Index: Integer): PItemIDList;
begin
Ā // Return the pidl at the specified index
Ā result:=PItemIDList(FList[ Index]);
end;
procedure TPidlList.LoadFolder(Folde r: IShellFolder);
var Ā pvEnumList: Ā Ā Ā IEnumIDList;
Ā Ā Ā pidlItem: Ā Ā Ā Ā PItemIDList;
Ā Ā Ā cbCount: Ā Ā Ā Ā Ā Cardinal;
begin
Ā // Clear the list
Ā Clear;
Ā // Check folder interface
Ā if Assigned(Folder) then
Ā begin
Ā Ā Ā // Get enumerator
Ā Ā Ā if (Folder.EnumObjects(Applic ation.Hand le, SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN, pvEnumList) = S_OK) then
Ā Ā Ā begin
Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā // Enumerate items
Ā Ā Ā Ā Ā Ā while (pvEnumList.Next(1, pidlItem, cbCount) = S_OK) do
Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā // Add item to the list
Ā Ā Ā Ā Ā Ā Ā FList.Add(pidlItem);
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā pvEnumList:=nil;
Ā Ā Ā Ā end;
Ā Ā Ā end;
Ā end;
end;
procedure TPidlList.Clear;
var Ā dwIndex: Ā Ā Ā Integer;
begin
Ā // Resource protection
Ā try
Ā Ā Ā // Walk the list and free the pidls
Ā Ā Ā for dwIndex:=Pred(FList.Count) downto 0 do CoTaskMemFree(FList[dwInde x]);
Ā finally
Ā Ā Ā // Clear the list
Ā Ā Ā FList.Clear;
Ā end;
end;
//// Utility functions ////////////////////////// ////////// ////////// ////////// /
function GetNetworkFolder(out NetworkFolder: IShellFolder): Boolean;
var Ā pvDesktop: Ā Ā Ā Ā IShellFolder;
Ā Ā Ā pvFolder: Ā Ā Ā Ā IShellFolder;
Ā Ā Ā pvEnumItems: Ā Ā Ā IEnumIDList;
Ā Ā Ā pidlCtrlPanel: Ā Ā PItemIDList;
Ā Ā Ā pidlItem: Ā Ā Ā Ā PItemIDList;
Ā Ā Ā cbCount: Ā Ā Ā Ā Ā Cardinal;
Ā Ā Ā lpValue: Ā Ā Ā Ā Ā TStrRet;
begin
Ā // Clear outbound interface
Ā NetworkFolder:=nil;
Ā // Resource protection
Ā try
Ā Ā Ā // Get desktop folder
Ā Ā Ā if (SHGetDesktopFolder(pvDesk top) = S_OK) then
Ā Ā Ā begin
Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā // Get control panel pidl
Ā Ā Ā Ā Ā Ā if (SHGetSpecialFolderLocatio n(Applicat ion.Handle , CSIDL_CONTROLS, pidlCtrlPanel) = S_OK) then
Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Bind to folder interface
Ā Ā Ā Ā Ā Ā Ā Ā Ā if (pvDesktop.BindToObject(pi dlCtrlPane l, nil, IID_IShellFolder, pvFolder) = S_OK) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Locate the folder for "Network Connections"
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if (pvFolder.EnumObjects(0, SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN, pvEnumItems) = S_OK) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Enumerate items
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā while (pvEnumItems.Next(1, pidlItem, cbCount) = S_OK) do
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Get parse name of pidl
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if (pvFolder.GetDisplayNameOf (pidlItem, SHGDN_FORPARSING or SHGDN_INFOLDER, lpValue) = S_OK) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Check for ::{7007ACC7-3202-11D1-AAD2 -00805FC12 70E}
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if (CompareText(StrRetToStr(l pValue), NC_ROOT) = 0) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Bind to folder interface
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if not(pvFolder.BindToObject( pidlItem, nil, IShellFolder, NetworkFolder) = S_OK) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Make sure interface is cleared
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā NetworkFolder:=nil;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Done processing either way
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā break;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Free string memory
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā StrRetFree(lpValue);
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Free the pidl
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā CoTaskMemFree(pidlItem);
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā pvEnumItems:=nil;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā pvFolder:=nil;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Free the pidl
Ā Ā Ā Ā Ā Ā Ā Ā Ā CoTaskMemFree(pidlCtrlPane l);
Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā pvDesktop:=nil;
Ā Ā Ā Ā end;
Ā Ā Ā end;
Ā finally
Ā Ā Ā // Success if we obtained the folder interface
Ā Ā Ā result:=Assigned(NetworkFo lder);
Ā end;
end;
procedure StrRetFree(StrRet: TStrRet);
begin
Ā // Check the type
Ā if (StrRet.uType = STRRET_WSTR) then
Ā begin
Ā Ā Ā // Free the string memory
Ā Ā Ā CoTaskMemFree(StrRet.pOleS tr);
Ā end;
end;
function StrRetToStr(StrRet: TStrRet): String;
begin
Ā // Check the type
Ā case StrRet.uType of
Ā Ā Ā // C type string
Ā Ā Ā STRRET_CSTR Ā Ā : Ā SetString(result, StrRet.cStr, lstrlen(StrRet.cStr));
Ā Ā Ā // String offset
Ā Ā Ā STRRET_OFFSET Ā : Ā SetLength(result, 0);
Ā Ā Ā // WideString
Ā Ā Ā STRRET_WSTR Ā Ā : Ā result:=StrRet.pOleStr;
Ā else
Ā Ā Ā // Sanity check
Ā Ā Ā SetLength(result, 0);
Ā end;
end;
function CreatePIDL(Size: Integer): PItemIDList;
begin
Ā // Allocate memory
Ā result:=CoTaskMemAlloc(Siz e);
end;
function GetNextPIDL(Item: PItemIDList): PItemIDList;
begin
Ā // Check for valid item
Ā if Assigned(Item) then
Ā begin
Ā Ā Ā // Get the size of the specified item identifier.
Ā Ā Ā if (Item^.mkid.cb Ā = 0) then
Ā Ā Ā Ā // No more items
Ā Ā Ā Ā result:=nil
Ā Ā Ā else
Ā Ā Ā begin
Ā Ā Ā Ā // Add cb to pidl (casting to increment by bytes).
Ā Ā Ā Ā Inc(PChar(Item), Item^.mkid.cb);
Ā Ā Ā Ā // Check for null
Ā Ā Ā Ā if (Item^.mkid.cb = 0) then
Ā Ā Ā Ā Ā Ā // No further items
Ā Ā Ā Ā Ā Ā result:=nil
Ā Ā Ā Ā else
Ā Ā Ā Ā Ā Ā // Return next item
Ā Ā Ā Ā Ā Ā result:=Item;
Ā Ā Ā end;
Ā end
Ā else
Ā Ā Ā // No item
Ā Ā Ā result:=nil;
end;
function GetPIDLSize(Item: PItemIDList): Integer;
begin
Ā // Default result
Ā result:=0;
Ā // Check item
Ā if Assigned(Item) then
Ā begin
Ā Ā Ā // Get base size (null terminator)
Ā Ā Ā Inc(result, SizeOf(Item^.mkid.cb));
Ā Ā Ā // While we have the pidl
Ā Ā Ā while Assigned(Item) do
Ā Ā Ā begin
Ā Ā Ā Ā // Update by current pidl size
Ā Ā Ā Ā Inc(result, Item^.mkid.cb);
Ā Ā Ā Ā // Get next pidl
Ā Ā Ā Ā Item:=GetNextPIDL(Item);
Ā Ā Ā end;
Ā end;
end;
function CopyPIDL(Item: PItemIDList): PItemIDList;
var Ā dwSize: Ā Ā Ā Ā Integer;
begin
Ā // Get total pidl size
Ā dwSize:=GetPIDLSize(Item);
Ā // Create new pidl
Ā result:=CreatePIDL(dwSize) ;
Ā // Check result, move data into new pidl
Ā if Assigned(result) then Move(Item^, result^, dwSize);
end;
end.
As I said, last shot...
unit NetConnections;
//////////////////////////
//
// Ā Unit Ā Ā Ā Ā : Ā NetConnections
// Ā Author Ā Ā Ā : Ā rllibby
// Ā Date Ā Ā Ā Ā : Ā 06.12.2007
// Ā Description : Ā Shell (COM) based mechanism for enabling / disabling the
// Ā Ā Ā Ā Ā Ā Ā Ā Ā network connections on a PC.
//
//////////////////////////
interface
//////////////////////////
// Ā Include units
//////////////////////////
uses
Ā Windows, SysUtils, Classes, Forms, ComObj, ActiveX, ShlObj;
//////////////////////////
// Ā Constants
//////////////////////////
const
Ā NC_ROOT Ā Ā Ā Ā Ā = Ā '::{7007ACC7-3202-11D1-AAD
Ā NC_ENABLE Ā Ā Ā Ā = Ā 16;
Ā NC_DISABLE Ā Ā Ā Ā = Ā 17;
//////////////////////////
// Ā Types
//////////////////////////
type
Ā ENetConnections Ā = Ā class(Exception);
//////////////////////////
// Ā Resource strings
//////////////////////////
resourcestring
Ā resAquire Ā Ā Ā Ā = Ā 'Failed to aquire the "Network Connections" shell folder interface';
Ā resLoaded Ā Ā Ā Ā = Ā 'The network collection item has not been loaded';
//////////////////////////
// Ā TPidlList
//////////////////////////
type
Ā TPidlList Ā Ā Ā Ā = Ā class(TObject)
Ā private
Ā Ā Ā // Private declarations
Ā Ā Ā FList: Ā Ā Ā Ā TList;
Ā protected
Ā Ā Ā // Protected declarations
Ā Ā Ā function Ā Ā Ā GetCount: Integer;
Ā Ā Ā function Ā Ā Ā GetItems(Index: Integer): PItemIDList;
Ā Ā Ā procedure Ā Ā Ā LoadFolder(Folder: IShellFolder);
Ā public
Ā Ā Ā // Public declarations
Ā Ā Ā constructor Ā Ā Create(Folder: IShellFolder);
Ā Ā Ā destructor Ā Ā Destroy; override;
Ā Ā Ā procedure Ā Ā Ā Clear;
Ā public
Ā Ā Ā // Public properties
Ā Ā Ā property Ā Ā Ā Count: Integer read GetCount;
Ā Ā Ā property Ā Ā Ā Items[Index: Integer]: PItemIDList read GetItems; default;
Ā end;
//////////////////////////
// Ā TNetConnection
//////////////////////////
type
Ā TNetConnection Ā Ā = Ā class(TCollectionItem)
Ā private
Ā Ā Ā // Private declarations
Ā Ā Ā FFolder: Ā Ā Ā IShellFolder;
Ā Ā Ā FItem: Ā Ā Ā Ā PItemIDList;
Ā Ā Ā function Ā Ā Ā ExecuteVerb(Verb: Word): HResult;
Ā protected
Ā Ā Ā // Protected declarations
Ā Ā Ā procedure Ā Ā Ā CheckLoaded;
Ā Ā Ā function Ā Ā Ā GetName: String;
Ā Ā Ā procedure Ā Ā Ā Load(Folder: IShellFolder; Item: PItemIDList);
Ā public
Ā Ā Ā // Public declarations
Ā Ā Ā constructor Ā Ā Create(Collection: TCollection); override;
Ā Ā Ā destructor Ā Ā Destroy; override;
Ā Ā Ā function Ā Ā Ā Connect: HResult;
Ā Ā Ā function Ā Ā Ā Disconnect: HResult;
Ā public
Ā Ā Ā // Public properties
Ā Ā Ā property Ā Ā Ā Name: String read GetName;
Ā end;
//////////////////////////
// Ā TNetConnections
//////////////////////////
type
Ā TNetConnections Ā = Ā class(TCollection)
Ā private
Ā Ā Ā // Private declarations
Ā Ā Ā FConnections: Ā TPidlList;
Ā Ā Ā FFolder: Ā Ā Ā IShellFolder;
Ā Ā Ā function Ā Ā Ā GetItem(Index: Integer): TNetConnection;
Ā Ā Ā procedure Ā Ā Ā SetItem(Index: Integer; Value: TNetConnection);
Ā protected
Ā Ā Ā // Protected declarations
Ā Ā Ā procedure Ā Ā Ā Load;
Ā public
Ā Ā Ā // Public declarations
Ā Ā Ā constructor Ā Ā Create;
Ā Ā Ā destructor Ā Ā Destroy; override;
Ā public
Ā Ā Ā // Public properties
Ā Ā Ā property Ā Ā Ā Items[Index: Integer]: TNetConnection read GetItem write SetItem; default;
Ā end;
//////////////////////////
// Ā Utility functions
//////////////////////////
function Ā GetNetworkFolder(out NetworkFolder: IShellFolder): Boolean;
function Ā CopyPIDL(Item: PItemIDList): PItemIDList;
function Ā CreatePIDL(Size: Integer): PItemIDList;
function Ā GetNextPIDL(Item: PItemIDList): PItemIDList;
function Ā GetPIDLSize(Item: PItemIDList): Integer;
function Ā StrRetToStr(StrRet: TStrRet): String;
procedure Ā StrRetFree(StrRet: TStrRet);
implementation
//// TNetConnection //////////////////////////
constructor TNetConnection.Create(Coll
begin
Ā // Perform inherited
Ā inherited Create(Collection);
Ā // Set starting defaults
Ā FFolder:=nil;
Ā FItem:=nil;
end;
destructor TNetConnection.Destroy;
begin
Ā // Resource protection
Ā try
Ā Ā Ā // Free memory
Ā Ā Ā CoTaskMemFree(FItem);
Ā Ā Ā // Release the interface
Ā Ā Ā FFolder:=nil;
Ā finally
Ā Ā Ā // Perform inherited
Ā Ā Ā inherited Destroy;
Ā end;
end;
procedure TNetConnection.Load(Folder
begin
Ā // Persist the passed values
Ā FFolder:=Folder;
Ā FItem:=CopyPidl(Item);
end;
procedure TNetConnection.CheckLoaded
begin
Ā // Determine if we are in a loaded state, raise exception if not
Ā if (FFolder = nil) or (FItem = nil) then raise ENetConnections.CreateRes(
end;
function TNetConnection.Connect: HResult;
begin
Ā // Perform the connect
Ā result:=ExecuteVerb(NC_ENA
end;
function TNetConnection.Disconnect:
begin
Ā // Perform the disconnect
Ā result:=ExecuteVerb(NC_DIS
end;
function TNetConnection.ExecuteVerb
var Ā lpCmd: Ā Ā Ā Ā TCMInvokeCommandInfo;
Ā Ā Ā pvCtxMenu: Ā Ā IContextMenu;
Ā Ā Ā dwMark: Ā Ā Ā Ā LongWord;
begin
Ā // Check loaded state
Ā CheckLoaded;
Ā // Query for the conext menu
Ā result:=FFolder.GetUIObjec
Ā // Check for success
Ā if Succeeded(result) then
Ā begin
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Clear the struct
Ā Ā Ā Ā FillChar(lpCmd, SizeOf(TCMInvokeCommandInf
Ā Ā Ā Ā // Setup the command info struct
Ā Ā Ā Ā lpCmd.cbSize:=SizeOf(TCMIn
Ā Ā Ā Ā lpCmd.hwnd:=Application.Ha
Ā Ā Ā Ā lpCmd.lpVerb:=MakeIntResou
Ā Ā Ā Ā lpCmd.nShow:=SW_SHOW;
Ā Ā Ā Ā // Execute
Ā Ā Ā Ā if (pvCtxMenu.InvokeCommand(l
Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā // Determine time to wait
Ā Ā Ā Ā Ā Ā dwMark:=GetTickCount + 5000;
Ā Ā Ā Ā Ā Ā // Spin message loop
Ā Ā Ā Ā Ā Ā while (dwMark >Ā GetTickCount) do
Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā // Process messages
Ā Ā Ā Ā Ā Ā Ā Application.ProcessMessage
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā end;
Ā Ā Ā finally
Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā pvCtxMenu:=nil;
Ā Ā Ā end;
Ā end;
end;
function TNetConnection.GetName: String;
var Ā lpName: Ā Ā Ā Ā TStrRet;
begin
Ā // Check loaded state
Ā CheckLoaded;
Ā // Get display name
Ā if (FFolder.GetDisplayNameOf(
Ā begin
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Return the name
Ā Ā Ā Ā result:=StrRetToStr(lpName
Ā Ā Ā finally
Ā Ā Ā Ā // Free string memory
Ā Ā Ā Ā StrRetFree(lpName);
Ā Ā Ā end;
Ā end
Ā else
Ā Ā Ā // Failed to get name
Ā Ā Ā SetLength(result, 0);
end;
//// TNetConnections //////////////////////////
constructor TNetConnections.Create;
begin
Ā // Perform inherited
Ā inherited Create(TNetConnection);
Ā // Aquire the network connections folder
Ā if not(GetNetworkFolder(FFold
Ā Ā Ā // Raise exception
Ā Ā Ā raise ENetConnections.CreateRes(
Ā else
Ā begin
Ā Ā Ā // Create pidl list from folder
Ā Ā Ā FConnections:=TPidlList.Cr
Ā Ā Ā // Load network connections from pidl
Ā Ā Ā Load;
Ā end;
end;
destructor TNetConnections.Destroy;
begin
Ā // Resource protection
Ā try
Ā Ā Ā // Release the interface
Ā Ā Ā FFolder:=nil;
Ā Ā Ā // Free connection list
Ā Ā Ā FConnections.Free;
Ā finally
Ā Ā Ā // Perform inherited
Ā Ā Ā inherited Destroy;
Ā end;
end;
function TNetConnections.GetItem(In
begin
Ā // Get the item at index
Ā result:=TNetConnection(inh
end;
procedure TNetConnections.SetItem(In
begin
Ā // Set the item at index
Ā inherited SetItem(Index, Value);
end;
procedure TNetConnections.Load;
var Ā dwIndex: Ā Ā Ā Integer;
begin
Ā // Perform inherited clear;
Ā inherited Clear;
Ā // Walk the connection list and add the collection items
Ā for dwIndex:=0 to Pred(FConnections.Count) do
Ā begin
Ā Ā Ā // Perform the add and load
Ā Ā Ā TNetConnection(inherited Add).Load(FFolder, FConnections[dwIndex]);
Ā end;
end;
//// TPidlList //////////////////////////
constructor TPidlList.Create(Folder: IShellFolder);
begin
Ā // Perform inherited
Ā inherited Create;
Ā // Initial defaults
Ā FList:=TList.Create;
Ā // Load the list from the folder
Ā LoadFolder(Folder);
end;
destructor TPidlList.Destroy;
begin
Ā // Resource protection
Ā try
Ā Ā Ā // Clear the list
Ā Ā Ā Clear;
Ā Ā Ā // Free the lists
Ā Ā Ā FList.Free;
Ā finally
Ā Ā Ā // Perform inherited
Ā Ā Ā inherited Destroy;
Ā end;
end;
function TPidlList.GetCount: Integer;
begin
Ā // Return count of pidls
Ā result:=FList.Count;
end;
function TPidlList.GetItems(Index: Integer): PItemIDList;
begin
Ā // Return the pidl at the specified index
Ā result:=PItemIDList(FList[
end;
procedure TPidlList.LoadFolder(Folde
var Ā pvEnumList: Ā Ā Ā IEnumIDList;
Ā Ā Ā pidlItem: Ā Ā Ā Ā PItemIDList;
Ā Ā Ā cbCount: Ā Ā Ā Ā Ā Cardinal;
begin
Ā // Clear the list
Ā Clear;
Ā // Check folder interface
Ā if Assigned(Folder) then
Ā begin
Ā Ā Ā // Get enumerator
Ā Ā Ā if (Folder.EnumObjects(Applic
Ā Ā Ā begin
Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā // Enumerate items
Ā Ā Ā Ā Ā Ā while (pvEnumList.Next(1, pidlItem, cbCount) = S_OK) do
Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā // Add item to the list
Ā Ā Ā Ā Ā Ā Ā FList.Add(pidlItem);
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā pvEnumList:=nil;
Ā Ā Ā Ā end;
Ā Ā Ā end;
Ā end;
end;
procedure TPidlList.Clear;
var Ā dwIndex: Ā Ā Ā Integer;
begin
Ā // Resource protection
Ā try
Ā Ā Ā // Walk the list and free the pidls
Ā Ā Ā for dwIndex:=Pred(FList.Count)
Ā finally
Ā Ā Ā // Clear the list
Ā Ā Ā FList.Clear;
Ā end;
end;
//// Utility functions //////////////////////////
function GetNetworkFolder(out NetworkFolder: IShellFolder): Boolean;
var Ā pvDesktop: Ā Ā Ā Ā IShellFolder;
Ā Ā Ā pvFolder: Ā Ā Ā Ā IShellFolder;
Ā Ā Ā pvEnumItems: Ā Ā Ā IEnumIDList;
Ā Ā Ā pidlCtrlPanel: Ā Ā PItemIDList;
Ā Ā Ā pidlItem: Ā Ā Ā Ā PItemIDList;
Ā Ā Ā cbCount: Ā Ā Ā Ā Ā Cardinal;
Ā Ā Ā lpValue: Ā Ā Ā Ā Ā TStrRet;
begin
Ā // Clear outbound interface
Ā NetworkFolder:=nil;
Ā // Resource protection
Ā try
Ā Ā Ā // Get desktop folder
Ā Ā Ā if (SHGetDesktopFolder(pvDesk
Ā Ā Ā begin
Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā // Get control panel pidl
Ā Ā Ā Ā Ā Ā if (SHGetSpecialFolderLocatio
Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Bind to folder interface
Ā Ā Ā Ā Ā Ā Ā Ā Ā if (pvDesktop.BindToObject(pi
Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Locate the folder for "Network Connections"
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if (pvFolder.EnumObjects(0, SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN, pvEnumItems) = S_OK) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Enumerate items
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā while (pvEnumItems.Next(1, pidlItem, cbCount) = S_OK) do
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Get parse name of pidl
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if (pvFolder.GetDisplayNameOf
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Check for ::{7007ACC7-3202-11D1-AAD2
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if (CompareText(StrRetToStr(l
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Bind to folder interface
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if not(pvFolder.BindToObject(
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Make sure interface is cleared
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā NetworkFolder:=nil;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Done processing either way
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā break;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Free string memory
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā StrRetFree(lpValue);
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Free the pidl
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā CoTaskMemFree(pidlItem);
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā pvEnumItems:=nil;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā pvFolder:=nil;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Free the pidl
Ā Ā Ā Ā Ā Ā Ā Ā Ā CoTaskMemFree(pidlCtrlPane
Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā pvDesktop:=nil;
Ā Ā Ā Ā end;
Ā Ā Ā end;
Ā finally
Ā Ā Ā // Success if we obtained the folder interface
Ā Ā Ā result:=Assigned(NetworkFo
Ā end;
end;
procedure StrRetFree(StrRet: TStrRet);
begin
Ā // Check the type
Ā if (StrRet.uType = STRRET_WSTR) then
Ā begin
Ā Ā Ā // Free the string memory
Ā Ā Ā CoTaskMemFree(StrRet.pOleS
Ā end;
end;
function StrRetToStr(StrRet: TStrRet): String;
begin
Ā // Check the type
Ā case StrRet.uType of
Ā Ā Ā // C type string
Ā Ā Ā STRRET_CSTR Ā Ā : Ā SetString(result, StrRet.cStr, lstrlen(StrRet.cStr));
Ā Ā Ā // String offset
Ā Ā Ā STRRET_OFFSET Ā : Ā SetLength(result, 0);
Ā Ā Ā // WideString
Ā Ā Ā STRRET_WSTR Ā Ā : Ā result:=StrRet.pOleStr;
Ā else
Ā Ā Ā // Sanity check
Ā Ā Ā SetLength(result, 0);
Ā end;
end;
function CreatePIDL(Size: Integer): PItemIDList;
begin
Ā // Allocate memory
Ā result:=CoTaskMemAlloc(Siz
end;
function GetNextPIDL(Item: PItemIDList): PItemIDList;
begin
Ā // Check for valid item
Ā if Assigned(Item) then
Ā begin
Ā Ā Ā // Get the size of the specified item identifier.
Ā Ā Ā if (Item^.mkid.cb Ā = 0) then
Ā Ā Ā Ā // No more items
Ā Ā Ā Ā result:=nil
Ā Ā Ā else
Ā Ā Ā begin
Ā Ā Ā Ā // Add cb to pidl (casting to increment by bytes).
Ā Ā Ā Ā Inc(PChar(Item), Item^.mkid.cb);
Ā Ā Ā Ā // Check for null
Ā Ā Ā Ā if (Item^.mkid.cb = 0) then
Ā Ā Ā Ā Ā Ā // No further items
Ā Ā Ā Ā Ā Ā result:=nil
Ā Ā Ā Ā else
Ā Ā Ā Ā Ā Ā // Return next item
Ā Ā Ā Ā Ā Ā result:=Item;
Ā Ā Ā end;
Ā end
Ā else
Ā Ā Ā // No item
Ā Ā Ā result:=nil;
end;
function GetPIDLSize(Item: PItemIDList): Integer;
begin
Ā // Default result
Ā result:=0;
Ā // Check item
Ā if Assigned(Item) then
Ā begin
Ā Ā Ā // Get base size (null terminator)
Ā Ā Ā Inc(result, SizeOf(Item^.mkid.cb));
Ā Ā Ā // While we have the pidl
Ā Ā Ā while Assigned(Item) do
Ā Ā Ā begin
Ā Ā Ā Ā // Update by current pidl size
Ā Ā Ā Ā Inc(result, Item^.mkid.cb);
Ā Ā Ā Ā // Get next pidl
Ā Ā Ā Ā Item:=GetNextPIDL(Item);
Ā Ā Ā end;
Ā end;
end;
function CopyPIDL(Item: PItemIDList): PItemIDList;
var Ā dwSize: Ā Ā Ā Ā Integer;
begin
Ā // Get total pidl size
Ā dwSize:=GetPIDLSize(Item);
Ā // Create new pidl
Ā result:=CreatePIDL(dwSize)
Ā // Check result, move data into new pidl
Ā if Assigned(result) then Move(Item^, result^, dwSize);
end;
end.
ASKER
Russell,
That is more than I could hope for!!
I'll give it a last shot!
John
That is more than I could hope for!!
I'll give it a last shot!
John
ASKER
Russell,
Damn! Ā Excuse my language. Ā :(
Worked just fine again on Windows XP (pro) but did not work on Windows 2000.
Thanks for all of your hard work.
I wonder... should I repost with your code and see if anyone has any thoughts?
Thx!
John
Damn! Ā Excuse my language. Ā :(
Worked just fine again on Windows XP (pro) but did not work on Windows 2000.
Thanks for all of your hard work.
I wonder... should I repost with your code and see if anyone has any thoughts?
Thx!
John
Can you pin point *where* it is failing? That would help narrow things down alot.
ASKER
No error, just runs through like it was clicked, but no disable.... or enable.
I did some research on the folder ID {7007ACC7-3202-11D1-AAD2-0 0805FC1270 E} for win 2K and all "should' work....
I did read something about user permissions but I am an admin on the hardware I am testing on.
Also, it was interesting to note that the following when run on XP brings up the run as box but no network connections but does both under Win 2K.
%SystemRoot%\explorer.exe ::{7007ACC7-3202-11D1-AAD2 -00805FC12 70E}
hmmm... I am baffled.
Can you provide any hints on how best to debug or step through the code since it seems to 'run' just fine. No action.
John
I did some research on the folder ID {7007ACC7-3202-11D1-AAD2-0
I did read something about user permissions but I am an admin on the hardware I am testing on.
Also, it was interesting to note that the following when run on XP brings up the run as box but no network connections but does both under Win 2K.
%SystemRoot%\explorer.exe ::{7007ACC7-3202-11D1-AAD2
hmmm... I am baffled.
Can you provide any hints on how best to debug or step through the code since it seems to 'run' just fine. No action.
John
Hmm, it may be a case where the Enable/Diable aren't 16 and 17 on Win2K. The only good way to find out is to create a popup menu and have the IContextMenu fill it in with a call to QueryContextMenu. (which is what I originally did to get the values).
Will have a chance to look at it more later.
Will have a chance to look at it more later.
ASKER
Cool!
Let me know what you would like me to do...
Most of this is pretty far out of my league.. but I am learning!!! Thanks!
John
Let me know what you would like me to do...
Most of this is pretty far out of my league.. but I am learning!!! Thanks!
John
John,
Just verify that (A) the network folder is being obtained, (B) that you can enumerate the connection items (loop the collection and showmessage the Items[index].Name) and that (C) the ExecuteVerb is getting called.
I will post up code either tonight or tomorrow for extracting the context menu items in order to obtain the ID's.
Russell
Just verify that (A) the network folder is being obtained, (B) that you can enumerate the connection items (loop the collection and showmessage the Items[index].Name) and that (C) the ExecuteVerb is getting called.
I will post up code either tonight or tomorrow for extracting the context menu items in order to obtain the ID's.
Russell
ASKER
Alrighty!
It does all the enumeration but under XP it only returns the network cards, and in my XP box it shows:
Primary Gigabit
Secondary
On the Windows 2000 box (3 nics) it shows:
Make New Connection
OpenNIC
Digi
PCI Card
Could the problem be related to "Make New Connection".
John
It does all the enumeration but under XP it only returns the network cards, and in my XP box it shows:
Primary Gigabit
Secondary
On the Windows 2000 box (3 nics) it shows:
Make New Connection
OpenNIC
Digi
PCI Card
Could the problem be related to "Make New Connection".
John
Issuing an enable/disable to the first 2 (under 2K) aren't goint to do anything, but it should work for the 3rd and 4th as long as the command ID's are the same as XPs (16/17).
ASKER
Ok... but the command IDs Ā I do not know.
Thx
Thx
As promised.
unit NetConnections;
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
//
// Ā Unit Ā Ā Ā Ā : Ā NetConnections
// Ā Author Ā Ā Ā : Ā rllibby
// Ā Date Ā Ā Ā Ā : Ā 06.12.2007
// Ā Description : Ā Shell (COM) based mechanism for enabling / disabling the
// Ā Ā Ā Ā Ā Ā Ā Ā Ā network connections on a PC.
//
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
interface
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
// Ā Conditionals for testing
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
{$DEFINE DEBUG}
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
// Ā Include units
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
uses
Ā Windows, SysUtils, Classes, Forms, ComObj, ActiveX, ShlObj;
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
// Ā Constants
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
const
Ā NC_ROOT Ā Ā Ā Ā Ā = Ā '::{7007ACC7-3202-11D1-AAD 2-00805FC1 270E}';
Ā NC_ENABLE Ā Ā Ā Ā = Ā 'enable';
Ā NC_DISABLE Ā Ā Ā Ā = Ā 'disable';
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
// Ā Types
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
type
Ā ENetConnections Ā = Ā class(Exception);
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
// Ā Resource strings
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
resourcestring
Ā resAquire Ā Ā Ā Ā = Ā 'Failed to aquire the "Network Connections" shell folder interface';
Ā resLoaded Ā Ā Ā Ā = Ā 'The network collection item has not been loaded';
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
// Ā TPidlList
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
type
Ā TPidlList Ā Ā Ā Ā = Ā class(TObject)
Ā private
Ā Ā Ā // Private declarations
Ā Ā Ā FList: Ā Ā Ā Ā TList;
Ā protected
Ā Ā Ā // Protected declarations
Ā Ā Ā function Ā Ā Ā GetCount: Integer;
Ā Ā Ā function Ā Ā Ā GetItems(Index: Integer): PItemIDList;
Ā Ā Ā procedure Ā Ā Ā LoadFolder(Folder: IShellFolder);
Ā public
Ā Ā Ā // Public declarations
Ā Ā Ā constructor Ā Ā Create(Folder: IShellFolder);
Ā Ā Ā destructor Ā Ā Destroy; override;
Ā Ā Ā procedure Ā Ā Ā Clear;
Ā public
Ā Ā Ā // Public properties
Ā Ā Ā property Ā Ā Ā Count: Integer read GetCount;
Ā Ā Ā property Ā Ā Ā Items[Index: Integer]: PItemIDList read GetItems; default;
Ā end;
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
// Ā TNetConnection
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
type
Ā TNetConnection Ā Ā = Ā class(TCollectionItem)
Ā private
Ā Ā Ā // Private declarations
Ā Ā Ā FFolder: Ā Ā Ā IShellFolder;
Ā Ā Ā FItem: Ā Ā Ā Ā PItemIDList;
Ā Ā Ā function Ā Ā Ā ExecuteVerb(Verb: Word): HResult;
Ā Ā Ā function Ā Ā Ā GetVerbID(Verb: String; out ID: Integer): Boolean;
Ā protected
Ā Ā Ā // Protected declarations
Ā Ā Ā procedure Ā Ā Ā CheckLoaded;
Ā Ā Ā function Ā Ā Ā GetName: String;
Ā Ā Ā procedure Ā Ā Ā Load(Folder: IShellFolder; Item: PItemIDList);
Ā public
Ā Ā Ā // Public declarations
Ā Ā Ā constructor Ā Ā Create(Collection: TCollection); override;
Ā Ā Ā destructor Ā Ā Destroy; override;
Ā Ā Ā function Ā Ā Ā Connect: HResult;
Ā Ā Ā function Ā Ā Ā Disconnect: HResult;
Ā public
Ā Ā Ā // Public properties
Ā Ā Ā property Ā Ā Ā Name: String read GetName;
Ā end;
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
// Ā TNetConnections
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
type
Ā TNetConnections Ā = Ā class(TCollection)
Ā private
Ā Ā Ā // Private declarations
Ā Ā Ā FConnections: Ā TPidlList;
Ā Ā Ā FFolder: Ā Ā Ā IShellFolder;
Ā Ā Ā function Ā Ā Ā GetItem(Index: Integer): TNetConnection;
Ā Ā Ā procedure Ā Ā Ā SetItem(Index: Integer; Value: TNetConnection);
Ā protected
Ā Ā Ā // Protected declarations
Ā Ā Ā procedure Ā Ā Ā Load;
Ā public
Ā Ā Ā // Public declarations
Ā Ā Ā constructor Ā Ā Create;
Ā Ā Ā destructor Ā Ā Destroy; override;
Ā public
Ā Ā Ā // Public properties
Ā Ā Ā property Ā Ā Ā Items[Index: Integer]: TNetConnection read GetItem write SetItem; default;
Ā end;
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
// Ā Utility functions
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
function Ā GetNetworkFolder(out NetworkFolder: IShellFolder): Boolean;
function Ā CopyPIDL(Item: PItemIDList): PItemIDList;
function Ā CreatePIDL(Size: Integer): PItemIDList;
function Ā GetNextPIDL(Item: PItemIDList): PItemIDList;
function Ā GetPIDLSize(Item: PItemIDList): Integer;
function Ā StrRetToStr(StrRet: TStrRet): String;
procedure Ā StrRetFree(StrRet: TStrRet);
function Ā StripAccel(Str: PChar): PChar;
implementation
//// TNetConnection ////////////////////////// ////////// ////////// ////////// ////
constructor TNetConnection.Create(Coll ection: TCollection);
begin
Ā // Perform inherited
Ā inherited Create(Collection);
Ā // Set starting defaults
Ā FFolder:=nil;
Ā FItem:=nil;
end;
destructor TNetConnection.Destroy;
begin
Ā // Resource protection
Ā try
Ā Ā Ā // Free memory
Ā Ā Ā CoTaskMemFree(FItem);
Ā Ā Ā // Release the interface
Ā Ā Ā FFolder:=nil;
Ā finally
Ā Ā Ā // Perform inherited
Ā Ā Ā inherited Destroy;
Ā end;
end;
procedure TNetConnection.Load(Folder : IShellFolder; Item: PItemIDList);
begin
Ā // Persist the passed values
Ā FFolder:=Folder;
Ā FItem:=CopyPidl(Item);
end;
procedure TNetConnection.CheckLoaded ;
begin
Ā // Determine if we are in a loaded state, raise exception if not
Ā if (FFolder = nil) or (FItem = nil) then raise ENetConnections.CreateRes( @resLoaded );
end;
function TNetConnection.Connect: HResult;
var Ā dwEnable: Ā Ā Ā Integer;
begin
Ā // Get the enable id
Ā if GetVerbID(NC_ENABLE, dwEnable) then
Ā Ā Ā // Perform the connect
Ā Ā Ā result:=ExecuteVerb(dwEnab le)
Ā else
Ā begin
Ā Ā Ā {$IFDEF DEBUG}
Ā Ā Ā MessageBox(0, 'Failed to get the ID for the Enable verb', nil, MB_OK);
Ā Ā Ā {$ENDIF}
Ā Ā Ā // Failed to get the id
Ā Ā Ā result:=S_FALSE;
Ā end;
end;
function TNetConnection.Disconnect: HResult;
var Ā dwDisable: Ā Ā Integer;
begin
Ā // Get the disable id
Ā if GetVerbID(NC_DISABLE, dwDisable) then
Ā Ā Ā // Perform the connect
Ā Ā Ā result:=ExecuteVerb(dwDisa ble)
Ā else
Ā begin
Ā Ā Ā {$IFDEF DEBUG}
Ā Ā Ā MessageBox(0, 'Failed to get the ID for the Disable verb', nil, MB_OK);
Ā Ā Ā {$ENDIF}
Ā Ā Ā // Failed to get the id
Ā Ā Ā result:=S_FALSE;
Ā end;
end;
function TNetConnection.GetVerbID(V erb: String; out ID: Integer): Boolean;
var Ā pvCtxMenu: Ā Ā IContextMenu;
Ā Ā Ā lpszVerb: Ā Ā Ā Array [0..MAX_PATH] of Char;
Ā Ā Ā hPopup: Ā Ā Ā Ā HMENU;
Ā Ā Ā dwIndex: Ā Ā Ā Integer;
begin
Ā // Set default result
Ā result:=False;
Ā // Check loaded state
Ā CheckLoaded;
Ā // Query for the conext menu
Ā if (FFolder.GetUIObjectOf(App lication.H andle, 1, FItem, IContextMenu, nil, pvCtxMenu) = S_OK) then
Ā begin
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Create popup menu
Ā Ā Ā Ā hPopup:=CreatePopupMenu;
Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā // Fill in the popup menu from the context menu
Ā Ā Ā Ā Ā Ā if Succeeded(pvCtxMenu.QueryC ontextMenu (hPopup, 0, 0, MaxInt, CMF_VERBSONLY)) then
Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā // Walk the menu
Ā Ā Ā Ā Ā Ā Ā for dwIndex:=0 to Pred(GetMenuItemCount(hPop up)) do
Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Get the menu item string
Ā Ā Ā Ā Ā Ā Ā Ā Ā lpszVerb[GetMenuString(hPo pup, dwIndex, @lpszVerb, MAX_PATH, MF_BYPOSITION)]:=#0;
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Check string
Ā Ā Ā Ā Ā Ā Ā Ā Ā if (lpszVerb[0] >Ā #0) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Strip the accel chars
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā StripAccel(@lpszVerb);
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Check against passed verb
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if (StrIComp(Pointer(Verb), @lpszVerb) = 0) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Found a match, the the id
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā ID:=GetMenuItemID(hPopup, dwIndex);
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Success
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā result:=True;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Done processing
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā break;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā // Destroy the menu
Ā Ā Ā Ā Ā Ā DestroyMenu(hPopup);
Ā Ā Ā Ā end;
Ā Ā Ā finally
Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā pvCtxMenu:=nil;
Ā Ā Ā end;
Ā end;
end;
function TNetConnection.ExecuteVerb (Verb: Word): HResult;
var Ā lpCmd: Ā Ā Ā Ā TCMInvokeCommandInfo;
Ā Ā Ā pvCtxMenu: Ā Ā IContextMenu;
Ā Ā Ā dwMark: Ā Ā Ā Ā LongWord;
begin
Ā {$IFDEF DEBUG}
Ā MessageBox(0, PCHar(Format('ID to execute: %d', [Verb])), nil, MB_OK);
Ā {$ENDIF}
Ā // Check loaded state
Ā CheckLoaded;
Ā // Query for the conext menu
Ā result:=FFolder.GetUIObjec tOf(Applic ation.Hand le, 1, FItem, IContextMenu, nil, pvCtxMenu);
Ā // Check for success
Ā if Succeeded(result) then
Ā begin
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Clear the struct
Ā Ā Ā Ā FillChar(lpCmd, SizeOf(TCMInvokeCommandInf o), 0);
Ā Ā Ā Ā // Setup the command info struct
Ā Ā Ā Ā lpCmd.cbSize:=SizeOf(TCMIn vokeComman dInfo);
Ā Ā Ā Ā lpCmd.hwnd:=Application.Ha ndle;
Ā Ā Ā Ā lpCmd.lpVerb:=MakeIntResou rce(Verb);
Ā Ā Ā Ā lpCmd.nShow:=SW_SHOW;
Ā Ā Ā Ā // Execute
Ā Ā Ā Ā if (pvCtxMenu.InvokeCommand(l pCmd) = S_OK) then
Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā // Determine time to wait
Ā Ā Ā Ā Ā Ā dwMark:=GetTickCount + 5000;
Ā Ā Ā Ā Ā Ā // Spin message loop
Ā Ā Ā Ā Ā Ā while (dwMark >Ā GetTickCount) do
Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā // Process messages
Ā Ā Ā Ā Ā Ā Ā Application.ProcessMessage s;
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā end;
Ā Ā Ā finally
Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā pvCtxMenu:=nil;
Ā Ā Ā end;
Ā end;
end;
function TNetConnection.GetName: String;
var Ā lpName: Ā Ā Ā Ā TStrRet;
begin
Ā // Check loaded state
Ā CheckLoaded;
Ā // Get display name
Ā if (FFolder.GetDisplayNameOf( FItem, SHGDN_NORMAL or SHGDN_INFOLDER, lpName) = S_OK) then
Ā begin
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Return the name
Ā Ā Ā Ā result:=StrRetToStr(lpName );
Ā Ā Ā finally
Ā Ā Ā Ā // Free string memory
Ā Ā Ā Ā StrRetFree(lpName);
Ā Ā Ā end;
Ā end
Ā else
Ā Ā Ā // Failed to get name
Ā Ā Ā SetLength(result, 0);
end;
//// TNetConnections ////////////////////////// ////////// ////////// ////////// ///
constructor TNetConnections.Create;
begin
Ā // Perform inherited
Ā inherited Create(TNetConnection);
Ā // Aquire the network connections folder
Ā if not(GetNetworkFolder(FFold er)) then
Ā Ā Ā // Raise exception
Ā Ā Ā raise ENetConnections.CreateRes( @resAquire )
Ā else
Ā begin
Ā Ā Ā // Create pidl list from folder
Ā Ā Ā FConnections:=TPidlList.Cr eate(FFold er);
Ā Ā Ā // Load network connections from pidl
Ā Ā Ā Load;
Ā end;
end;
destructor TNetConnections.Destroy;
begin
Ā // Resource protection
Ā try
Ā Ā Ā // Release the interface
Ā Ā Ā FFolder:=nil;
Ā Ā Ā // Free connection list
Ā Ā Ā FConnections.Free;
Ā finally
Ā Ā Ā // Perform inherited
Ā Ā Ā inherited Destroy;
Ā end;
end;
function TNetConnections.GetItem(In dex: Integer): TNetConnection;
begin
Ā // Get the item at index
Ā result:=TNetConnection(inh erited GetItem(Index));
end;
procedure TNetConnections.SetItem(In dex: Integer; Value: TNetConnection);
begin
Ā // Set the item at index
Ā inherited SetItem(Index, Value);
end;
procedure TNetConnections.Load;
var Ā dwIndex: Ā Ā Ā Integer;
begin
Ā // Perform inherited clear;
Ā inherited Clear;
Ā // Walk the connection list and add the collection items
Ā for dwIndex:=0 to Pred(FConnections.Count) do
Ā begin
Ā Ā Ā // Perform the add and load
Ā Ā Ā TNetConnection(inherited Add).Load(FFolder, FConnections[dwIndex]);
Ā end;
end;
//// TPidlList ////////////////////////// ////////// ////////// ////////// /////////
constructor TPidlList.Create(Folder: IShellFolder);
begin
Ā // Perform inherited
Ā inherited Create;
Ā // Initial defaults
Ā FList:=TList.Create;
Ā // Load the list from the folder
Ā LoadFolder(Folder);
end;
destructor TPidlList.Destroy;
begin
Ā // Resource protection
Ā try
Ā Ā Ā // Clear the list
Ā Ā Ā Clear;
Ā Ā Ā // Free the lists
Ā Ā Ā FList.Free;
Ā finally
Ā Ā Ā // Perform inherited
Ā Ā Ā inherited Destroy;
Ā end;
end;
function TPidlList.GetCount: Integer;
begin
Ā // Return count of pidls
Ā result:=FList.Count;
end;
function TPidlList.GetItems(Index: Integer): PItemIDList;
begin
Ā // Return the pidl at the specified index
Ā result:=PItemIDList(FList[ Index]);
end;
procedure TPidlList.LoadFolder(Folde r: IShellFolder);
var Ā pvEnumList: Ā Ā Ā IEnumIDList;
Ā Ā Ā pidlItem: Ā Ā Ā Ā PItemIDList;
Ā Ā Ā cbCount: Ā Ā Ā Ā Ā Cardinal;
begin
Ā // Clear the list
Ā Clear;
Ā // Check folder interface
Ā if Assigned(Folder) then
Ā begin
Ā Ā Ā // Get enumerator
Ā Ā Ā if (Folder.EnumObjects(Applic ation.Hand le, SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN, pvEnumList) = S_OK) then
Ā Ā Ā begin
Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā // Enumerate items
Ā Ā Ā Ā Ā Ā while (pvEnumList.Next(1, pidlItem, cbCount) = S_OK) do
Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā // Add item to the list
Ā Ā Ā Ā Ā Ā Ā FList.Add(pidlItem);
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā pvEnumList:=nil;
Ā Ā Ā Ā end;
Ā Ā Ā end;
Ā end;
end;
procedure TPidlList.Clear;
var Ā dwIndex: Ā Ā Ā Integer;
begin
Ā // Resource protection
Ā try
Ā Ā Ā // Walk the list and free the pidls
Ā Ā Ā for dwIndex:=Pred(FList.Count) downto 0 do CoTaskMemFree(FList[dwInde x]);
Ā finally
Ā Ā Ā // Clear the list
Ā Ā Ā FList.Clear;
Ā end;
end;
//// Utility functions ////////////////////////// ////////// ////////// ////////// /
function StripAccel(Str: PChar): PChar;
var Ā lpszParse: Ā Ā PChar;
begin
Ā // Set result
Ā result:=Str;
Ā // Set parse point
Ā lpszParse:=Str;
Ā // Resource protection
Ā try
Ā Ā Ā // Strip &Ā accel from the string
Ā Ā Ā while (Str^ >Ā #0) do
Ā Ā Ā begin
Ā Ā Ā Ā // Check char
Ā Ā Ā Ā if (Str^ = '&') then
Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā // Check next char
Ā Ā Ā Ā Ā Ā if (Str[1] = '&') then
Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā // Copy char
Ā Ā Ā Ā Ā Ā Ā lpszParse^:=Str^;
Ā Ā Ā Ā Ā Ā Ā // Push parse point
Ā Ā Ā Ā Ā Ā Ā Inc(lpszParse);
Ā Ā Ā Ā Ā Ā Ā // Increment the string
Ā Ā Ā Ā Ā Ā Ā Inc(Str);
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā end
Ā Ā Ā Ā else
Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā // Copy char
Ā Ā Ā Ā Ā Ā lpszParse^:=Str^;
Ā Ā Ā Ā Ā Ā // Push parse point
Ā Ā Ā Ā Ā Ā Inc(lpszParse);
Ā Ā Ā Ā end;
Ā Ā Ā Ā // Increment string
Ā Ā Ā Ā Inc(Str);
Ā Ā Ā end;
Ā finally
Ā Ā Ā // Null terminate
Ā Ā Ā lpszParse^:=#0;
Ā end;
end;
function GetNetworkFolder(out NetworkFolder: IShellFolder): Boolean;
var Ā pvDesktop: Ā Ā Ā Ā IShellFolder;
Ā Ā Ā pvFolder: Ā Ā Ā Ā IShellFolder;
Ā Ā Ā pvEnumItems: Ā Ā Ā IEnumIDList;
Ā Ā Ā pidlCtrlPanel: Ā Ā PItemIDList;
Ā Ā Ā pidlItem: Ā Ā Ā Ā PItemIDList;
Ā Ā Ā cbCount: Ā Ā Ā Ā Ā Cardinal;
Ā Ā Ā lpValue: Ā Ā Ā Ā Ā TStrRet;
begin
Ā // Clear outbound interface
Ā NetworkFolder:=nil;
Ā // Resource protection
Ā try
Ā Ā Ā // Get desktop folder
Ā Ā Ā if (SHGetDesktopFolder(pvDesk top) = S_OK) then
Ā Ā Ā begin
Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā // Get control panel pidl
Ā Ā Ā Ā Ā Ā if (SHGetSpecialFolderLocatio n(Applicat ion.Handle , CSIDL_CONTROLS, pidlCtrlPanel) = S_OK) then
Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Bind to folder interface
Ā Ā Ā Ā Ā Ā Ā Ā Ā if (pvDesktop.BindToObject(pi dlCtrlPane l, nil, IID_IShellFolder, pvFolder) = S_OK) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Locate the folder for "Network Connections"
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if (pvFolder.EnumObjects(0, SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN, pvEnumItems) = S_OK) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Enumerate items
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā while (pvEnumItems.Next(1, pidlItem, cbCount) = S_OK) do
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Get parse name of pidl
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if (pvFolder.GetDisplayNameOf (pidlItem, SHGDN_FORPARSING or SHGDN_INFOLDER, lpValue) = S_OK) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Check for ::{7007ACC7-3202-11D1-AAD2 -00805FC12 70E}
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if (CompareText(StrRetToStr(l pValue), NC_ROOT) = 0) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Bind to folder interface
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if not(pvFolder.BindToObject( pidlItem, nil, IShellFolder, NetworkFolder) = S_OK) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Make sure interface is cleared
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā NetworkFolder:=nil;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Done processing either way
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā break;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Free string memory
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā StrRetFree(lpValue);
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Free the pidl
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā CoTaskMemFree(pidlItem);
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā pvEnumItems:=nil;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā pvFolder:=nil;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Free the pidl
Ā Ā Ā Ā Ā Ā Ā Ā Ā CoTaskMemFree(pidlCtrlPane l);
Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā pvDesktop:=nil;
Ā Ā Ā Ā end;
Ā Ā Ā end;
Ā finally
Ā Ā Ā // Success if we obtained the folder interface
Ā Ā Ā result:=Assigned(NetworkFo lder);
Ā end;
end;
procedure StrRetFree(StrRet: TStrRet);
begin
Ā // Check the type
Ā if (StrRet.uType = STRRET_WSTR) then
Ā begin
Ā Ā Ā // Free the string memory
Ā Ā Ā CoTaskMemFree(StrRet.pOleS tr);
Ā end;
end;
function StrRetToStr(StrRet: TStrRet): String;
begin
Ā // Check the type
Ā case StrRet.uType of
Ā Ā Ā // C type string
Ā Ā Ā STRRET_CSTR Ā Ā : Ā SetString(result, StrRet.cStr, lstrlen(StrRet.cStr));
Ā Ā Ā // String offset
Ā Ā Ā STRRET_OFFSET Ā : Ā SetLength(result, 0);
Ā Ā Ā // WideString
Ā Ā Ā STRRET_WSTR Ā Ā : Ā result:=StrRet.pOleStr;
Ā else
Ā Ā Ā // Sanity check
Ā Ā Ā SetLength(result, 0);
Ā end;
end;
function CreatePIDL(Size: Integer): PItemIDList;
begin
Ā // Allocate memory
Ā result:=CoTaskMemAlloc(Siz e);
end;
function GetNextPIDL(Item: PItemIDList): PItemIDList;
begin
Ā // Check for valid item
Ā if Assigned(Item) then
Ā begin
Ā Ā Ā // Get the size of the specified item identifier.
Ā Ā Ā if (Item^.mkid.cb Ā = 0) then
Ā Ā Ā Ā // No more items
Ā Ā Ā Ā result:=nil
Ā Ā Ā else
Ā Ā Ā begin
Ā Ā Ā Ā // Add cb to pidl (casting to increment by bytes).
Ā Ā Ā Ā Inc(PChar(Item), Item^.mkid.cb);
Ā Ā Ā Ā // Check for null
Ā Ā Ā Ā if (Item^.mkid.cb = 0) then
Ā Ā Ā Ā Ā Ā // No further items
Ā Ā Ā Ā Ā Ā result:=nil
Ā Ā Ā Ā else
Ā Ā Ā Ā Ā Ā // Return next item
Ā Ā Ā Ā Ā Ā result:=Item;
Ā Ā Ā end;
Ā end
Ā else
Ā Ā Ā // No item
Ā Ā Ā result:=nil;
end;
function GetPIDLSize(Item: PItemIDList): Integer;
begin
Ā // Default result
Ā result:=0;
Ā // Check item
Ā if Assigned(Item) then
Ā begin
Ā Ā Ā // Get base size (null terminator)
Ā Ā Ā Inc(result, SizeOf(Item^.mkid.cb));
Ā Ā Ā // While we have the pidl
Ā Ā Ā while Assigned(Item) do
Ā Ā Ā begin
Ā Ā Ā Ā // Update by current pidl size
Ā Ā Ā Ā Inc(result, Item^.mkid.cb);
Ā Ā Ā Ā // Get next pidl
Ā Ā Ā Ā Item:=GetNextPIDL(Item);
Ā Ā Ā end;
Ā end;
end;
function CopyPIDL(Item: PItemIDList): PItemIDList;
var Ā dwSize: Ā Ā Ā Ā Integer;
begin
Ā // Get total pidl size
Ā dwSize:=GetPIDLSize(Item);
Ā // Create new pidl
Ā result:=CreatePIDL(dwSize) ;
Ā // Check result, move data into new pidl
Ā if Assigned(result) then Move(Item^, result^, dwSize);
end;
end.
unit NetConnections;
//////////////////////////
//
// Ā Unit Ā Ā Ā Ā : Ā NetConnections
// Ā Author Ā Ā Ā : Ā rllibby
// Ā Date Ā Ā Ā Ā : Ā 06.12.2007
// Ā Description : Ā Shell (COM) based mechanism for enabling / disabling the
// Ā Ā Ā Ā Ā Ā Ā Ā Ā network connections on a PC.
//
//////////////////////////
interface
//////////////////////////
// Ā Conditionals for testing
//////////////////////////
{$DEFINE DEBUG}
//////////////////////////
// Ā Include units
//////////////////////////
uses
Ā Windows, SysUtils, Classes, Forms, ComObj, ActiveX, ShlObj;
//////////////////////////
// Ā Constants
//////////////////////////
const
Ā NC_ROOT Ā Ā Ā Ā Ā = Ā '::{7007ACC7-3202-11D1-AAD
Ā NC_ENABLE Ā Ā Ā Ā = Ā 'enable';
Ā NC_DISABLE Ā Ā Ā Ā = Ā 'disable';
//////////////////////////
// Ā Types
//////////////////////////
type
Ā ENetConnections Ā = Ā class(Exception);
//////////////////////////
// Ā Resource strings
//////////////////////////
resourcestring
Ā resAquire Ā Ā Ā Ā = Ā 'Failed to aquire the "Network Connections" shell folder interface';
Ā resLoaded Ā Ā Ā Ā = Ā 'The network collection item has not been loaded';
//////////////////////////
// Ā TPidlList
//////////////////////////
type
Ā TPidlList Ā Ā Ā Ā = Ā class(TObject)
Ā private
Ā Ā Ā // Private declarations
Ā Ā Ā FList: Ā Ā Ā Ā TList;
Ā protected
Ā Ā Ā // Protected declarations
Ā Ā Ā function Ā Ā Ā GetCount: Integer;
Ā Ā Ā function Ā Ā Ā GetItems(Index: Integer): PItemIDList;
Ā Ā Ā procedure Ā Ā Ā LoadFolder(Folder: IShellFolder);
Ā public
Ā Ā Ā // Public declarations
Ā Ā Ā constructor Ā Ā Create(Folder: IShellFolder);
Ā Ā Ā destructor Ā Ā Destroy; override;
Ā Ā Ā procedure Ā Ā Ā Clear;
Ā public
Ā Ā Ā // Public properties
Ā Ā Ā property Ā Ā Ā Count: Integer read GetCount;
Ā Ā Ā property Ā Ā Ā Items[Index: Integer]: PItemIDList read GetItems; default;
Ā end;
//////////////////////////
// Ā TNetConnection
//////////////////////////
type
Ā TNetConnection Ā Ā = Ā class(TCollectionItem)
Ā private
Ā Ā Ā // Private declarations
Ā Ā Ā FFolder: Ā Ā Ā IShellFolder;
Ā Ā Ā FItem: Ā Ā Ā Ā PItemIDList;
Ā Ā Ā function Ā Ā Ā ExecuteVerb(Verb: Word): HResult;
Ā Ā Ā function Ā Ā Ā GetVerbID(Verb: String; out ID: Integer): Boolean;
Ā protected
Ā Ā Ā // Protected declarations
Ā Ā Ā procedure Ā Ā Ā CheckLoaded;
Ā Ā Ā function Ā Ā Ā GetName: String;
Ā Ā Ā procedure Ā Ā Ā Load(Folder: IShellFolder; Item: PItemIDList);
Ā public
Ā Ā Ā // Public declarations
Ā Ā Ā constructor Ā Ā Create(Collection: TCollection); override;
Ā Ā Ā destructor Ā Ā Destroy; override;
Ā Ā Ā function Ā Ā Ā Connect: HResult;
Ā Ā Ā function Ā Ā Ā Disconnect: HResult;
Ā public
Ā Ā Ā // Public properties
Ā Ā Ā property Ā Ā Ā Name: String read GetName;
Ā end;
//////////////////////////
// Ā TNetConnections
//////////////////////////
type
Ā TNetConnections Ā = Ā class(TCollection)
Ā private
Ā Ā Ā // Private declarations
Ā Ā Ā FConnections: Ā TPidlList;
Ā Ā Ā FFolder: Ā Ā Ā IShellFolder;
Ā Ā Ā function Ā Ā Ā GetItem(Index: Integer): TNetConnection;
Ā Ā Ā procedure Ā Ā Ā SetItem(Index: Integer; Value: TNetConnection);
Ā protected
Ā Ā Ā // Protected declarations
Ā Ā Ā procedure Ā Ā Ā Load;
Ā public
Ā Ā Ā // Public declarations
Ā Ā Ā constructor Ā Ā Create;
Ā Ā Ā destructor Ā Ā Destroy; override;
Ā public
Ā Ā Ā // Public properties
Ā Ā Ā property Ā Ā Ā Items[Index: Integer]: TNetConnection read GetItem write SetItem; default;
Ā end;
//////////////////////////
// Ā Utility functions
//////////////////////////
function Ā GetNetworkFolder(out NetworkFolder: IShellFolder): Boolean;
function Ā CopyPIDL(Item: PItemIDList): PItemIDList;
function Ā CreatePIDL(Size: Integer): PItemIDList;
function Ā GetNextPIDL(Item: PItemIDList): PItemIDList;
function Ā GetPIDLSize(Item: PItemIDList): Integer;
function Ā StrRetToStr(StrRet: TStrRet): String;
procedure Ā StrRetFree(StrRet: TStrRet);
function Ā StripAccel(Str: PChar): PChar;
implementation
//// TNetConnection //////////////////////////
constructor TNetConnection.Create(Coll
begin
Ā // Perform inherited
Ā inherited Create(Collection);
Ā // Set starting defaults
Ā FFolder:=nil;
Ā FItem:=nil;
end;
destructor TNetConnection.Destroy;
begin
Ā // Resource protection
Ā try
Ā Ā Ā // Free memory
Ā Ā Ā CoTaskMemFree(FItem);
Ā Ā Ā // Release the interface
Ā Ā Ā FFolder:=nil;
Ā finally
Ā Ā Ā // Perform inherited
Ā Ā Ā inherited Destroy;
Ā end;
end;
procedure TNetConnection.Load(Folder
begin
Ā // Persist the passed values
Ā FFolder:=Folder;
Ā FItem:=CopyPidl(Item);
end;
procedure TNetConnection.CheckLoaded
begin
Ā // Determine if we are in a loaded state, raise exception if not
Ā if (FFolder = nil) or (FItem = nil) then raise ENetConnections.CreateRes(
end;
function TNetConnection.Connect: HResult;
var Ā dwEnable: Ā Ā Ā Integer;
begin
Ā // Get the enable id
Ā if GetVerbID(NC_ENABLE, dwEnable) then
Ā Ā Ā // Perform the connect
Ā Ā Ā result:=ExecuteVerb(dwEnab
Ā else
Ā begin
Ā Ā Ā {$IFDEF DEBUG}
Ā Ā Ā MessageBox(0, 'Failed to get the ID for the Enable verb', nil, MB_OK);
Ā Ā Ā {$ENDIF}
Ā Ā Ā // Failed to get the id
Ā Ā Ā result:=S_FALSE;
Ā end;
end;
function TNetConnection.Disconnect:
var Ā dwDisable: Ā Ā Integer;
begin
Ā // Get the disable id
Ā if GetVerbID(NC_DISABLE, dwDisable) then
Ā Ā Ā // Perform the connect
Ā Ā Ā result:=ExecuteVerb(dwDisa
Ā else
Ā begin
Ā Ā Ā {$IFDEF DEBUG}
Ā Ā Ā MessageBox(0, 'Failed to get the ID for the Disable verb', nil, MB_OK);
Ā Ā Ā {$ENDIF}
Ā Ā Ā // Failed to get the id
Ā Ā Ā result:=S_FALSE;
Ā end;
end;
function TNetConnection.GetVerbID(V
var Ā pvCtxMenu: Ā Ā IContextMenu;
Ā Ā Ā lpszVerb: Ā Ā Ā Array [0..MAX_PATH] of Char;
Ā Ā Ā hPopup: Ā Ā Ā Ā HMENU;
Ā Ā Ā dwIndex: Ā Ā Ā Integer;
begin
Ā // Set default result
Ā result:=False;
Ā // Check loaded state
Ā CheckLoaded;
Ā // Query for the conext menu
Ā if (FFolder.GetUIObjectOf(App
Ā begin
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Create popup menu
Ā Ā Ā Ā hPopup:=CreatePopupMenu;
Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā // Fill in the popup menu from the context menu
Ā Ā Ā Ā Ā Ā if Succeeded(pvCtxMenu.QueryC
Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā // Walk the menu
Ā Ā Ā Ā Ā Ā Ā for dwIndex:=0 to Pred(GetMenuItemCount(hPop
Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Get the menu item string
Ā Ā Ā Ā Ā Ā Ā Ā Ā lpszVerb[GetMenuString(hPo
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Check string
Ā Ā Ā Ā Ā Ā Ā Ā Ā if (lpszVerb[0] >Ā #0) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Strip the accel chars
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā StripAccel(@lpszVerb);
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Check against passed verb
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if (StrIComp(Pointer(Verb), @lpszVerb) = 0) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Found a match, the the id
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā ID:=GetMenuItemID(hPopup, dwIndex);
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Success
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā result:=True;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Done processing
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā break;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā // Destroy the menu
Ā Ā Ā Ā Ā Ā DestroyMenu(hPopup);
Ā Ā Ā Ā end;
Ā Ā Ā finally
Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā pvCtxMenu:=nil;
Ā Ā Ā end;
Ā end;
end;
function TNetConnection.ExecuteVerb
var Ā lpCmd: Ā Ā Ā Ā TCMInvokeCommandInfo;
Ā Ā Ā pvCtxMenu: Ā Ā IContextMenu;
Ā Ā Ā dwMark: Ā Ā Ā Ā LongWord;
begin
Ā {$IFDEF DEBUG}
Ā MessageBox(0, PCHar(Format('ID to execute: %d', [Verb])), nil, MB_OK);
Ā {$ENDIF}
Ā // Check loaded state
Ā CheckLoaded;
Ā // Query for the conext menu
Ā result:=FFolder.GetUIObjec
Ā // Check for success
Ā if Succeeded(result) then
Ā begin
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Clear the struct
Ā Ā Ā Ā FillChar(lpCmd, SizeOf(TCMInvokeCommandInf
Ā Ā Ā Ā // Setup the command info struct
Ā Ā Ā Ā lpCmd.cbSize:=SizeOf(TCMIn
Ā Ā Ā Ā lpCmd.hwnd:=Application.Ha
Ā Ā Ā Ā lpCmd.lpVerb:=MakeIntResou
Ā Ā Ā Ā lpCmd.nShow:=SW_SHOW;
Ā Ā Ā Ā // Execute
Ā Ā Ā Ā if (pvCtxMenu.InvokeCommand(l
Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā // Determine time to wait
Ā Ā Ā Ā Ā Ā dwMark:=GetTickCount + 5000;
Ā Ā Ā Ā Ā Ā // Spin message loop
Ā Ā Ā Ā Ā Ā while (dwMark >Ā GetTickCount) do
Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā // Process messages
Ā Ā Ā Ā Ā Ā Ā Application.ProcessMessage
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā end;
Ā Ā Ā finally
Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā pvCtxMenu:=nil;
Ā Ā Ā end;
Ā end;
end;
function TNetConnection.GetName: String;
var Ā lpName: Ā Ā Ā Ā TStrRet;
begin
Ā // Check loaded state
Ā CheckLoaded;
Ā // Get display name
Ā if (FFolder.GetDisplayNameOf(
Ā begin
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Return the name
Ā Ā Ā Ā result:=StrRetToStr(lpName
Ā Ā Ā finally
Ā Ā Ā Ā // Free string memory
Ā Ā Ā Ā StrRetFree(lpName);
Ā Ā Ā end;
Ā end
Ā else
Ā Ā Ā // Failed to get name
Ā Ā Ā SetLength(result, 0);
end;
//// TNetConnections //////////////////////////
constructor TNetConnections.Create;
begin
Ā // Perform inherited
Ā inherited Create(TNetConnection);
Ā // Aquire the network connections folder
Ā if not(GetNetworkFolder(FFold
Ā Ā Ā // Raise exception
Ā Ā Ā raise ENetConnections.CreateRes(
Ā else
Ā begin
Ā Ā Ā // Create pidl list from folder
Ā Ā Ā FConnections:=TPidlList.Cr
Ā Ā Ā // Load network connections from pidl
Ā Ā Ā Load;
Ā end;
end;
destructor TNetConnections.Destroy;
begin
Ā // Resource protection
Ā try
Ā Ā Ā // Release the interface
Ā Ā Ā FFolder:=nil;
Ā Ā Ā // Free connection list
Ā Ā Ā FConnections.Free;
Ā finally
Ā Ā Ā // Perform inherited
Ā Ā Ā inherited Destroy;
Ā end;
end;
function TNetConnections.GetItem(In
begin
Ā // Get the item at index
Ā result:=TNetConnection(inh
end;
procedure TNetConnections.SetItem(In
begin
Ā // Set the item at index
Ā inherited SetItem(Index, Value);
end;
procedure TNetConnections.Load;
var Ā dwIndex: Ā Ā Ā Integer;
begin
Ā // Perform inherited clear;
Ā inherited Clear;
Ā // Walk the connection list and add the collection items
Ā for dwIndex:=0 to Pred(FConnections.Count) do
Ā begin
Ā Ā Ā // Perform the add and load
Ā Ā Ā TNetConnection(inherited Add).Load(FFolder, FConnections[dwIndex]);
Ā end;
end;
//// TPidlList //////////////////////////
constructor TPidlList.Create(Folder: IShellFolder);
begin
Ā // Perform inherited
Ā inherited Create;
Ā // Initial defaults
Ā FList:=TList.Create;
Ā // Load the list from the folder
Ā LoadFolder(Folder);
end;
destructor TPidlList.Destroy;
begin
Ā // Resource protection
Ā try
Ā Ā Ā // Clear the list
Ā Ā Ā Clear;
Ā Ā Ā // Free the lists
Ā Ā Ā FList.Free;
Ā finally
Ā Ā Ā // Perform inherited
Ā Ā Ā inherited Destroy;
Ā end;
end;
function TPidlList.GetCount: Integer;
begin
Ā // Return count of pidls
Ā result:=FList.Count;
end;
function TPidlList.GetItems(Index: Integer): PItemIDList;
begin
Ā // Return the pidl at the specified index
Ā result:=PItemIDList(FList[
end;
procedure TPidlList.LoadFolder(Folde
var Ā pvEnumList: Ā Ā Ā IEnumIDList;
Ā Ā Ā pidlItem: Ā Ā Ā Ā PItemIDList;
Ā Ā Ā cbCount: Ā Ā Ā Ā Ā Cardinal;
begin
Ā // Clear the list
Ā Clear;
Ā // Check folder interface
Ā if Assigned(Folder) then
Ā begin
Ā Ā Ā // Get enumerator
Ā Ā Ā if (Folder.EnumObjects(Applic
Ā Ā Ā begin
Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā // Enumerate items
Ā Ā Ā Ā Ā Ā while (pvEnumList.Next(1, pidlItem, cbCount) = S_OK) do
Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā // Add item to the list
Ā Ā Ā Ā Ā Ā Ā FList.Add(pidlItem);
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā pvEnumList:=nil;
Ā Ā Ā Ā end;
Ā Ā Ā end;
Ā end;
end;
procedure TPidlList.Clear;
var Ā dwIndex: Ā Ā Ā Integer;
begin
Ā // Resource protection
Ā try
Ā Ā Ā // Walk the list and free the pidls
Ā Ā Ā for dwIndex:=Pred(FList.Count)
Ā finally
Ā Ā Ā // Clear the list
Ā Ā Ā FList.Clear;
Ā end;
end;
//// Utility functions //////////////////////////
function StripAccel(Str: PChar): PChar;
var Ā lpszParse: Ā Ā PChar;
begin
Ā // Set result
Ā result:=Str;
Ā // Set parse point
Ā lpszParse:=Str;
Ā // Resource protection
Ā try
Ā Ā Ā // Strip &Ā accel from the string
Ā Ā Ā while (Str^ >Ā #0) do
Ā Ā Ā begin
Ā Ā Ā Ā // Check char
Ā Ā Ā Ā if (Str^ = '&') then
Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā // Check next char
Ā Ā Ā Ā Ā Ā if (Str[1] = '&') then
Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā // Copy char
Ā Ā Ā Ā Ā Ā Ā lpszParse^:=Str^;
Ā Ā Ā Ā Ā Ā Ā // Push parse point
Ā Ā Ā Ā Ā Ā Ā Inc(lpszParse);
Ā Ā Ā Ā Ā Ā Ā // Increment the string
Ā Ā Ā Ā Ā Ā Ā Inc(Str);
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā end
Ā Ā Ā Ā else
Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā // Copy char
Ā Ā Ā Ā Ā Ā lpszParse^:=Str^;
Ā Ā Ā Ā Ā Ā // Push parse point
Ā Ā Ā Ā Ā Ā Inc(lpszParse);
Ā Ā Ā Ā end;
Ā Ā Ā Ā // Increment string
Ā Ā Ā Ā Inc(Str);
Ā Ā Ā end;
Ā finally
Ā Ā Ā // Null terminate
Ā Ā Ā lpszParse^:=#0;
Ā end;
end;
function GetNetworkFolder(out NetworkFolder: IShellFolder): Boolean;
var Ā pvDesktop: Ā Ā Ā Ā IShellFolder;
Ā Ā Ā pvFolder: Ā Ā Ā Ā IShellFolder;
Ā Ā Ā pvEnumItems: Ā Ā Ā IEnumIDList;
Ā Ā Ā pidlCtrlPanel: Ā Ā PItemIDList;
Ā Ā Ā pidlItem: Ā Ā Ā Ā PItemIDList;
Ā Ā Ā cbCount: Ā Ā Ā Ā Ā Cardinal;
Ā Ā Ā lpValue: Ā Ā Ā Ā Ā TStrRet;
begin
Ā // Clear outbound interface
Ā NetworkFolder:=nil;
Ā // Resource protection
Ā try
Ā Ā Ā // Get desktop folder
Ā Ā Ā if (SHGetDesktopFolder(pvDesk
Ā Ā Ā begin
Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā // Get control panel pidl
Ā Ā Ā Ā Ā Ā if (SHGetSpecialFolderLocatio
Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Bind to folder interface
Ā Ā Ā Ā Ā Ā Ā Ā Ā if (pvDesktop.BindToObject(pi
Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Locate the folder for "Network Connections"
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if (pvFolder.EnumObjects(0, SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN, pvEnumItems) = S_OK) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Enumerate items
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā while (pvEnumItems.Next(1, pidlItem, cbCount) = S_OK) do
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Get parse name of pidl
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if (pvFolder.GetDisplayNameOf
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Check for ::{7007ACC7-3202-11D1-AAD2
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if (CompareText(StrRetToStr(l
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Bind to folder interface
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if not(pvFolder.BindToObject(
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Make sure interface is cleared
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā NetworkFolder:=nil;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Done processing either way
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā break;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Free string memory
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā StrRetFree(lpValue);
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Free the pidl
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā CoTaskMemFree(pidlItem);
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā pvEnumItems:=nil;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā pvFolder:=nil;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Free the pidl
Ā Ā Ā Ā Ā Ā Ā Ā Ā CoTaskMemFree(pidlCtrlPane
Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā pvDesktop:=nil;
Ā Ā Ā Ā end;
Ā Ā Ā end;
Ā finally
Ā Ā Ā // Success if we obtained the folder interface
Ā Ā Ā result:=Assigned(NetworkFo
Ā end;
end;
procedure StrRetFree(StrRet: TStrRet);
begin
Ā // Check the type
Ā if (StrRet.uType = STRRET_WSTR) then
Ā begin
Ā Ā Ā // Free the string memory
Ā Ā Ā CoTaskMemFree(StrRet.pOleS
Ā end;
end;
function StrRetToStr(StrRet: TStrRet): String;
begin
Ā // Check the type
Ā case StrRet.uType of
Ā Ā Ā // C type string
Ā Ā Ā STRRET_CSTR Ā Ā : Ā SetString(result, StrRet.cStr, lstrlen(StrRet.cStr));
Ā Ā Ā // String offset
Ā Ā Ā STRRET_OFFSET Ā : Ā SetLength(result, 0);
Ā Ā Ā // WideString
Ā Ā Ā STRRET_WSTR Ā Ā : Ā result:=StrRet.pOleStr;
Ā else
Ā Ā Ā // Sanity check
Ā Ā Ā SetLength(result, 0);
Ā end;
end;
function CreatePIDL(Size: Integer): PItemIDList;
begin
Ā // Allocate memory
Ā result:=CoTaskMemAlloc(Siz
end;
function GetNextPIDL(Item: PItemIDList): PItemIDList;
begin
Ā // Check for valid item
Ā if Assigned(Item) then
Ā begin
Ā Ā Ā // Get the size of the specified item identifier.
Ā Ā Ā if (Item^.mkid.cb Ā = 0) then
Ā Ā Ā Ā // No more items
Ā Ā Ā Ā result:=nil
Ā Ā Ā else
Ā Ā Ā begin
Ā Ā Ā Ā // Add cb to pidl (casting to increment by bytes).
Ā Ā Ā Ā Inc(PChar(Item), Item^.mkid.cb);
Ā Ā Ā Ā // Check for null
Ā Ā Ā Ā if (Item^.mkid.cb = 0) then
Ā Ā Ā Ā Ā Ā // No further items
Ā Ā Ā Ā Ā Ā result:=nil
Ā Ā Ā Ā else
Ā Ā Ā Ā Ā Ā // Return next item
Ā Ā Ā Ā Ā Ā result:=Item;
Ā Ā Ā end;
Ā end
Ā else
Ā Ā Ā // No item
Ā Ā Ā result:=nil;
end;
function GetPIDLSize(Item: PItemIDList): Integer;
begin
Ā // Default result
Ā result:=0;
Ā // Check item
Ā if Assigned(Item) then
Ā begin
Ā Ā Ā // Get base size (null terminator)
Ā Ā Ā Inc(result, SizeOf(Item^.mkid.cb));
Ā Ā Ā // While we have the pidl
Ā Ā Ā while Assigned(Item) do
Ā Ā Ā begin
Ā Ā Ā Ā // Update by current pidl size
Ā Ā Ā Ā Inc(result, Item^.mkid.cb);
Ā Ā Ā Ā // Get next pidl
Ā Ā Ā Ā Item:=GetNextPIDL(Item);
Ā Ā Ā end;
Ā end;
end;
function CopyPIDL(Item: PItemIDList): PItemIDList;
var Ā dwSize: Ā Ā Ā Ā Integer;
begin
Ā // Get total pidl size
Ā dwSize:=GetPIDLSize(Item);
Ā // Create new pidl
Ā result:=CreatePIDL(dwSize)
Ā // Check result, move data into new pidl
Ā if Assigned(result) then Move(Item^, result^, dwSize);
end;
end.
ASKER
Russell,
Thanks a bunch! I will check it later tonight as I have been pulling fence and fence posts today.
I will also start another thread with another 500 points for you as that is the least I can do for your efforts in any event, later this evening.
I would have never thought enable/disable would be the key here in looking over it briefly.
You too are the man!
John
Thanks a bunch! I will check it later tonight as I have been pulling fence and fence posts today.
I will also start another thread with another 500 points for you as that is the least I can do for your efforts in any event, later this evening.
I would have never thought enable/disable would be the key here in looking over it briefly.
You too are the man!
John
John,
Your very welcome, and I hope you have some success with it. I'm out of ideas otherwise <lol>. As to the points, don't post another question because (a) its not allowed and (b) it really isn't necessary. I could care less about the points, and I only maintain enough to keep my "free" status (3K/Month). Plus, I enjoy questions such as these, as it is a good learning experience for both involved.
Let me know how it goes.
Russell
Your very welcome, and I hope you have some success with it. I'm out of ideas otherwise <lol>. As to the points, don't post another question because (a) its not allowed and (b) it really isn't necessary. I could care less about the points, and I only maintain enough to keep my "free" status (3K/Month). Plus, I enjoy questions such as these, as it is a good learning experience for both involved.
Let me know how it goes.
Russell
ASKER
Russell,
A bummer, but... no joy at all on 2K! Works fine on XP. The latest on 2K is 'Failed to acquire the "Network Connections" shell folder interface'
This popped up a time or two on XP as well but would work after a second click.
I really appreciate your work and assistance! At least I have a good method for XP and above. I'll test it on Vista when I get a chance too.
Thank-you Russell!
John
A bummer, but... no joy at all on 2K! Works fine on XP. The latest on 2K is 'Failed to acquire the "Network Connections" shell folder interface'
This popped up a time or two on XP as well but would work after a second click.
I really appreciate your work and assistance! At least I have a good method for XP and above. I'll test it on Vista when I get a chance too.
Thank-you Russell!
John
Sorry to hear that its not working. Did you have any luck with the other option? (Re-adding and attempt delete after the first attempt at Delete fails)
Russell
Russell
ASKER
I did enable the NIC manually then tried disabling through code if that is what you are speaking of, and tried the inverse as well. No joy....
I need to research why 2K is so different.... I can't image that being the case, but I have gone over what I am doing a million times and it is fine. I even tried a shotgun approach with a "for do" for all connections.
Interesting.
John
I need to research why 2K is so different.... I can't image that being the case, but I have gone over what I am doing a million times and it is fine. I even tried a shotgun approach with a "for do" for all connections.
Interesting.
John
No, I was talking about calling AddIpAddress then DeleteIPAddress if the call to DeleteIPAddress (or whatever your unit has declared the function as) fails.
ASKER
Oh... no I have not tried that yet as the address still exists after a disconnect and it just does not sound "logical" to me BUT, I will try that today!
I know some of the scripting sites mention the use of Shell.Application (exposed out of Shell32) in order to do the enabling/disabling. Below I Ā provided a small piece of code that uses this, and can be used to load a litsbox/memo etc with connection item names. Seems like it is just a wrapper over the IShellFolder interfaces, but you never know. Try calling GetConnections(...) passing it a TMemo.Lines / TListBox.Items / etc to see what you get.
Also, you are running the latest svc packs on these 2K boxes right?
---- start of code ----
interface
uses
Ā Windows, SysUtils, Classes, Forms, ComObj, ActiveX;
type
Ā IEnumerator Ā Ā Ā = Ā interface
Ā Ā Ā function Ā Ā Ā ForEach(out Obj: OleVariant): Boolean;
Ā Ā Ā function Ā Ā Ā ForEachObject(const IID: TGUID; out Obj): Boolean;
Ā Ā Ā function Ā Ā Ā Reset: Boolean;
Ā Ā Ā function Ā Ā Ā Skip(Count: LongWord): Boolean;
Ā Ā Ā function Ā Ā Ā Clone: IEnumerator;
Ā end;
Ā TEnumerator Ā Ā Ā = Ā class(TInterfacedObject, IEnumerator)
Ā private
Ā Ā Ā // Private declarations
Ā Ā Ā FEnumVariant: Ā IEnumVariant;
Ā Ā Ā procedure Ā Ā Ā GetEnumVariant(Dispatch: IDispatch);
Ā protected
Ā Ā Ā // Protected declarations
Ā Ā Ā function Ā Ā Ā ForEach(out Obj: OleVariant): Boolean;
Ā Ā Ā function Ā Ā Ā ForEachObject(const IID: TGUID; out Obj): Boolean;
Ā Ā Ā function Ā Ā Ā Reset: Boolean;
Ā Ā Ā function Ā Ā Ā Skip(Count: LongWord): Boolean;
Ā Ā Ā function Ā Ā Ā Clone: IEnumerator;
Ā public
Ā Ā Ā // Public declarations
Ā Ā Ā constructor Ā Ā Create(Dispatch: IDispatch);
Ā Ā Ā constructor Ā Ā CreateWrapper(EnumVariant: IEnumVariant);
Ā Ā Ā destructor Ā Ā Destroy; override;
Ā end;
function Ā GetOSFolderName: String;
function Ā GetConnections(List: TStrings): Integer;
implementation
function GetConnections(List: TStrings): Integer;
var Ā oShellApp: Ā Ā OleVariant;
Ā Ā Ā oFolder: Ā Ā Ā OleVariant;
Ā Ā Ā pvItems: Ā Ā Ā IEnumerator;
Ā Ā Ā pvConnections: IEnumerator;
Ā Ā Ā szFolder: Ā Ā Ā String;
begin
Ā // Check list
Ā if not(Assigned(List)) then
Ā Ā Ā // No list
Ā Ā Ā result:=(-1)
Ā else
Ā begin
Ā Ā Ā // Lock the list
Ā Ā Ā List.BeginUpdate;
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Clear the list
Ā Ā Ā Ā List.Clear;
Ā Ā Ā Ā // Create shell object
Ā Ā Ā Ā oShellApp:=CreateOleObject ('Shell.Ap plication' );
Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā // Get desired folder name
Ā Ā Ā Ā Ā Ā szFolder:=GetOSFolderName;
Ā Ā Ā Ā Ā Ā // Get enumerator for the control panel folder
Ā Ā Ā Ā Ā Ā pvItems:=TEnumerator.Creat e(oShellAp p.NameSpac e(3).Items );
Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā // Iterate the items
Ā Ā Ā Ā Ā Ā Ā while pvItems.ForEach(oFolder) do
Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Debugging
Ā Ā Ā Ā Ā Ā Ā Ā Ā MessageBox(0, PChar(String(oFolder.Name) ), nil, MB_OK);
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Check folder name against desired folder name
Ā Ā Ā Ā Ā Ā Ā Ā Ā if (CompareText(oFolder.Name, szFolder) = 0) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Get the network folder items
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā pvConnections:=TEnumerator .Create(oF older.GetF older.Item s);
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Iterate the connections
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā while pvConnections.ForEach(oFol der) do
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Add name to list
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā List.Add(oFolder.Name);
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā pvConnections:=nil;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Done processing
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā break;
Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā Ā pvItems:=nil;
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā // Clear variant
Ā Ā Ā Ā Ā Ā oShellApp:=Unassigned;
Ā Ā Ā Ā end;
Ā Ā Ā finally
Ā Ā Ā Ā // Unlock list
Ā Ā Ā Ā List.EndUpdate;
Ā Ā Ā end;
Ā Ā Ā // Return the count of items
Ā Ā Ā result:=List.Count;
Ā end;
end;
function GetOSFolderName: String;
var Ā lpVer: Ā Ā Ā Ā TOSVersionInfo;
begin
Ā // Set default result
Ā SetLength(result, 0);
Ā // Set size
Ā lpVer.dwOSVersionInfoSize: =SizeOf(lp Ver);
Ā // Get OS version
Ā if GetVersionEx(lpVer) then
Ā begin
Ā Ā Ā // Check major and minor
Ā Ā Ā if (lpVer.dwMajorVersion = 5) then
Ā Ā Ā begin
Ā Ā Ā Ā // Check minor version
Ā Ā Ā Ā if (lpVer.dwMinorVersion = 0) then
Ā Ā Ā Ā Ā Ā // Win 2000
Ā Ā Ā Ā Ā Ā result:='Network and Dial-up Connections'
Ā Ā Ā Ā else
Ā Ā Ā Ā Ā Ā // Win XP or up
Ā Ā Ā Ā Ā Ā result:='Network Connections';
Ā Ā Ā end;
Ā end;
end;
//// TEnumerator ////////////////////////// ////////// ////////// ////////// ///////
procedure TEnumerator.GetEnumVariant (Dispatch: IDispatch);
var Ā pdParams: Ā Ā Ā TDispParams;
Ā Ā Ā ovEnum: Ā Ā Ā Ā OleVariant;
begin
Ā // Check interface
Ā if Assigned(Dispatch) then
Ā begin
Ā Ā Ā // Clear disp params
Ā Ā Ā FillChar(pdParams, SizeOf(TDispParams), 0);
Ā Ā Ā // Get enumerator
Ā Ā Ā OleCheck(Dispatch.Invoke(D ISPID_NEWE NUM, GUID_NULL, LOCALE_SYSTEM_DEFAULT, DISPATCH_PROPERTYGET or DISPATCH_METHOD, pdParams, @ovEnum, nil, nil));
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Check returned interface
Ā Ā Ā Ā if (TVariantArg(ovEnum).vt = VT_UNKNOWN) then
Ā Ā Ā Ā Ā Ā // Query interface for the IEnumVariant
Ā Ā Ā Ā Ā Ā OleCheck(IUnknown(ovEnum). QueryInter face(IEnum Variant, FEnumVariant))
Ā Ā Ā Ā else
Ā Ā Ā Ā Ā Ā // Throw error
Ā Ā Ā Ā Ā Ā OleError(E_NOINTERFACE);
Ā Ā Ā finally
Ā Ā Ā Ā // Clear interface
Ā Ā Ā Ā ovEnum:=Unassigned;
Ā Ā Ā end;
Ā end
Ā else
Ā Ā Ā // Throw error
Ā Ā Ā OleError(E_NOINTERFACE);
end;
function TEnumerator.ForEach(out Obj: OleVariant): Boolean;
var Ā dwFetch: Ā Ā Ā Cardinal;
begin
Ā // Get the next item
Ā result:=(FEnumVariant.Next (1, Obj, dwFetch) = S_OK) and (dwFetch = 1);
end;
function TEnumerator.ForEachObject( const IID: TGUID; out Obj): Boolean;
var Ā ovItem: Ā Ā Ā Ā OleVariant;
begin
Ā // Get next item as OleVariant
Ā if ForEach(ovItem) then
Ā begin
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Check interface for IUknown
Ā Ā Ā Ā if (TVariantArg(ovItem).vt = VT_UNKNOWN) then
Ā Ā Ā Ā Ā Ā // Query interface for the desired interface
Ā Ā Ā Ā Ā Ā result:=(IUnknown(ovItem). QueryInter face(IID, Obj) = S_OK)
Ā Ā Ā Ā // Check interface for IDispatch
Ā Ā Ā Ā else if (TVariantArg(ovItem).vt = VT_DISPATCH) then
Ā Ā Ā Ā Ā Ā // Query interface for the desired interface
Ā Ā Ā Ā Ā Ā result:=(IDispatch(ovItem) .QueryInte rface(IID, Obj) = S_OK)
Ā Ā Ā Ā else
Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā // Pacify the compiler
Ā Ā Ā Ā Ā Ā result:=False;
Ā Ā Ā Ā Ā Ā // Throw error
Ā Ā Ā Ā Ā Ā OleError(E_NOINTERFACE);
Ā Ā Ā Ā end;
Ā Ā Ā finally
Ā Ā Ā Ā // Clear obtained item
Ā Ā Ā Ā ovItem:=Unassigned;
Ā Ā Ā end;
Ā end
Ā else
Ā Ā Ā // Failed to get item
Ā Ā Ā result:=False;
end;
function TEnumerator.Reset: Boolean;
begin
Ā // Reset enumerator
Ā result:=(FEnumVariant.Rese t = S_OK);
end;
function TEnumerator.Skip(Count: LongWord): Boolean;
begin
Ā // Skip items in enumerator
Ā result:=(FEnumVariant.Skip (Count) = S_OK);
end;
function TEnumerator.Clone: IEnumerator;
var Ā pvEnum: Ā Ā Ā Ā IEnumVariant;
begin
Ā // Clone
Ā if (FEnumVariant.Clone(pvEnum ) = S_OK) then
Ā begin
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Return wrapper
Ā Ā Ā Ā result:=TEnumerator.Create Wrapper(pv Enum);
Ā Ā Ā finally
Ā Ā Ā Ā // Release interface
Ā Ā Ā Ā pvEnum:=nil;
Ā Ā Ā end
Ā end
Ā else
Ā Ā Ā // Return nil
Ā Ā Ā result:=nil;
end;
constructor TEnumerator.CreateWrapper( EnumVarian t: IEnumVariant);
begin
Ā // Perform inherited
Ā inherited Create;
Ā // Check interface pointer
Ā if Assigned(EnumVariant) then
Ā Ā Ā // Bind to the passed interface
Ā Ā Ā FEnumVariant:=EnumVariant
Ā else
Ā Ā Ā // Throw error
Ā Ā Ā OleError(E_NOINTERFACE);
end;
constructor TEnumerator.Create(Dispatc h: IDispatch);
begin
Ā // Perform inherited
Ā inherited Create;
Ā // Get enumerator interface
Ā GetEnumVariant(Dispatch);
end;
destructor TEnumerator.Destroy;
begin
Ā // Resource protection
Ā try
Ā Ā Ā // Release the interface
Ā Ā Ā FEnumVariant:=nil;
Ā finally
Ā Ā Ā // Perform inherited
Ā Ā Ā inherited Destroy;
Ā end;
end;
end.
Also, you are running the latest svc packs on these 2K boxes right?
---- start of code ----
interface
uses
Ā Windows, SysUtils, Classes, Forms, ComObj, ActiveX;
type
Ā IEnumerator Ā Ā Ā = Ā interface
Ā Ā Ā function Ā Ā Ā ForEach(out Obj: OleVariant): Boolean;
Ā Ā Ā function Ā Ā Ā ForEachObject(const IID: TGUID; out Obj): Boolean;
Ā Ā Ā function Ā Ā Ā Reset: Boolean;
Ā Ā Ā function Ā Ā Ā Skip(Count: LongWord): Boolean;
Ā Ā Ā function Ā Ā Ā Clone: IEnumerator;
Ā end;
Ā TEnumerator Ā Ā Ā = Ā class(TInterfacedObject, IEnumerator)
Ā private
Ā Ā Ā // Private declarations
Ā Ā Ā FEnumVariant: Ā IEnumVariant;
Ā Ā Ā procedure Ā Ā Ā GetEnumVariant(Dispatch: IDispatch);
Ā protected
Ā Ā Ā // Protected declarations
Ā Ā Ā function Ā Ā Ā ForEach(out Obj: OleVariant): Boolean;
Ā Ā Ā function Ā Ā Ā ForEachObject(const IID: TGUID; out Obj): Boolean;
Ā Ā Ā function Ā Ā Ā Reset: Boolean;
Ā Ā Ā function Ā Ā Ā Skip(Count: LongWord): Boolean;
Ā Ā Ā function Ā Ā Ā Clone: IEnumerator;
Ā public
Ā Ā Ā // Public declarations
Ā Ā Ā constructor Ā Ā Create(Dispatch: IDispatch);
Ā Ā Ā constructor Ā Ā CreateWrapper(EnumVariant:
Ā Ā Ā destructor Ā Ā Destroy; override;
Ā end;
function Ā GetOSFolderName: String;
function Ā GetConnections(List: TStrings): Integer;
implementation
function GetConnections(List: TStrings): Integer;
var Ā oShellApp: Ā Ā OleVariant;
Ā Ā Ā oFolder: Ā Ā Ā OleVariant;
Ā Ā Ā pvItems: Ā Ā Ā IEnumerator;
Ā Ā Ā pvConnections: IEnumerator;
Ā Ā Ā szFolder: Ā Ā Ā String;
begin
Ā // Check list
Ā if not(Assigned(List)) then
Ā Ā Ā // No list
Ā Ā Ā result:=(-1)
Ā else
Ā begin
Ā Ā Ā // Lock the list
Ā Ā Ā List.BeginUpdate;
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Clear the list
Ā Ā Ā Ā List.Clear;
Ā Ā Ā Ā // Create shell object
Ā Ā Ā Ā oShellApp:=CreateOleObject
Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā // Get desired folder name
Ā Ā Ā Ā Ā Ā szFolder:=GetOSFolderName;
Ā Ā Ā Ā Ā Ā // Get enumerator for the control panel folder
Ā Ā Ā Ā Ā Ā pvItems:=TEnumerator.Creat
Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā // Iterate the items
Ā Ā Ā Ā Ā Ā Ā while pvItems.ForEach(oFolder) do
Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Debugging
Ā Ā Ā Ā Ā Ā Ā Ā Ā MessageBox(0, PChar(String(oFolder.Name)
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Check folder name against desired folder name
Ā Ā Ā Ā Ā Ā Ā Ā Ā if (CompareText(oFolder.Name,
Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Get the network folder items
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā pvConnections:=TEnumerator
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Iterate the connections
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā while pvConnections.ForEach(oFol
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Add name to list
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā List.Add(oFolder.Name);
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā pvConnections:=nil;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Done processing
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā break;
Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā Ā pvItems:=nil;
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā // Clear variant
Ā Ā Ā Ā Ā Ā oShellApp:=Unassigned;
Ā Ā Ā Ā end;
Ā Ā Ā finally
Ā Ā Ā Ā // Unlock list
Ā Ā Ā Ā List.EndUpdate;
Ā Ā Ā end;
Ā Ā Ā // Return the count of items
Ā Ā Ā result:=List.Count;
Ā end;
end;
function GetOSFolderName: String;
var Ā lpVer: Ā Ā Ā Ā TOSVersionInfo;
begin
Ā // Set default result
Ā SetLength(result, 0);
Ā // Set size
Ā lpVer.dwOSVersionInfoSize:
Ā // Get OS version
Ā if GetVersionEx(lpVer) then
Ā begin
Ā Ā Ā // Check major and minor
Ā Ā Ā if (lpVer.dwMajorVersion = 5) then
Ā Ā Ā begin
Ā Ā Ā Ā // Check minor version
Ā Ā Ā Ā if (lpVer.dwMinorVersion = 0) then
Ā Ā Ā Ā Ā Ā // Win 2000
Ā Ā Ā Ā Ā Ā result:='Network and Dial-up Connections'
Ā Ā Ā Ā else
Ā Ā Ā Ā Ā Ā // Win XP or up
Ā Ā Ā Ā Ā Ā result:='Network Connections';
Ā Ā Ā end;
Ā end;
end;
//// TEnumerator //////////////////////////
procedure TEnumerator.GetEnumVariant
var Ā pdParams: Ā Ā Ā TDispParams;
Ā Ā Ā ovEnum: Ā Ā Ā Ā OleVariant;
begin
Ā // Check interface
Ā if Assigned(Dispatch) then
Ā begin
Ā Ā Ā // Clear disp params
Ā Ā Ā FillChar(pdParams, SizeOf(TDispParams), 0);
Ā Ā Ā // Get enumerator
Ā Ā Ā OleCheck(Dispatch.Invoke(D
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Check returned interface
Ā Ā Ā Ā if (TVariantArg(ovEnum).vt = VT_UNKNOWN) then
Ā Ā Ā Ā Ā Ā // Query interface for the IEnumVariant
Ā Ā Ā Ā Ā Ā OleCheck(IUnknown(ovEnum).
Ā Ā Ā Ā else
Ā Ā Ā Ā Ā Ā // Throw error
Ā Ā Ā Ā Ā Ā OleError(E_NOINTERFACE);
Ā Ā Ā finally
Ā Ā Ā Ā // Clear interface
Ā Ā Ā Ā ovEnum:=Unassigned;
Ā Ā Ā end;
Ā end
Ā else
Ā Ā Ā // Throw error
Ā Ā Ā OleError(E_NOINTERFACE);
end;
function TEnumerator.ForEach(out Obj: OleVariant): Boolean;
var Ā dwFetch: Ā Ā Ā Cardinal;
begin
Ā // Get the next item
Ā result:=(FEnumVariant.Next
end;
function TEnumerator.ForEachObject(
var Ā ovItem: Ā Ā Ā Ā OleVariant;
begin
Ā // Get next item as OleVariant
Ā if ForEach(ovItem) then
Ā begin
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Check interface for IUknown
Ā Ā Ā Ā if (TVariantArg(ovItem).vt = VT_UNKNOWN) then
Ā Ā Ā Ā Ā Ā // Query interface for the desired interface
Ā Ā Ā Ā Ā Ā result:=(IUnknown(ovItem).
Ā Ā Ā Ā // Check interface for IDispatch
Ā Ā Ā Ā else if (TVariantArg(ovItem).vt = VT_DISPATCH) then
Ā Ā Ā Ā Ā Ā // Query interface for the desired interface
Ā Ā Ā Ā Ā Ā result:=(IDispatch(ovItem)
Ā Ā Ā Ā else
Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā // Pacify the compiler
Ā Ā Ā Ā Ā Ā result:=False;
Ā Ā Ā Ā Ā Ā // Throw error
Ā Ā Ā Ā Ā Ā OleError(E_NOINTERFACE);
Ā Ā Ā Ā end;
Ā Ā Ā finally
Ā Ā Ā Ā // Clear obtained item
Ā Ā Ā Ā ovItem:=Unassigned;
Ā Ā Ā end;
Ā end
Ā else
Ā Ā Ā // Failed to get item
Ā Ā Ā result:=False;
end;
function TEnumerator.Reset: Boolean;
begin
Ā // Reset enumerator
Ā result:=(FEnumVariant.Rese
end;
function TEnumerator.Skip(Count: LongWord): Boolean;
begin
Ā // Skip items in enumerator
Ā result:=(FEnumVariant.Skip
end;
function TEnumerator.Clone: IEnumerator;
var Ā pvEnum: Ā Ā Ā Ā IEnumVariant;
begin
Ā // Clone
Ā if (FEnumVariant.Clone(pvEnum
Ā begin
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Return wrapper
Ā Ā Ā Ā result:=TEnumerator.Create
Ā Ā Ā finally
Ā Ā Ā Ā // Release interface
Ā Ā Ā Ā pvEnum:=nil;
Ā Ā Ā end
Ā end
Ā else
Ā Ā Ā // Return nil
Ā Ā Ā result:=nil;
end;
constructor TEnumerator.CreateWrapper(
begin
Ā // Perform inherited
Ā inherited Create;
Ā // Check interface pointer
Ā if Assigned(EnumVariant) then
Ā Ā Ā // Bind to the passed interface
Ā Ā Ā FEnumVariant:=EnumVariant
Ā else
Ā Ā Ā // Throw error
Ā Ā Ā OleError(E_NOINTERFACE);
end;
constructor TEnumerator.Create(Dispatc
begin
Ā // Perform inherited
Ā inherited Create;
Ā // Get enumerator interface
Ā GetEnumVariant(Dispatch);
end;
destructor TEnumerator.Destroy;
begin
Ā // Resource protection
Ā try
Ā Ā Ā // Release the interface
Ā Ā Ā FEnumVariant:=nil;
Ā finally
Ā Ā Ā // Perform inherited
Ā Ā Ā inherited Destroy;
Ā end;
end;
end.
ASKER
I get an error box three times, first has printer and the second something else and the third network connections and then the list box populates with all three network adapters. All 2K PCs have SP 4.
Clicking through the error messages gets me the info. Does the same on XP. I didn't see where any messagesboxes were written into the code, but I didn't look hard!
Clicking through the error messages gets me the info. Does the same on XP. I didn't see where any messagesboxes were written into the code, but I didn't look hard!
So, just to clarify, this is loading the list of connections for Win2k boxes? And yes, there is a MessagBox call to display each enumerated item until the network is found.
If this is correct, then this method can be followed to what will hopefully be a solution for 2K and XP systems.
Russell
If this is correct, then this method can be followed to what will hopefully be a solution for 2K and XP systems.
Russell
ASKER
Yes. It is showing up for the Win 2K boxes...
It, the 2K boxes, have three NICS and each is listed!
It showed up in a prior test as well.
John
It, the 2K boxes, have three NICS and each is listed!
It showed up in a prior test as well.
John
Example usage:
procedure TForm1.Button1Click(Sender : TObject);
var Ā dwIndex: Ā Ā Ā Ā Ā Integer;
begin
Ā GetNetworkNames(ListBox1.I tems);
Ā for dwIndex:=0 to Pred(ListBox1.Items.Count) do
Ā Ā Ā NetworkDisable(ListBox1.It ems[dwInde x]);
end;
procedure TForm1.Button2Click(Sender : TObject);
var Ā dwIndex: Ā Ā Ā Ā Ā Integer;
begin
Ā GetNetworkNames(ListBox1.I tems);
Ā for dwIndex:=0 to Pred(ListBox1.Items.Count) do
Ā Ā Ā NetworkEnable(ListBox1.Ite ms[dwIndex ]);
end;
-- dfm --
object Form1: TForm1
Ā Left = 251
Ā Top = 166
Ā Width = 386
Ā Height = 319
Ā Caption = 'Form1'
Ā Color = clBtnFace
Ā Font.Charset = DEFAULT_CHARSET
Ā Font.Color = clWindowText
Ā Font.Height = -11
Ā Font.Name = 'MS Sans Serif'
Ā Font.Style = []
Ā OldCreateOrder = False
Ā PixelsPerInch = 96
Ā TextHeight = 13
Ā object ListBox1: TListBox
Ā Ā Left = 140
Ā Ā Top = 28
Ā Ā Width = 185
Ā Ā Height = 225
Ā Ā ItemHeight = 13
Ā Ā TabOrder = 0
Ā end
Ā object Button1: TButton
Ā Ā Left = 32
Ā Ā Top = 32
Ā Ā Width = 75
Ā Ā Height = 25
Ā Ā Caption = 'Disable'
Ā Ā TabOrder = 1
Ā Ā OnClick = Button1Click
Ā end
Ā object Button2: TButton
Ā Ā Left = 32
Ā Ā Top = 68
Ā Ā Width = 75
Ā Ā Height = 25
Ā Ā Caption = 'Enable'
Ā Ā TabOrder = 2
Ā Ā OnClick = Button2Click
Ā end
end
-- Source --
unit NetConnections;
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
//
// Ā Unit Ā Ā Ā Ā : Ā NetConnections
// Ā Author Ā Ā Ā : Ā rllibby
// Ā Date Ā Ā Ā Ā : Ā 06.16.2007
// Ā Description : Ā OLE scripting based mechanism for enabling / disabling the
// Ā Ā Ā Ā Ā Ā Ā Ā Ā network connections on a PC.
//
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
interface
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
// Ā Include units
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
uses
Ā Windows, SysUtils, Classes, Forms, ComObj, ActiveX, ComUtils;
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
// Ā Constants
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
const
Ā SHELL_APPLICATION = Ā 'Shell.Application';
Ā NETWORK_2K Ā Ā Ā Ā = Ā 'Network and Dial-up Connections';
Ā NETWORK_XP Ā Ā Ā Ā = Ā 'Network Connections';
Ā VERB_ENABLE1 Ā Ā Ā = Ā 'En&able';
Ā VERB_ENABLE2 Ā Ā Ā = Ā 'Enable';
Ā VERB_DISABLE1 Ā Ā = Ā 'Disa&ble';
Ā VERB_DISABLE2 Ā Ā = Ā 'Disable';
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
// Ā IEnumVariant interface and implementation
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
type
Ā IEnumerator Ā Ā Ā = Ā interface
Ā Ā Ā function Ā Ā Ā ForEach(out Obj: OleVariant): Boolean;
Ā Ā Ā function Ā Ā Ā ForEachObject(const IID: TGUID; out Obj): Boolean;
Ā Ā Ā function Ā Ā Ā Reset: Boolean;
Ā Ā Ā function Ā Ā Ā Skip(Count: LongWord): Boolean;
Ā Ā Ā function Ā Ā Ā Clone: IEnumerator;
Ā end;
Ā TEnumerator Ā Ā Ā = Ā class(TInterfacedObject, IEnumerator)
Ā private
Ā Ā Ā // Private declarations
Ā Ā Ā FEnumVariant: Ā IEnumVariant;
Ā Ā Ā procedure Ā Ā Ā GetEnumVariant(Dispatch: IDispatch);
Ā protected
Ā Ā Ā // Protected declarations
Ā Ā Ā function Ā Ā Ā ForEach(out Obj: OleVariant): Boolean;
Ā Ā Ā function Ā Ā Ā ForEachObject(const IID: TGUID; out Obj): Boolean;
Ā Ā Ā function Ā Ā Ā Reset: Boolean;
Ā Ā Ā function Ā Ā Ā Skip(Count: LongWord): Boolean;
Ā Ā Ā function Ā Ā Ā Clone: IEnumerator;
Ā public
Ā Ā Ā // Public declarations
Ā Ā Ā constructor Ā Ā Create(Dispatch: IDispatch);
Ā Ā Ā constructor Ā Ā CreateWrapper(EnumVariant: IEnumVariant);
Ā Ā Ā destructor Ā Ā Destroy; override;
Ā end;
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
// Ā Utility functions
////////////////////////// ////////// ////////// ////////// ////////// ////////// ////
function Ā NetworkDisable(Name: String): Boolean;
function Ā NetworkEnable(Name: String): Boolean;
function Ā GetNetworkNames(List: TStrings): Integer;
function Ā GetNetworkFolderItems(out Enumerator: IEnumerator): HResult;
function Ā IsWin2000: Boolean;
implementation
function NetworkDisable(Name: String): Boolean;
var Ā pvConnections: IEnumerator;
Ā Ā Ā pvVerbs: Ā Ā Ā IEnumerator;
Ā Ā Ā oItem: Ā Ā Ā Ā OleVariant;
Ā Ā Ā oVerb: Ā Ā Ā Ā OleVariant;
begin
Ā // Set default result
Ā result:=False;
Ā // Get the network folder items
Ā OleCheck(GetNetworkFolderI tems(pvCon nections)) ;
Ā // Resuorce protection
Ā try
Ā Ā Ā // Iterate the items to find the match
Ā Ā Ā while pvConnections.ForEach(oIte m) do
Ā Ā Ā begin
Ā Ā Ā Ā // Check name
Ā Ā Ā Ā if (CompareText(oItem.Name, Name) = 0) then
Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā // Found the item, get the verbs
Ā Ā Ā Ā Ā Ā pvVerbs:=TEnumerator.Creat e(oItem.Ve rbs);
Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā // Iterate the vebs
Ā Ā Ā Ā Ā Ā Ā while pvVerbs.ForEach(oVerb) do
Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Check verb name
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if (CompareText(oVerb.Name, VERB_DISABLE1) = 0) or (CompareText(oVerb.Name, VERB_DISABLE2) = 0) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Found the enable verb, fire it
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā oVerb.DoIt;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Success
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā result:=True;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Wait
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Sleep(1000);
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Done processing
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā break;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Clear the variant
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā oVerb:=Unassigned;
Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā Ā pvVerbs:=nil;
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā end;
Ā Ā Ā end;
Ā finally
Ā Ā Ā // Release the interface
Ā Ā Ā pvConnections:=nil;
Ā end;
end;
function NetworkEnable(Name: String): Boolean;
var Ā pvConnections: IEnumerator;
Ā Ā Ā pvVerbs: Ā Ā Ā IEnumerator;
Ā Ā Ā oItem: Ā Ā Ā Ā OleVariant;
Ā Ā Ā oVerb: Ā Ā Ā Ā OleVariant;
begin
Ā // Set default result
Ā result:=False;
Ā // Get the network folder items
Ā OleCheck(GetNetworkFolderI tems(pvCon nections)) ;
Ā // Resuorce protection
Ā try
Ā Ā Ā // Iterate the items to find the match
Ā Ā Ā while pvConnections.ForEach(oIte m) do
Ā Ā Ā begin
Ā Ā Ā Ā // Check name
Ā Ā Ā Ā if (CompareText(oItem.Name, Name) = 0) then
Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā // Found the item, get the verbs
Ā Ā Ā Ā Ā Ā pvVerbs:=TEnumerator.Creat e(oItem.Ve rbs);
Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā // Iterate the vebs
Ā Ā Ā Ā Ā Ā Ā while pvVerbs.ForEach(oVerb) do
Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Check verb name
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if (CompareText(oVerb.Name, VERB_ENABLE1) = 0) or (CompareText(oVerb.Name, VERB_ENABLE2) = 0) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Found the enable verb, fire it
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā oVerb.DoIt;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Success
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā result:=True;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Wait
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Sleep(1000);
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Done processing
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā break;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Clear the variant
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā oVerb:=Unassigned;
Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā Ā pvVerbs:=nil;
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā end;
Ā Ā Ā end;
Ā finally
Ā Ā Ā // Release the interface
Ā Ā Ā pvConnections:=nil;
Ā end;
end;
function GetNetworkNames(List: TStrings): Integer;
var Ā pvConnections: IEnumerator;
Ā Ā Ā oItem: Ā Ā Ā Ā OleVariant;
begin
Ā // Get the network folder items
Ā OleCheck(GetNetworkFolderI tems(pvCon nections)) ;
Ā // Resuorce protection
Ā try
Ā Ā Ā // Lock list
Ā Ā Ā List.BeginUpdate;
Ā Ā Ā // Rsource protection
Ā Ā Ā try
Ā Ā Ā Ā // Clear the list
Ā Ā Ā Ā List.Clear;
Ā Ā Ā Ā // Add the items to the list
Ā Ā Ā Ā while pvConnections.ForEach(oIte m) do
Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā // Add item name
Ā Ā Ā Ā Ā Ā Ā List.Add(oItem.Name);
Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā // Clear the variant
Ā Ā Ā Ā Ā Ā Ā oItem:=Unassigned;
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā end;
Ā Ā Ā finally
Ā Ā Ā Ā // Unlock the list
Ā Ā Ā Ā List.EndUpdate;
Ā Ā Ā end;
Ā finally
Ā Ā Ā // Release the interface
Ā Ā Ā pvConnections:=nil;
Ā Ā Ā // Return list count
Ā Ā Ā result:=List.Count;
Ā end;
end;
function GetNetworkFolderItems(out Enumerator: IEnumerator): HResult;
var Ā pvItems: Ā Ā Ā IEnumerator;
Ā Ā Ā oShellApp: Ā Ā OleVariant;
Ā Ā Ā oFolder: Ā Ā Ā OleVariant;
Ā Ā Ā szFolder: Ā Ā Ā String;
begin
Ā // Clear out bound interface
Ā Enumerator:=nil;
Ā // Resource protection
Ā try
Ā Ā Ā // Create shell object
Ā Ā Ā oShellApp:=CreateOleObject ('Shell.Ap plication' );
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Get desired folder name
Ā Ā Ā Ā if IsWin2000 then
Ā Ā Ā Ā Ā Ā szFolder:=NETWORK_2K
Ā Ā Ā Ā else
Ā Ā Ā Ā Ā Ā szFolder:=NETWORK_XP;
Ā Ā Ā Ā // Get enumerator for the control panel folder
Ā Ā Ā Ā pvItems:=TEnumerator.Creat e(oShellAp p.NameSpac e(3).Items );
Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā // Iterate the items
Ā Ā Ā Ā Ā Ā while pvItems.ForEach(oFolder) do
Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Check folder name against desired folder name
Ā Ā Ā Ā Ā Ā Ā Ā Ā if (CompareText(oFolder.Name, szFolder) = 0) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Found the network folder, get items collection
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Enumerator:=TEnumerator.Cr eate(oFold er.GetFold er.Items);
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Done processing
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā break;
Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Clear variant
Ā Ā Ā Ā Ā Ā Ā Ā Ā oFolder:=Unassigned;
Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā pvItems:=nil;
Ā Ā Ā Ā end;
Ā Ā Ā finally
Ā Ā Ā Ā // Clear variant
Ā Ā Ā Ā oShellApp:=Unassigned;
Ā Ā Ā end;
Ā finally
Ā Ā Ā // Success if we have the interface
Ā Ā Ā if Assigned(Enumerator) then
Ā Ā Ā Ā // Success
Ā Ā Ā Ā result:=S_OK
Ā Ā Ā else
Ā Ā Ā Ā // No interface
Ā Ā Ā Ā result:=E_NOINTERFACE;
Ā end;
end;
//// Utility functions ////////////////////////// ////////// ////////// ////////// /
function IsWin2000: Boolean;
var Ā lpVer: Ā Ā Ā Ā TOSVersionInfo;
begin
Ā // Set size
Ā lpVer.dwOSVersionInfoSize: =SizeOf(lp Ver);
Ā // Get OS version
Ā if GetVersionEx(lpVer) then
Ā Ā Ā // Check major and minor
Ā Ā Ā result:=(lpVer.dwMajorVers ion = 5) and (lpVer.dwMinorVersion = 0)
Ā else
Ā Ā Ā // Failed, who knows...
Ā Ā Ā result:=False;
end;
//// TEnumerator ////////////////////////// ////////// ////////// ////////// ///////
procedure TEnumerator.GetEnumVariant (Dispatch: IDispatch);
var Ā pdParams: Ā Ā Ā TDispParams;
Ā Ā Ā ovEnum: Ā Ā Ā Ā OleVariant;
begin
Ā // Check interface
Ā if Assigned(Dispatch) then
Ā begin
Ā Ā Ā // Clear disp params
Ā Ā Ā FillChar(pdParams, SizeOf(TDispParams), 0);
Ā Ā Ā // Get enumerator
Ā Ā Ā OleCheck(Dispatch.Invoke(D ISPID_NEWE NUM, GUID_NULL, LOCALE_SYSTEM_DEFAULT, DISPATCH_PROPERTYGET or DISPATCH_METHOD, pdParams, @ovEnum, nil, nil));
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Check returned interface
Ā Ā Ā Ā if (TVariantArg(ovEnum).vt = VT_UNKNOWN) then
Ā Ā Ā Ā Ā Ā // Query interface for the IEnumVariant
Ā Ā Ā Ā Ā Ā OleCheck(IUnknown(ovEnum). QueryInter face(IEnum Variant, FEnumVariant))
Ā Ā Ā Ā else
Ā Ā Ā Ā Ā Ā // Throw error
Ā Ā Ā Ā Ā Ā OleError(E_NOINTERFACE);
Ā Ā Ā finally
Ā Ā Ā Ā // Clear interface
Ā Ā Ā Ā ovEnum:=Unassigned;
Ā Ā Ā end;
Ā end
Ā else
Ā Ā Ā // Throw error
Ā Ā Ā OleError(E_NOINTERFACE);
end;
function TEnumerator.ForEach(out Obj: OleVariant): Boolean;
var Ā dwFetch: Ā Ā Ā Cardinal;
begin
Ā // Get the next item
Ā result:=(FEnumVariant.Next (1, Obj, dwFetch) = S_OK) and (dwFetch = 1);
end;
function TEnumerator.ForEachObject( const IID: TGUID; out Obj): Boolean;
var Ā ovItem: Ā Ā Ā Ā OleVariant;
begin
Ā // Get next item as OleVariant
Ā if ForEach(ovItem) then
Ā begin
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Check interface for IUknown
Ā Ā Ā Ā if (TVariantArg(ovItem).vt = VT_UNKNOWN) then
Ā Ā Ā Ā Ā Ā // Query interface for the desired interface
Ā Ā Ā Ā Ā Ā result:=(IUnknown(ovItem). QueryInter face(IID, Obj) = S_OK)
Ā Ā Ā Ā // Check interface for IDispatch
Ā Ā Ā Ā else if (TVariantArg(ovItem).vt = VT_DISPATCH) then
Ā Ā Ā Ā Ā Ā // Query interface for the desired interface
Ā Ā Ā Ā Ā Ā result:=(IDispatch(ovItem) .QueryInte rface(IID, Obj) = S_OK)
Ā Ā Ā Ā else
Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā // Pacify the compiler
Ā Ā Ā Ā Ā Ā result:=False;
Ā Ā Ā Ā Ā Ā // Throw error
Ā Ā Ā Ā Ā Ā OleError(E_NOINTERFACE);
Ā Ā Ā Ā end;
Ā Ā Ā finally
Ā Ā Ā Ā // Clear obtained item
Ā Ā Ā Ā ovItem:=Unassigned;
Ā Ā Ā end;
Ā end
Ā else
Ā Ā Ā // Failed to get item
Ā Ā Ā result:=False;
end;
function TEnumerator.Reset: Boolean;
begin
Ā // Reset enumerator
Ā result:=(FEnumVariant.Rese t = S_OK);
end;
function TEnumerator.Skip(Count: LongWord): Boolean;
begin
Ā // Skip items in enumerator
Ā result:=(FEnumVariant.Skip (Count) = S_OK);
end;
function TEnumerator.Clone: IEnumerator;
var Ā pvEnum: Ā Ā Ā Ā IEnumVariant;
begin
Ā // Clone
Ā if (FEnumVariant.Clone(pvEnum ) = S_OK) then
Ā begin
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Return wrapper
Ā Ā Ā Ā result:=TEnumerator.Create Wrapper(pv Enum);
Ā Ā Ā finally
Ā Ā Ā Ā // Release interface
Ā Ā Ā Ā pvEnum:=nil;
Ā Ā Ā end
Ā end
Ā else
Ā Ā Ā // Return nil
Ā Ā Ā result:=nil;
end;
constructor TEnumerator.CreateWrapper( EnumVarian t: IEnumVariant);
begin
Ā // Perform inherited
Ā inherited Create;
Ā // Check interface pointer
Ā if Assigned(EnumVariant) then
Ā Ā Ā // Bind to the passed interface
Ā Ā Ā FEnumVariant:=EnumVariant
Ā else
Ā Ā Ā // Throw error
Ā Ā Ā OleError(E_NOINTERFACE);
end;
constructor TEnumerator.Create(Dispatc h: IDispatch);
begin
Ā // Perform inherited
Ā inherited Create;
Ā // Get enumerator interface
Ā GetEnumVariant(Dispatch);
end;
destructor TEnumerator.Destroy;
begin
Ā // Resource protection
Ā try
Ā Ā Ā // Release the interface
Ā Ā Ā FEnumVariant:=nil;
Ā finally
Ā Ā Ā // Perform inherited
Ā Ā Ā inherited Destroy;
Ā end;
end;
end.
procedure TForm1.Button1Click(Sender
var Ā dwIndex: Ā Ā Ā Ā Ā Integer;
begin
Ā GetNetworkNames(ListBox1.I
Ā for dwIndex:=0 to Pred(ListBox1.Items.Count)
Ā Ā Ā NetworkDisable(ListBox1.It
end;
procedure TForm1.Button2Click(Sender
var Ā dwIndex: Ā Ā Ā Ā Ā Integer;
begin
Ā GetNetworkNames(ListBox1.I
Ā for dwIndex:=0 to Pred(ListBox1.Items.Count)
Ā Ā Ā NetworkEnable(ListBox1.Ite
end;
-- dfm --
object Form1: TForm1
Ā Left = 251
Ā Top = 166
Ā Width = 386
Ā Height = 319
Ā Caption = 'Form1'
Ā Color = clBtnFace
Ā Font.Charset = DEFAULT_CHARSET
Ā Font.Color = clWindowText
Ā Font.Height = -11
Ā Font.Name = 'MS Sans Serif'
Ā Font.Style = []
Ā OldCreateOrder = False
Ā PixelsPerInch = 96
Ā TextHeight = 13
Ā object ListBox1: TListBox
Ā Ā Left = 140
Ā Ā Top = 28
Ā Ā Width = 185
Ā Ā Height = 225
Ā Ā ItemHeight = 13
Ā Ā TabOrder = 0
Ā end
Ā object Button1: TButton
Ā Ā Left = 32
Ā Ā Top = 32
Ā Ā Width = 75
Ā Ā Height = 25
Ā Ā Caption = 'Disable'
Ā Ā TabOrder = 1
Ā Ā OnClick = Button1Click
Ā end
Ā object Button2: TButton
Ā Ā Left = 32
Ā Ā Top = 68
Ā Ā Width = 75
Ā Ā Height = 25
Ā Ā Caption = 'Enable'
Ā Ā TabOrder = 2
Ā Ā OnClick = Button2Click
Ā end
end
-- Source --
unit NetConnections;
//////////////////////////
//
// Ā Unit Ā Ā Ā Ā : Ā NetConnections
// Ā Author Ā Ā Ā : Ā rllibby
// Ā Date Ā Ā Ā Ā : Ā 06.16.2007
// Ā Description : Ā OLE scripting based mechanism for enabling / disabling the
// Ā Ā Ā Ā Ā Ā Ā Ā Ā network connections on a PC.
//
//////////////////////////
interface
//////////////////////////
// Ā Include units
//////////////////////////
uses
Ā Windows, SysUtils, Classes, Forms, ComObj, ActiveX, ComUtils;
//////////////////////////
// Ā Constants
//////////////////////////
const
Ā SHELL_APPLICATION = Ā 'Shell.Application';
Ā NETWORK_2K Ā Ā Ā Ā = Ā 'Network and Dial-up Connections';
Ā NETWORK_XP Ā Ā Ā Ā = Ā 'Network Connections';
Ā VERB_ENABLE1 Ā Ā Ā = Ā 'En&able';
Ā VERB_ENABLE2 Ā Ā Ā = Ā 'Enable';
Ā VERB_DISABLE1 Ā Ā = Ā 'Disa&ble';
Ā VERB_DISABLE2 Ā Ā = Ā 'Disable';
//////////////////////////
// Ā IEnumVariant interface and implementation
//////////////////////////
type
Ā IEnumerator Ā Ā Ā = Ā interface
Ā Ā Ā function Ā Ā Ā ForEach(out Obj: OleVariant): Boolean;
Ā Ā Ā function Ā Ā Ā ForEachObject(const IID: TGUID; out Obj): Boolean;
Ā Ā Ā function Ā Ā Ā Reset: Boolean;
Ā Ā Ā function Ā Ā Ā Skip(Count: LongWord): Boolean;
Ā Ā Ā function Ā Ā Ā Clone: IEnumerator;
Ā end;
Ā TEnumerator Ā Ā Ā = Ā class(TInterfacedObject, IEnumerator)
Ā private
Ā Ā Ā // Private declarations
Ā Ā Ā FEnumVariant: Ā IEnumVariant;
Ā Ā Ā procedure Ā Ā Ā GetEnumVariant(Dispatch: IDispatch);
Ā protected
Ā Ā Ā // Protected declarations
Ā Ā Ā function Ā Ā Ā ForEach(out Obj: OleVariant): Boolean;
Ā Ā Ā function Ā Ā Ā ForEachObject(const IID: TGUID; out Obj): Boolean;
Ā Ā Ā function Ā Ā Ā Reset: Boolean;
Ā Ā Ā function Ā Ā Ā Skip(Count: LongWord): Boolean;
Ā Ā Ā function Ā Ā Ā Clone: IEnumerator;
Ā public
Ā Ā Ā // Public declarations
Ā Ā Ā constructor Ā Ā Create(Dispatch: IDispatch);
Ā Ā Ā constructor Ā Ā CreateWrapper(EnumVariant:
Ā Ā Ā destructor Ā Ā Destroy; override;
Ā end;
//////////////////////////
// Ā Utility functions
//////////////////////////
function Ā NetworkDisable(Name: String): Boolean;
function Ā NetworkEnable(Name: String): Boolean;
function Ā GetNetworkNames(List: TStrings): Integer;
function Ā GetNetworkFolderItems(out Enumerator: IEnumerator): HResult;
function Ā IsWin2000: Boolean;
implementation
function NetworkDisable(Name: String): Boolean;
var Ā pvConnections: IEnumerator;
Ā Ā Ā pvVerbs: Ā Ā Ā IEnumerator;
Ā Ā Ā oItem: Ā Ā Ā Ā OleVariant;
Ā Ā Ā oVerb: Ā Ā Ā Ā OleVariant;
begin
Ā // Set default result
Ā result:=False;
Ā // Get the network folder items
Ā OleCheck(GetNetworkFolderI
Ā // Resuorce protection
Ā try
Ā Ā Ā // Iterate the items to find the match
Ā Ā Ā while pvConnections.ForEach(oIte
Ā Ā Ā begin
Ā Ā Ā Ā // Check name
Ā Ā Ā Ā if (CompareText(oItem.Name, Name) = 0) then
Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā // Found the item, get the verbs
Ā Ā Ā Ā Ā Ā pvVerbs:=TEnumerator.Creat
Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā // Iterate the vebs
Ā Ā Ā Ā Ā Ā Ā while pvVerbs.ForEach(oVerb) do
Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Check verb name
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if (CompareText(oVerb.Name, VERB_DISABLE1) = 0) or (CompareText(oVerb.Name, VERB_DISABLE2) = 0) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Found the enable verb, fire it
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā oVerb.DoIt;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Success
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā result:=True;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Wait
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Sleep(1000);
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Done processing
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā break;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Clear the variant
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā oVerb:=Unassigned;
Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā Ā pvVerbs:=nil;
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā end;
Ā Ā Ā end;
Ā finally
Ā Ā Ā // Release the interface
Ā Ā Ā pvConnections:=nil;
Ā end;
end;
function NetworkEnable(Name: String): Boolean;
var Ā pvConnections: IEnumerator;
Ā Ā Ā pvVerbs: Ā Ā Ā IEnumerator;
Ā Ā Ā oItem: Ā Ā Ā Ā OleVariant;
Ā Ā Ā oVerb: Ā Ā Ā Ā OleVariant;
begin
Ā // Set default result
Ā result:=False;
Ā // Get the network folder items
Ā OleCheck(GetNetworkFolderI
Ā // Resuorce protection
Ā try
Ā Ā Ā // Iterate the items to find the match
Ā Ā Ā while pvConnections.ForEach(oIte
Ā Ā Ā begin
Ā Ā Ā Ā // Check name
Ā Ā Ā Ā if (CompareText(oItem.Name, Name) = 0) then
Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā // Found the item, get the verbs
Ā Ā Ā Ā Ā Ā pvVerbs:=TEnumerator.Creat
Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā // Iterate the vebs
Ā Ā Ā Ā Ā Ā Ā while pvVerbs.ForEach(oVerb) do
Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Check verb name
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā if (CompareText(oVerb.Name, VERB_ENABLE1) = 0) or (CompareText(oVerb.Name, VERB_ENABLE2) = 0) then
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Found the enable verb, fire it
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā oVerb.DoIt;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Success
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā result:=True;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Wait
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Sleep(1000);
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Done processing
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā break;
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Clear the variant
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā oVerb:=Unassigned;
Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā Ā pvVerbs:=nil;
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā end;
Ā Ā Ā end;
Ā finally
Ā Ā Ā // Release the interface
Ā Ā Ā pvConnections:=nil;
Ā end;
end;
function GetNetworkNames(List: TStrings): Integer;
var Ā pvConnections: IEnumerator;
Ā Ā Ā oItem: Ā Ā Ā Ā OleVariant;
begin
Ā // Get the network folder items
Ā OleCheck(GetNetworkFolderI
Ā // Resuorce protection
Ā try
Ā Ā Ā // Lock list
Ā Ā Ā List.BeginUpdate;
Ā Ā Ā // Rsource protection
Ā Ā Ā try
Ā Ā Ā Ā // Clear the list
Ā Ā Ā Ā List.Clear;
Ā Ā Ā Ā // Add the items to the list
Ā Ā Ā Ā while pvConnections.ForEach(oIte
Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā // Add item name
Ā Ā Ā Ā Ā Ā Ā List.Add(oItem.Name);
Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā // Clear the variant
Ā Ā Ā Ā Ā Ā Ā oItem:=Unassigned;
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā end;
Ā Ā Ā finally
Ā Ā Ā Ā // Unlock the list
Ā Ā Ā Ā List.EndUpdate;
Ā Ā Ā end;
Ā finally
Ā Ā Ā // Release the interface
Ā Ā Ā pvConnections:=nil;
Ā Ā Ā // Return list count
Ā Ā Ā result:=List.Count;
Ā end;
end;
function GetNetworkFolderItems(out Enumerator: IEnumerator): HResult;
var Ā pvItems: Ā Ā Ā IEnumerator;
Ā Ā Ā oShellApp: Ā Ā OleVariant;
Ā Ā Ā oFolder: Ā Ā Ā OleVariant;
Ā Ā Ā szFolder: Ā Ā Ā String;
begin
Ā // Clear out bound interface
Ā Enumerator:=nil;
Ā // Resource protection
Ā try
Ā Ā Ā // Create shell object
Ā Ā Ā oShellApp:=CreateOleObject
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Get desired folder name
Ā Ā Ā Ā if IsWin2000 then
Ā Ā Ā Ā Ā Ā szFolder:=NETWORK_2K
Ā Ā Ā Ā else
Ā Ā Ā Ā Ā Ā szFolder:=NETWORK_XP;
Ā Ā Ā Ā // Get enumerator for the control panel folder
Ā Ā Ā Ā pvItems:=TEnumerator.Creat
Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā // Iterate the items
Ā Ā Ā Ā Ā Ā while pvItems.ForEach(oFolder) do
Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā // Resource protection
Ā Ā Ā Ā Ā Ā Ā try
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Check folder name against desired folder name
Ā Ā Ā Ā Ā Ā Ā Ā Ā if (CompareText(oFolder.Name,
Ā Ā Ā Ā Ā Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Found the network folder, get items collection
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā Enumerator:=TEnumerator.Cr
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā // Done processing
Ā Ā Ā Ā Ā Ā Ā Ā Ā Ā break;
Ā Ā Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā Ā Ā Ā // Clear variant
Ā Ā Ā Ā Ā Ā Ā Ā Ā oFolder:=Unassigned;
Ā Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā Ā Ā end;
Ā Ā Ā Ā finally
Ā Ā Ā Ā Ā Ā // Release the interface
Ā Ā Ā Ā Ā Ā pvItems:=nil;
Ā Ā Ā Ā end;
Ā Ā Ā finally
Ā Ā Ā Ā // Clear variant
Ā Ā Ā Ā oShellApp:=Unassigned;
Ā Ā Ā end;
Ā finally
Ā Ā Ā // Success if we have the interface
Ā Ā Ā if Assigned(Enumerator) then
Ā Ā Ā Ā // Success
Ā Ā Ā Ā result:=S_OK
Ā Ā Ā else
Ā Ā Ā Ā // No interface
Ā Ā Ā Ā result:=E_NOINTERFACE;
Ā end;
end;
//// Utility functions //////////////////////////
function IsWin2000: Boolean;
var Ā lpVer: Ā Ā Ā Ā TOSVersionInfo;
begin
Ā // Set size
Ā lpVer.dwOSVersionInfoSize:
Ā // Get OS version
Ā if GetVersionEx(lpVer) then
Ā Ā Ā // Check major and minor
Ā Ā Ā result:=(lpVer.dwMajorVers
Ā else
Ā Ā Ā // Failed, who knows...
Ā Ā Ā result:=False;
end;
//// TEnumerator //////////////////////////
procedure TEnumerator.GetEnumVariant
var Ā pdParams: Ā Ā Ā TDispParams;
Ā Ā Ā ovEnum: Ā Ā Ā Ā OleVariant;
begin
Ā // Check interface
Ā if Assigned(Dispatch) then
Ā begin
Ā Ā Ā // Clear disp params
Ā Ā Ā FillChar(pdParams, SizeOf(TDispParams), 0);
Ā Ā Ā // Get enumerator
Ā Ā Ā OleCheck(Dispatch.Invoke(D
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Check returned interface
Ā Ā Ā Ā if (TVariantArg(ovEnum).vt = VT_UNKNOWN) then
Ā Ā Ā Ā Ā Ā // Query interface for the IEnumVariant
Ā Ā Ā Ā Ā Ā OleCheck(IUnknown(ovEnum).
Ā Ā Ā Ā else
Ā Ā Ā Ā Ā Ā // Throw error
Ā Ā Ā Ā Ā Ā OleError(E_NOINTERFACE);
Ā Ā Ā finally
Ā Ā Ā Ā // Clear interface
Ā Ā Ā Ā ovEnum:=Unassigned;
Ā Ā Ā end;
Ā end
Ā else
Ā Ā Ā // Throw error
Ā Ā Ā OleError(E_NOINTERFACE);
end;
function TEnumerator.ForEach(out Obj: OleVariant): Boolean;
var Ā dwFetch: Ā Ā Ā Cardinal;
begin
Ā // Get the next item
Ā result:=(FEnumVariant.Next
end;
function TEnumerator.ForEachObject(
var Ā ovItem: Ā Ā Ā Ā OleVariant;
begin
Ā // Get next item as OleVariant
Ā if ForEach(ovItem) then
Ā begin
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Check interface for IUknown
Ā Ā Ā Ā if (TVariantArg(ovItem).vt = VT_UNKNOWN) then
Ā Ā Ā Ā Ā Ā // Query interface for the desired interface
Ā Ā Ā Ā Ā Ā result:=(IUnknown(ovItem).
Ā Ā Ā Ā // Check interface for IDispatch
Ā Ā Ā Ā else if (TVariantArg(ovItem).vt = VT_DISPATCH) then
Ā Ā Ā Ā Ā Ā // Query interface for the desired interface
Ā Ā Ā Ā Ā Ā result:=(IDispatch(ovItem)
Ā Ā Ā Ā else
Ā Ā Ā Ā begin
Ā Ā Ā Ā Ā Ā // Pacify the compiler
Ā Ā Ā Ā Ā Ā result:=False;
Ā Ā Ā Ā Ā Ā // Throw error
Ā Ā Ā Ā Ā Ā OleError(E_NOINTERFACE);
Ā Ā Ā Ā end;
Ā Ā Ā finally
Ā Ā Ā Ā // Clear obtained item
Ā Ā Ā Ā ovItem:=Unassigned;
Ā Ā Ā end;
Ā end
Ā else
Ā Ā Ā // Failed to get item
Ā Ā Ā result:=False;
end;
function TEnumerator.Reset: Boolean;
begin
Ā // Reset enumerator
Ā result:=(FEnumVariant.Rese
end;
function TEnumerator.Skip(Count: LongWord): Boolean;
begin
Ā // Skip items in enumerator
Ā result:=(FEnumVariant.Skip
end;
function TEnumerator.Clone: IEnumerator;
var Ā pvEnum: Ā Ā Ā Ā IEnumVariant;
begin
Ā // Clone
Ā if (FEnumVariant.Clone(pvEnum
Ā begin
Ā Ā Ā // Resource protection
Ā Ā Ā try
Ā Ā Ā Ā // Return wrapper
Ā Ā Ā Ā result:=TEnumerator.Create
Ā Ā Ā finally
Ā Ā Ā Ā // Release interface
Ā Ā Ā Ā pvEnum:=nil;
Ā Ā Ā end
Ā end
Ā else
Ā Ā Ā // Return nil
Ā Ā Ā result:=nil;
end;
constructor TEnumerator.CreateWrapper(
begin
Ā // Perform inherited
Ā inherited Create;
Ā // Check interface pointer
Ā if Assigned(EnumVariant) then
Ā Ā Ā // Bind to the passed interface
Ā Ā Ā FEnumVariant:=EnumVariant
Ā else
Ā Ā Ā // Throw error
Ā Ā Ā OleError(E_NOINTERFACE);
end;
constructor TEnumerator.Create(Dispatc
begin
Ā // Perform inherited
Ā inherited Create;
Ā // Get enumerator interface
Ā GetEnumVariant(Dispatch);
end;
destructor TEnumerator.Destroy;
begin
Ā // Resource protection
Ā try
Ā Ā Ā // Release the interface
Ā Ā Ā FEnumVariant:=nil;
Ā finally
Ā Ā Ā // Perform inherited
Ā Ā Ā inherited Destroy;
Ā end;
end;
end.
ASKER
Russell,
ComUtils.pas is a unit you wrote some time ago, correct?
John
ComUtils.pas is a unit you wrote some time ago, correct?
John
Oops, yep. You don't need it in the includes though, as I ripped the enumerator stuff from it already.
Russell
Russell
ASKER
ALL RIGHT!!!!!
It werks! In XP and 2K! However...
It tries to enable the card(s) multiple times. In XP it was once (had two nics) and in 2000 it was three times (had 3 nics) after you do a NetworkEnable.
John!
It werks! In XP and 2K! However...
It tries to enable the card(s) multiple times. In XP it was once (had two nics) and in 2000 it was three times (had 3 nics) after you do a NetworkEnable.
John!
Cool, glad it works in both cases. Also, you can individually enable/disable the desired card as well (the demo code was just that... demo code). Its going to be up to you to determine which connection you wish to disable then re-enable.
Russell
Russell
ASKER
Ya know... one can overlook the most obvious stuff. And several times.
Man, I was stepping through your code starting from the middle working my way out and it dawned on me...
It was my button code causing it to loop and try to enable it again causing windows to let me know that it was already enabling the connection!
Oh Me!
Thanks Russell. It works great!!!!!!!
John
Man, I was stepping through your code starting from the middle working my way out and it dawned on me...
It was my button code causing it to loop and try to enable it again causing windows to let me know that it was already enabling the connection!
Oh Me!
Thanks Russell. It works great!!!!!!!
John
No problem John.
Glad we were able to finally kick out some code that worked on both OS's. It does make me curious as to what the Shell COM interfaces are doing internally though, as my original code using IShellFolder should have been doing the same thing (but at the lowest level of interfaces). Moot point, as you have a solution that works.
Russell
Glad we were able to finally kick out some code that worked on both OS's. It does make me curious as to what the Shell COM interfaces are doing internally though, as my original code using IShellFolder should have been doing the same thing (but at the lowest level of interfaces). Moot point, as you have a solution that works.
Russell
ASKER
Well, me too!
I have learned a BUNCH and will dig deeper as time permits...
Thanks again.
John
I have learned a BUNCH and will dig deeper as time permits...
Thanks again.
John
rllibby;
is the Best guy for Delphi networking
is the Best guy for Delphi networking
Russell