如何在delphi中编程实现用命令＂net use＂获取的 找易语言进销存源码
销售管理软件版1楼: 如题,
在win2000控制台中用net use可以获取本机的网络连接列表,如何用编程实现.
dwBufSize : DWORD;
pNR, pBuf : PNetResourceA;
dwRet : DWORD;
ChildNode : TTreeNode;
begin
dwRet := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0,
pNetNode, hEnum);
if dwRet <> NO_ERROR then
Exit;
dwBufSize := 1000;
GetMem(pBuf, dwBufSize);
try
while True do
begin
dwCount := $FFFFFFFF; // alle Items anfordern
dwRet := WNetEnumResource(hEnum, dwCount, pBuf, dwBufSize);
if dwRet = ERROR_MORE_DATA then
begin
// der Startwert von 1000 war zu klein
dwCount := $FFFFFFFF;
FreeMem(pBuf);
GetMem(pBuf, dwBufSize);
dwRet := WNetEnumResource(hEnum, dwCount, pBuf, dwBufSize);
end;
if dwRet = ERROR_NO_MORE_ITEMS then
Break; // Fertig !
if dwRet <> NO_ERROR then
Abort; // dwRet enthalt eine Fehlermeldung!
pNR := pBuf;
while dwCount > 0 do
begin
ChildNode := TV.Items.AddChild(TreeNode, pNR.lpRemoteName);
LoadNetNode(ChildNode, pNR);
Inc(pNR);
Dec(dwCount);
Inc(FPCCount);
end;
end;
finally
WNetCloseEnum(hEnum);
FreeMem(pBuf);
end;
end;
Comment from Cesario
Date: 06/06/2001 09:32AM PDT
Comment
Create a new Application
1. Add a TreeView
2. Add a Scrollbar
3. Add this field to the public part FPCCount : Integer;
ciao
cesario
Comment from Cesario
Date: 06/06/2001 09:37AM PDT
Comment
another exmaple:
Browsing for a Network Machine (ala Network Neighborhood)
From: mloeffler@teletrade.com (Michael J. Loeffler)
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.
{
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,＇＇(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;
{
Add child item to container denoted as current top;
this just adds a string for purposes such as being unable
to enumerate a container. That is, the container＇＇s shares
are not accessible to us.
}
procedure TfrmMain.AddShareString(TopContainerIndex: Integer;
ItemName: String);
begin
tvResources.Items.AddChild(tvResources.Items[TopContainerIndex],ItemName);
end;
{
Add a connection to the tree view.
Mostly used for persistent and currently connected
resources to be displayed.
}
procedure TfrmMain.AddConnection(NetRes: TNetResource);
var
ItemName: String;
begin
ItemName:=Trim(String(NetRes.lpLocalName));
if Trim(String(NetRes.lpRemoteName))<>＇＇＇＇ then
begin
if ItemName<>＇＇＇＇ then ItemName:=ItemName+＇＇ ＇＇;
ItemName:=ItemName+＇＇-> ＇＇+Trim(String(NetRes.lpRemoteName));
end;
tvResources.Items.Add(tvResources.Selected,ItemName);
end;
{
Expand all containers in the tree view:
}
procedure TfrmMain.mniExpandAllClick(Sender: TObject);
begin
tvResources.FullExpand;
end;
{
Collapse all containers in the tree view:
}
procedure TfrmMain.mniCollapseAllClick(Sender: TObject);
begin
tvResources.FullCollapse;
end;
{
Allow saving of tree view to a file:
}
procedure TfrmMain.mniSaveToFileClick(Sender: TObject);
begin
if dlgSave.Execute then
tvResources.SaveToFile(dlgSave.FileName);
end;
{
Allow loading of tree view from a file:
}
procedure TfrmMain.mniLoadFromFileClick(Sender: TObject);
begin
if dlgOpen.Execute then
tvResources.LoadFromFile(dlgOpen.FileName);
end;
{
Rebrowse:
}
procedure TfrmMain.btnOKClick(Sender: TObject);
begin
DoEnumeration;
end;
end.
Accepted Answer from inthe
Date: 06/06/2001 09:46AM PDT
Grade: A
Accepted Answer
Hi,
good example here of network enumeration:
http://www.delphifreestuff.com/examples/wnetexmp.html
example with listbox:
procedure EnumRemoteDrives(Items: TStringlist);
function EnumerateFunc(lpnr: PNetResource; Items: TStringList; DrillDepth: Integer): Boolean;
var
lpnrLocal: PNetResource;
hEnum:THandle;
dwResult, dwResultEnum, cbBuffer, cEntries: DWORD;
i: Integer;
p1:PChar;
p2:PnetResource;
s, t: string;
begin
dwResult := WNetOpenEnum(RESOURCE_GLOBALNET,RESOURCETYPE_DISK, 0, lpnr, hEnum);
if dwResult <> NO_ERROR then begin EnumerateFunc := False;
exit;
end;
cbBuffer := 32768;
cEntries := $FFFFFFFF;
lpnrLocal := PNetResource(GlobalAlloc(GPTR,cbBuffer));
repeat
dwResultEnum := WNetEnumResource(hEnum,cEntries, lpnrLocal, cbBuffer);
if dwResultEnum = NO_ERROR then begin
for i := 0 to cEntries - 1 do begin
p1 := PChar(lpnrLocal) + i *
SizeOf(TNetResource);
p2 := PNetResource(p1);
s := StrPas(p2^.lpRemoteName);
if Length(s) > 2 then
if (s[1] = ＇＇＼＇＇) and
(s[2] = ＇＇＼＇＇) then begin
t := Copy(s,
3, Length(s) - 2);
if Pos(＇＇＼＇＇, t)
<> 0 then
items.Add(s);
end;
if (p2.dwUsage and RESOURCEUSAGE_CONTAINER) = RESOURCEUSAGE_CONTAINER then
if DrillDepth < 3 then
EnumerateFunc(p2, Items, DrillDepth + 1);
end;
end;
until dwResultEnum = ERROR_NO_MORE_ITEMS;
GlobalFree(HGLOBAL(lpnrLocal));
dwResult := WNetCloseEnum(hEnum);
if dwResult <> NO_ERROR then begin EnumerateFunc := False;
exit;
end;
EnumerateFunc := True;
end;
begin
EnumerateFunc(nil, Items, 0);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
sl : tstringlist;
begin
sl := tstringlist.create;
EnumRemoteDrives(sl);
listbox1.items.addstrings(sl);
sl.free;
end;
Comment from ryan_sabarre
Date: 06/06/2001 10:18AM PDT
Author Comment
InThe No lists of networks found in my listbox its still
empty
Comment from inthe
Date: 06/06/2001 11:36AM PDT
Comment
really ？ it works great on our win2k network .
i get
＼＼compname1＼drivec
＼＼compname1＼drived
＼＼compname2＼drivec
etc..
maybe you have a domain and mine is only a workgroup is something to do with it..
did the treeview example from delphifreestuff work？
or Cesario＇＇s examples did they work？
do you have a server on domain etc？
Comment from inthe
Date: 06/06/2001 11:53AM PDT
Comment
try this one:
procedure EnumNetShares(List: TStrings);
procedure EnumFunc(NetResource: PNetResource);
var
Enum: THandle;
Count, BufferSize: DWORD;
Buffer: array[0..16384 div SizeOf(TNetResource)] of TNetResource;
i: Integer;
begin
if WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, NetResource,
Enum) = NO_ERROR then
try
Count := $FFFFFFFF;
BufferSize := SizeOf(Buffer);
while WNetEnumResource(Enum, Count, @Buffer, BufferSize) = NO_ERROR do
for i := 0 to Count - 1 do
begin
if Buffer[i].dwDisplayType = RESOURCEDISPLAYTYPE_SHARE then
List.Add(Buffer[i].lpRemoteName);
if (Buffer[i].dwUsage and RESOURCEUSAGE_CONTAINER) > 0 then
EnumFunc(@Buffer[i])
end;
finally
WNetCloseEnum(Enum);
end;
end;
begin
EnumFunc(nil);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
EnumNetShares(ListBox1.Items);
end;
Comment from ryan_sabarre
Date: 06/06/2001 01:16PM PDT
Author Comment
Inthe your link program works VERY FINE and thanks for the
example i Edited the source
Comment from ryan_sabarre
Date: 06/06/2001 01:18PM PDT
Author Comment
I increase your points thanks
Comment from inthe
Date: 06/06/2001 01:25PM PDT
Comment
great thanks :-)
在win2000控制台中用net use可以获取本机的网络连接列表,如何用编程实现.
2楼: 笨办法
net use >c:＼1.txt
读c:＼1.txt 如易语言进销存源码
3楼: http://www.delphibbs.com/keylife/iblog_show.asp？xid=17853
4楼: 转一个
Comment from Cesario
Date: 06/06/2001 09:30AM PDT
Comment
Hi ryan,
you can use this exmaple with ( TreeView )
procedure TForm1.FormCreate(Sender: TObject);
begin
FPCCount := 0;
LoadNetNode(nil,nil);
StatBar.Panels[0].Text := Format(＇＇%d Objekte＇＇, [FPCCount]);
end;
{-------------------------------------------------------------}
{ Private Methoden }
{-------------------------------------------------------------}
procedure TForm1.LoadNetNode(TreeNode: TTreeNode; pNetNode: PNetResourceA);
var
hEnum : THandle;
dwCount : DWORD;
dwBufSize : DWORD;
pNR, pBuf : PNetResourceA;
dwRet : DWORD;
ChildNode : TTreeNode;
begin
dwRet := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0,
pNetNode, hEnum);
if dwRet <> NO_ERROR then
Exit;
dwBufSize := 1000;
GetMem(pBuf, dwBufSize);
try
while True do
begin
dwCount := $FFFFFFFF; // alle Items anfordern
dwRet := WNetEnumResource(hEnum, dwCount, pBuf, dwBufSize);
if dwRet = ERROR_MORE_DATA then
begin
// der Startwert von 1000 war zu klein
dwCount := $FFFFFFFF;
FreeMem(pBuf);
GetMem(pBuf, dwBufSize);
dwRet := WNetEnumResource(hEnum, dwCount, pBuf, dwBufSize);
end;
if dwRet = ERROR_NO_MORE_ITEMS then
Break; // Fertig !
if dwRet <> NO_ERROR then
Abort; // dwRet enthalt eine Fehlermeldung!
pNR := pBuf;
while dwCount > 0 do
begin
ChildNode := TV.Items.AddChild(TreeNode, pNR.lpRemoteName);
LoadNetNode(ChildNode, pNR);
Inc(pNR);
Dec(dwCount);
Inc(FPCCount);
end;
end;
finally
WNetCloseEnum(hEnum);
FreeMem(pBuf);
end;
end;
Comment from Cesario
Date: 06/06/2001 09:32AM PDT
Comment
Create a new Application
1. Add a TreeView
2. Add a Scrollbar
3. Add this field to the public part FPCCount : Integer;
ciao
cesario
Comment from Cesario
Date: 06/06/2001 09:37AM PDT
Comment
another exmaple:
Browsing for a Network Machine (ala Network Neighborhood)
From: mloeffler@teletrade.com (Michael J. Loeffler)
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.
{
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,＇＇
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;
{
Add child item to container denoted as current top;
this just adds a string for purposes such as being unable
to enumerate a container. That is, the container＇＇s shares
are not accessible to us.
}
procedure TfrmMain.AddShareString(TopContainerIndex: Integer;
ItemName: String);
begin
tvResources.Items.AddChild(tvResources.Items[TopContainerIndex],ItemName);
end;
{
Add a connection to the tree view.
Mostly used for persistent and currently connected
resources to be displayed.
}
procedure TfrmMain.AddConnection(NetRes: TNetResource);
var
ItemName: String;
begin
ItemName:=Trim(String(NetRes.lpLocalName));
if Trim(String(NetRes.lpRemoteName))<>＇＇＇＇ then
begin
if ItemName<>＇＇＇＇ then ItemName:=ItemName+＇＇ ＇＇;
ItemName:=ItemName+＇＇-> ＇＇+Trim(String(NetRes.lpRemoteName));
end;
tvResources.Items.Add(tvResources.Selected,ItemName);
end;
{
Expand all containers in the tree view:
}
procedure TfrmMain.mniExpandAllClick(Sender: TObject);
begin
tvResources.FullExpand;
end;
{
Collapse all containers in the tree view:
}
procedure TfrmMain.mniCollapseAllClick(Sender: TObject);
begin
tvResources.FullCollapse;
end;
{
Allow saving of tree view to a file:
}
procedure TfrmMain.mniSaveToFileClick(Sender: TObject);
begin
if dlgSave.Execute then
tvResources.SaveToFile(dlgSave.FileName);
end;
{
Allow loading of tree view from a file:
}
procedure TfrmMain.mniLoadFromFileClick(Sender: TObject);
begin
if dlgOpen.Execute then
tvResources.LoadFromFile(dlgOpen.FileName);
end;
{
Rebrowse:
}
procedure TfrmMain.btnOKClick(Sender: TObject);
begin
DoEnumeration;
end;
end.
Accepted Answer from inthe
Date: 06/06/2001 09:46AM PDT
Grade: A
Accepted Answer
Hi,
good example here of network enumeration:
http://www.delphifreestuff.com/examples/wnetexmp.html
example with listbox:
procedure EnumRemoteDrives(Items: TStringlist);
function EnumerateFunc(lpnr: PNetResource; Items: TStringList; DrillDepth: Integer): Boolean;
var
lpnrLocal: PNetResource;
hEnum:THandle;
dwResult, dwResultEnum, cbBuffer, cEntries: DWORD;
i: Integer;
p1:PChar;
p2:PnetResource;
s, t: string;
begin
dwResult := WNetOpenEnum(RESOURCE_GLOBALNET,RESOURCETYPE_DISK, 0, lpnr, hEnum);
if dwResult <> NO_ERROR then begin EnumerateFunc := False;
exit;
end;
cbBuffer := 32768;
cEntries := $FFFFFFFF;
lpnrLocal := PNetResource(GlobalAlloc(GPTR,cbBuffer));
repeat
dwResultEnum := WNetEnumResource(hEnum,cEntries, lpnrLocal, cbBuffer);
if dwResultEnum = NO_ERROR then begin
for i := 0 to cEntries - 1 do begin
p1 := PChar(lpnrLocal) + i *
SizeOf(TNetResource);
p2 := PNetResource(p1);
s := StrPas(p2^.lpRemoteName);
if Length(s) > 2 then
if (s[1] = ＇＇＼＇＇) and
(s[2] = ＇＇＼＇＇) then begin
t := Copy(s,
3, Length(s) - 2);
if Pos(＇＇＼＇＇, t)
<> 0 then
items.Add(s);
end;
if (p2.dwUsage and RESOURCEUSAGE_CONTAINER) = RESOURCEUSAGE_CONTAINER then
if DrillDepth < 3 then
EnumerateFunc(p2, Items, DrillDepth + 1);
end;
end;
until dwResultEnum = ERROR_NO_MORE_ITEMS;
GlobalFree(HGLOBAL(lpnrLocal));
dwResult := WNetCloseEnum(hEnum);
if dwResult <> NO_ERROR then begin EnumerateFunc := False;
exit;
end;
EnumerateFunc := True;
end;
begin
EnumerateFunc(nil, Items, 0);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
sl : tstringlist;
begin
sl := tstringlist.create;
EnumRemoteDrives(sl);
listbox1.items.addstrings(sl);
sl.free;
end;
Comment from ryan_sabarre
Date: 06/06/2001 10:18AM PDT
Author Comment
InThe No lists of networks found in my listbox its still
empty
Comment from inthe
Date: 06/06/2001 11:36AM PDT
Comment
really ？ it works great on our win2k network .
i get
＼＼compname1＼drivec
＼＼compname1＼drived
＼＼compname2＼drivec
etc..
maybe you have a domain and mine is only a workgroup is something to do with it..
did the treeview example from delphifreestuff work？
or Cesario＇＇s examples did they work？
do you have a server on domain etc？
Comment from inthe
Date: 06/06/2001 11:53AM PDT
Comment
try this one:
procedure EnumNetShares(List: TStrings);
procedure EnumFunc(NetResource: PNetResource);
var
Enum: THandle;
Count, BufferSize: DWORD;
Buffer: array[0..16384 div SizeOf(TNetResource)] of TNetResource;
i: Integer;
begin
if WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, NetResource,
Enum) = NO_ERROR then
try
Count := $FFFFFFFF;
BufferSize := SizeOf(Buffer);
while WNetEnumResource(Enum, Count, @Buffer, BufferSize) = NO_ERROR do
for i := 0 to Count - 1 do
begin
if Buffer[i].dwDisplayType = RESOURCEDISPLAYTYPE_SHARE then
List.Add(Buffer[i].lpRemoteName);
if (Buffer[i].dwUsage and RESOURCEUSAGE_CONTAINER) > 0 then
EnumFunc(@Buffer[i])
end;
finally
WNetCloseEnum(Enum);
end;
end;
begin
EnumFunc(nil);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
EnumNetShares(ListBox1.Items);
end;
Comment from ryan_sabarre
Date: 06/06/2001 01:16PM PDT
Author Comment
Inthe your link program works VERY FINE and thanks for the
example i Edited the source
Comment from ryan_sabarre
Date: 06/06/2001 01:18PM PDT
Author Comment
I increase your points thanks
Comment from inthe
Date: 06/06/2001 01:25PM PDT
Comment
great thanks :-)
5楼: to yitang: 没有api函数能实现此功能吗？
to tseug: 你贴的我试过了,是枚举网上邻居的.
我要的是用win32 api 获取本机与其它电脑的建立的IPC$连接.
6楼: 楼主怎么说了要API又不要了，让人费解
那请试下用WinExec或ShellExecute调用DOS命令，并获取返回信息
销售管理软件版7楼: 我说的是不想用net use , 要用win32 api实现.
8楼: Open时使用RESOURCE_CONNECTED就行了
WNetOpenEnum(RESOURCE_CONNECTED , RESOURCETYPE_ANY, 0,
pNetNode, hEnum);
9楼: [:D]看来我是无聊到了一种境界，自己验证了一把
var lpNetRes: PNetResource;
lphEnum: THandle;
lpcCount, lpBufferSize: DWORD;
lpBuffer, lpGo: PNetResource;
i, dwResultEnum: integer;
begin
mmo1.Lines.Clear;
lpNetRes := nil;
lphEnum := 0;
if WNetOpenEnum(RESOURCE_CONNECTED, RESOURCETYPE_ANY, 0, lpNetRes, lphEnum)
= NO_ERROR then
begin
//参考ms-help://MS.MSDNQTR.2003FEB.2052/wnet/wnet/enumerating_network_resources.htm
repeat
FillChar(lpBuffer^, lpBufferSize, 0);
dwResultEnum := WNetEnumResource(lphEnum, lpcCount,
lpBuffer, lpBufferSize);
if dwResultEnum = NO_ERROR then
begin
lpGo := lpBuffer;
for i := 1 to lpcCount do
begin
mmo1.Lines.Add(＇＇----------------＇＇ + IntToStr(i) + ＇＇-------------＇＇);
mmo1.Lines.Add(＇＇RemoteName=＇＇ + lpGo^.lpRemoteName);
mmo1.Lines.Add(＇＇LocalName=＇＇ + lpGo^.lpLocalName);
mmo1.Lines.Add(＇＇Provider=＇＇ + lpGo^.lpProvider);
mmo1.Lines.Add(＇＇Comment=＇＇ + lpGo^.lpComment);
if i <> lpcCount then inc(lpGo);
end;// for i
end
else
begin
if dwResultEnum <> ERROR_NO_MORE_ITEMS then Break;
end;// if
until dwResultEnum = ERROR_NO_MORE_ITEMS;
WNetCloseEnum(lphEnum);
end;// if
end;
10楼: 谢谢大家, 祝大家春节愉快!
11楼: 多人接受答案了。
联系我们
