📄 network.htm
字号:
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<HTML>
<HEAD>
<TITLE>UDDF - Networking</TITLE>
<META NAME="Description" CONTENT="Networking section of the Delphi Developers FAQ" >
<META NAME="Keywords" CONTENT="" >
</HEAD>
<BODY bgcolor="#FFFFFF">
<CENTER>
<IMG SRC="../images/uddf.jpg"> </CENTER>
<HR SIZE="6" COLOR="LIME">
<CENTER><FONT SIZE="7" FACE="Arial Black" COLOR="RED">Networking</FONT></CENTER>
<!---------------------------------------------------------------------------------------------------------------------------------------------------->
<P><H1><A NAME="network0">Browsing for a Network Machine (ala Network Neighborhood)</P></A></H1>
<P><I>From: mloeffler@teletrade.com (Michael J. Loeffler)</I></P>
I started messing around with a utility like this, just for fun.
I never finished it. I know it did work at the time.
You might be able to use some of the code as a base
point. Don't know if you feel like poring through the
details, but hope it helps. <p>
<HR><PRE>{
Network resource utility. Similar in function to NetWork-
Neighborhood.
Michael J. Loeffler
1997.01.31
}
unit netres_main_unit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
ComCtrls, StdCtrls, Buttons, Menus, ExtCtrls;
type
TfrmMain = class(TForm)
tvResources: TTreeView;
btnOK: TBitBtn;
btnClose: TBitBtn;
Label1: TLabel;
barBottom: TStatusBar;
popResources: TPopupMenu;
mniExpandAll: TMenuItem;
mniCollapseAll: TMenuItem;
mniSaveToFile: TMenuItem;
mniLoadFromFile: TMenuItem;
grpListType: TRadioGroup;
grpResourceType: TRadioGroup;
dlgOpen: TOpenDialog;
dlgSave: TSaveDialog;
procedure FormCreate(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure mniExpandAllClick(Sender: TObject);
procedure mniCollapseAllClick(Sender: TObject);
procedure mniSaveToFileClick(Sender: TObject);
procedure mniLoadFromFileClick(Sender: TObject);
procedure btnOKClick(Sender: TObject);
private
ListType, ResourceType: DWORD;
procedure ShowHint(Sender: TObject);
procedure DoEnumeration;
procedure DoEnumerationContainer(NetResContainer: TNetResource);
procedure AddContainer(NetRes: TNetResource);
procedure AddShare(TopContainerIndex: Integer; NetRes:
TNetResource);
procedure AddShareString(TopContainerIndex: Integer; ItemName:
String);
procedure AddConnection(NetRes: TNetResource);
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.DFM}
procedure TfrmMain.ShowHint(Sender: TObject);
begin
barBottom.Panels.Items[0].Text:=Application.Hint;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
Application.OnHint:=ShowHint;
barBottom.Panels.Items[0].Text:='';
end;
procedure TfrmMain.btnCloseClick(Sender: TObject);
begin
Close;
end;
{
Enumerate through all network resources:
}
procedure TfrmMain.DoEnumeration;
var
NetRes: Array[0..2] of TNetResource;
Loop: Integer;
r, hEnum, EntryCount, NetResLen: DWORD;
begin
case grpListType.ItemIndex of
{ Connected resources: }
1: ListType:=RESOURCE_CONNECTED;
{ Persistent resources: }
2: ListType:=RESOURCE_REMEMBERED;
{ Global: }
else ListType:=RESOURCE_GLOBALNET;
end;
case grpResourceType.ItemIndex of
{ Disk resources: }
1: ResourceType:=RESOURCETYPE_DISK;
{ Print resources: }
2: ResourceType:=RESOURCETYPE_PRINT;
{ All: }
else ResourceType:=RESOURCETYPE_ANY;
end;
Screen.Cursor:=crHourGlass;
try
{ Delete any old items in the tree view: }
for Loop:=tvResources.Items.Count-1 downto 0 do
tvResources.Items[Loop].Delete;
except
end;
{ Start enumeration: }
r:=WNetOpenEnum(ListType,ResourceType,0,nil,hEnum);
if r<>NO_ERROR then
begin
if r=ERROR_EXTENDED_ERROR then
MessageDlg('Unable to Enumerate the Network.'+#13+
'A network-specific error occurred.',mtError,[mbOK],0)
else
MessageDlg('Unable to Enumerate the Network.',
mtError,[mbOK],0);
Exit;
end;
try
{ We got a valid enumeration handle; walk the resources: }
while (1=1) do
begin
EntryCount:=1;
NetResLen:=SizeOf(NetRes);
r:=WNetEnumResource(hEnum,EntryCount,@NetRes,NetResLen);
case r of
0: begin
{ It's a container, iterate it: }
if NetRes[0].dwUsage=RESOURCEUSAGE_CONTAINER then
DoEnumerationContainer(NetRes[0])
else
{ Persistent and connected resources show up here: }
if ListType in [RESOURCE_REMEMBERED,RESOURCE_CONNECTED]
then
AddConnection(NetRes[0]);
end;
{ Done: }
ERROR_NO_MORE_ITEMS: Break;
{ Other error: }
else begin
MessageDlg('Error Walking Resources.',mtError,[mbOK],0);
Break;
end;
end;
end;
finally
Screen.Cursor:=crDefault;
{ Close enumeration handle: }
WNetCloseEnum(hEnum);
end;
end;
{
Enumerate through the specified container:
This function is usually recursively called.
}
procedure TfrmMain.DoEnumerationContainer(NetResContainer:
TNetResource);
var
NetRes: Array[0..10] of TNetResource;
TopContainerIndex: Integer;
r, hEnum, EntryCount, NetResLen: DWORD;
begin
{ Add container name to tree view: }
AddContainer(NetResContainer);
{ Keep track of this item as current root: }
TopContainerIndex:=tvResources.Items.Count-1;
{ Start enumeration: }
if ListType=RESOURCE_GLOBALNET then
{ Enumerating global net: }
r:=WNetOpenEnum(ListType,ResourceType,RESOURCEUSAGE_CONTAINER,
@NetResContainer,hEnum)
else
{ Enumerating connections or persistent (won't normally get here):
}
r:=WNetOpenEnum(ListType,ResourceType,RESOURCEUSAGE_CONTAINER,
nil,hEnum);
{ Couldn't enumerate through this container; just make a note
of it and continue on: }
if r<>NO_ERROR then
begin
AddShareString(TopContainerIndex,'<Couldn''t Enumerate Resources
(Error #'+
IntToStr(r)+'>');
WNetCloseEnum(hEnum);
Exit;
end;
{ We got a valid enumeration handle; walk the resources: }
while (1=1) do
begin
EntryCount:=1;
NetResLen:=SizeOf(NetRes);
r:=WNetEnumResource(hEnum,EntryCount,@NetRes,NetResLen);
case r of
0: begin
{ Yet another container to enumerate; call this function
recursively to handle it: }
if (NetRes[0].dwUsage=RESOURCEUSAGE_CONTAINER) or
(NetRes[0].dwUsage=10) then
DoEnumerationContainer(NetRes[0])
else
case NetRes[0].dwDisplayType of
{ Top level type: }
RESOURCEDISPLAYTYPE_GENERIC,
RESOURCEDISPLAYTYPE_DOMAIN,
RESOURCEDISPLAYTYPE_SERVER: AddContainer(NetRes[0]);
{ Share: }
RESOURCEDISPLAYTYPE_SHARE:
AddShare(TopContainerIndex,NetRes[0]);
end;
end;
ERROR_NO_MORE_ITEMS: Break;
else begin
MessageDlg('Error #'+IntToStr(r)+' Walking
Resources.',mtError,[mbOK],0);
Break;
end;
end;
end;
{ Close enumeration handle: }
WNetCloseEnum(hEnum);
end;
procedure TfrmMain.FormShow(Sender: TObject);
begin
DoEnumeration;
end;
{
Add item to tree view; indicate that it is a container:
}
procedure TfrmMain.AddContainer(NetRes: TNetResource);
var
ItemName: String;
begin
ItemName:=Trim(String(NetRes.lpRemoteName));
if Trim(String(NetRes.lpComment))<>'' then
begin
if ItemName<>'' then ItemName:=ItemName+' ';
ItemName:=ItemName+'('+String(NetRes.lpComment)+')';
end;
tvResources.Items.Add(tvResources.Selected,ItemName);
end;
{
Add child item to container denoted as current top:
}
procedure TfrmMain.AddShare(TopContainerIndex: Integer; NetRes:
TNetResource);
var
ItemName: String;
begin
ItemName:=Trim(String(NetRes.lpRemoteName));
if Trim(String(NetRes.lpComment))<>'' then
begin
if ItemName<>'' then ItemName:=ItemName+' ';
ItemName:=ItemName+'('+String(NetRes.lpComment)+')';
end;
tvResources.Items.AddChild(tvResources.Items[TopContainerIndex],ItemName);
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -