1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Network, Buttons, WinInet, Psock, ComCtrls, Spin,
  WinSock,ShlObj, ActiveX;

type
  TForm1 = class(TForm)
    Button1: TButton;
    txt_ComputerName: TEdit;
    ListBox_PCs: TListBox;
    ListBox_Domain: TListBox;
    txt_LocalIP: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  PNetResourceArray = ^TNetResourceArray;
  TNetResourceArray = array[0..100] of TNetResource;


//Funktion Name der Computer im Netzwerk
function GetComputerNetName: string;
var
  buffer: array[0..255] of char;
  size: dword;
begin
  size := 256;
  if GetComputerName(buffer, size) then
    Result := buffer
  else
    Result := ''
end;

//Funktion IP anhand des Hostnames herauszubekommen
function GetIPFromHost(const HostName: string): string;
type
  TaPInAddr = array[0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var 
  phe: PHostEnt; 
  pptr: PaPInAddr; 
  i: Integer; 
  GInitData: TWSAData; 
begin 
  WSAStartup($101, GInitData); 
  Result := ''; 
  phe := GetHostByName(PChar(HostName)); 
  if phe = nil then Exit; 
  pPtr := PaPInAddr(phe^.h_addr_list); 
  i := 0; 
  while pPtr^[i] <> nil do 
  begin 
    Result := inet_ntoa(pptr^[i]^); 
    Inc(i); 
  end; 
  WSACleanup; 
end;

// Funktion zur Auflistung der Netwerkresourcen
function CreateNetResourceList(ResourceType: DWord;
                               NetResource: PNetResource; 
                               out Entries: DWord; 
                               out List: PNetResourceArray): Boolean; 
var 
  EnumHandle: THandle; 
  BufSize: DWord; 
  Res: DWord; 
begin 
  Result := False; 
  List := Nil; 
  Entries := 0; 
  if WNetOpenEnum(RESOURCE_GLOBALNET, 
                  ResourceType, 
                  0, 
                  NetResource, 
                  EnumHandle) = NO_ERROR then begin 
    try 
      BufSize := $4000;   // 16 kByte 
      GetMem(List, BufSize); 
      try 
        repeat 
          Entries := DWord(-1); 
          FillChar(List^, BufSize, 0); 
          Res := WNetEnumResource(EnumHandle, Entries, List, BufSize); 
          if Res = ERROR_MORE_DATA then begin 
            ReAllocMem(List, BufSize); 
          end; 
        until Res <> ERROR_MORE_DATA; 

        Result := Res = NO_ERROR; 
        if not Result then begin 
          FreeMem(List); 
          List := Nil; 
          Entries := 0; 
        end; 
      except 
        FreeMem(List); 
        raise; 
      end; 
    finally 
      WNetCloseEnum(EnumHandle); 
    end; 
  end; 
end;

//Funktion um Computer von der Netzwerkumgebung auszuwählen
function BrowseComputer(DialogTitle: string; var CompName: string; 
  bNewStyle: Boolean): Boolean; 
  // bNewStyle: If True, this code will try to use the "new" 
  // BrowseForFolders UI on Windows 2000/XP 
const 
  BIF_USENEWUI = 28; 
var 
  BrowseInfo: TBrowseInfo;
  ItemIDList: PItemIDList; 
  ComputerName: array[0..MAX_PATH] of Char; 
  Title: string;
  WindowList: Pointer;
  ShellMalloc: IMalloc;
begin 
  if Failed(SHGetSpecialFolderLocation(Application.Handle, CSIDL_NETWORK, 
ItemIDList)) then 
    raise Exception.Create('Unable open browse computer dialog'); 
  try 
    FillChar(BrowseInfo, SizeOf(BrowseInfo), 0); 
    BrowseInfo.hwndOwner := Application.Handle; 
    BrowseInfo.pidlRoot := ItemIDList; 
    BrowseInfo.pszDisplayName := ComputerName; 
    Title := DialogTitle; 
    BrowseInfo.lpszTitle := PChar(Pointer(Title)); 
    if bNewStyle then 
      BrowseInfo.ulFlags := BIF_BROWSEFORCOMPUTER or BIF_USENEWUI 
    else 
      BrowseInfo.ulFlags := BIF_BROWSEFORCOMPUTER; 
    WindowList := DisableTaskWindows(0); 
    try 
      Result := SHBrowseForFolder(BrowseInfo) <> nil; 
    finally 
      EnableTaskWindows(WindowList); 
    end; 
    if Result then CompName := ComputerName; 
  finally 
    if Succeeded(SHGetMalloc(ShellMalloc)) then 
      ShellMalloc.Free(ItemIDList); 
  end; 
end;

//Aufruf der Netzwerkresourcen
procedure GetNetResourceList(AResourceType, ADisplayType: DWord;
                             const ARemoteName: String; AList: TStrings);
type
  PNetResourceArray = ^TNetResourceArray;
  TNetResourceArray = array[0..100] of TNetResource; 
var 
  EnumHandle  : THandle; 
  NetResource : TNetResource; 
  Buf         : PNetResourceArray; 
  AllocBufSize, BufSize: DWord; 
  Entries     : DWord; 
  Res         : DWord; 
  i : Integer; 
begin 
  FillChar(NetResource, SizeOf(NetResource), 0); 
  with NetResource do begin 
    dwScope := RESOURCE_GLOBALNET; 
    dwType := AResourceType; 
    dwDisplayType := ADisplayType; 
    dwUsage := RESOURCEUSAGE_CONTAINER; 
    lpRemoteName := Pointer(ARemoteName); 
  end;
  if WNetOpenEnum(RESOURCE_GLOBALNET, 
                  AResourceType, 
                  0, 
                  @NetResource, 
                  EnumHandle) = NO_ERROR then begin 
    try 
      AllocBufSize := $4000;   // 16 kByte 
      GetMem(Buf, AllocBufSize); 
      try 
        repeat 
          Entries := DWord(-1); 
          BufSize := AllocBufSize; 
          FillChar(Buf^, BufSize, 0); 
          Res := WNetEnumResource(EnumHandle, 
                                  Entries, 
                                  Buf, 
                                  BufSize); 
          if (Res <> NO_ERROR) and (Res <> ERROR_MORE_DATA) then Break; 
 
          if Entries > 0 then begin 
            for i := 0 to Entries - 1 do begin 
              AList.Add(Buf[i].lpRemoteName); 
            end; 
          end; 
 
          if BufSize > AllocBufSize then begin 
            AllocBufSize := BufSize; 
            ReAllocMem(Buf, AllocBufSize); 
          end; 
        until False; 
      finally 
        FreeMem(Buf, AllocBufSize); 
      end; 
    finally 
      WNetCloseEnum(EnumHandle); 
    end; 
  end; 
end;

//Aufruf Suche Netzwerkresourcen
procedure ScanNetworkResources(ResourceType, DisplayType: DWord; List: TStrings); 

procedure ScanLevel(NetResource: PNetResource); 
var 
  Entries: DWord; 
  NetResourceList: PNetResourceArray; 
  i: Integer; 
begin 
  if CreateNetResourceList(ResourceType, NetResource, Entries, NetResourceList) then try 
    for i := 0 to Integer(Entries) - 1 do begin 
      if (DisplayType = RESOURCEDISPLAYTYPE_GENERIC) or 
         (NetResourceList[i].dwDisplayType = DisplayType) then begin 
        List.AddObject(NetResourceList[i].lpRemoteName, 
                       Pointer(NetResourceList[i].dwDisplayType)); 
      end; 
      if (NetResourceList[i].dwUsage and RESOURCEUSAGE_CONTAINER) <> 0 then 
        ScanLevel(@NetResourceList[i]); 
    end; 
  finally 
    FreeMem(NetResourceList); 
  end; 
end; 

begin 
  ScanLevel(Nil); 
end;

//Aufruf Zeige Netzwerkdrucker
procedure GetNetworkPrinterList(AList: TStrings); 
var
  Workgroups: TStringList;
  Computers: TStringList; 
  RemoteName: String; 
  i: Integer; 
begin 
  Workgroups := TStringList.Create; 
  try 
    // Get workgroups
    GetNetResourceList(RESOURCETYPE_PRINT, RESOURCEDISPLAYTYPE_GENERIC,
                       '', Workgroups); 
    if Workgroups.Count <= 0 then Exit; 
 
    Computers := TStringList.Create; 
    try 
      // Get Computers 
      for i := 0 to Workgroups.Count - 1 do begin 
        RemoteName := Workgroups[i]; 
        GetNetResourceList(RESOURCETYPE_PRINT, RESOURCEDISPLAYTYPE_GENERIC, 
                           RemoteName, Computers); 
      end; 
      if Computers.Count <= 0 then Exit; 
 
      // Get Shares 
      for i := 0 to Computers.Count - 1 do begin 
        RemoteName := Computers[i]; 
        GetNetResourceList(RESOURCETYPE_PRINT, RESOURCEDISPLAYTYPE_GENERIC, 
                           RemoteName, AList); 
      end; 
    finally 
      Computers.Free;
    end; 
  finally 
    Workgroups.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  { Zeigt den eigenen Computernamen an }
  txt_ComputerName.Text := GetComputerNetName;
  { Zeigt die Locale IP des eigenen Rechners an }
  txt_LocalIP.Text := GetIPFromHost(GetComputerNetName);
  { Listet alle Computer im Netzwerk auf }
  ScanNetworkResources(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER, ListBox_PCs.Items);
  { Zeigt den Domain-Namen / Arbeitgruppen-Namen im Netzwerk an }
  ScanNetworkResources(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_DOMAIN, ListBox_Domain.Items);
end;

end.					

1:
2:
3:
4:
5:
6:

procedure TForm1.Button1Click(Sender: TObject);
var comp: String;
begin
If BrowseComputer('Computer auswählen:',comp,false) then
 Showmessage('Sie haben den Computer '+comp+' ausgewählt');
end;					

1:
2:
3:
4:
5:
6:

uses ..., ShellApi;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(0,'explore',PChar('\\'+Edit1.Text),nil,'',SW_SHOW);
end;					

1:
2:
3:
4:

procedure TForm1.Button1Click(Sender: TObject);
begin
 GetNetworkPrinterList(Memo1.Lines);
end;