DICAS

Visite a biblioteca de dicas da comunidade.

Saiba mais

ARTIGOS

Abordagens detalhadas sobre assuntos diversos.

Saiba mais

INICIANTES

Aprenda a programar de um modo simples e fácil.

Saiba mais

DOWNLOADS

Acesse os materiais exclusivos aos membros.

Saiba mais
voltar

PARA QUEM GOSTA DE DELPHI

Como listar todos os computadores de uma rede?

Para esta dica, foi criado um novo projeto com um botão e
um listbox.

Veja como ficou o código fonte da unit:

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
unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
  Datasnap.DBClient, Vcl.Grids,
  Vcl.DBGrids, Vcl.Imaging.jpeg, Vcl.ComCtrls, Data.DB;
 
type
  PNetResourceArray = ^TNetResourceArray;
  TNetResourceArray = array [0 .. 100] of TNetResource;
 
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
 
  public
 
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
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;
 
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;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  ScanNetworkResources(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER,
    ListBox1.Items);
end;
 
end.

Testado com Delphi XE 7 no Windows 8.1.

Facebook Comments Box
  • InfusTec
  • 6.005 views
  • 0 comentários
  • 19 de abril de 2015

Está gostando do conteúdo? Considere pagar um cafezinho para nossa equipe!

Deixe um comentário

Ir ao topo

© 2024 Infus Soluções em Tecnologia - Todos os Direitos Reservados