Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Обзор сети (типа Network Neighborhood - Сетевое Окружение)

Сеть - это дырки, связанные веревками.

В свое время я начал писать эту утилиту для своего развлечения, шутки ради. Она так и осталась незавершенной. Не знаю, хватит ли времени и желания дописать ее теперь. Но тем не менее вы можете использовать ее в качестве отправной точки для создания чего-то покруче. Я надеюсь, что приведеный здесь код поможет понять технологию поиска сетевых машин и мой труд не пропадет даром. 


{
Сетевая утилита. Аналогична функции NetWork-
Neighborhood - Сетевое Окружение.
}

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;

{

Перечисляем все сетевые ресурсы:
}

procedure TfrmMain.DoEnumeration;
var

  NetRes: array[0..2] of TNetResource;
  Loop: Integer;
  r, hEnum, EntryCount, NetResLen: DWORD;
begin

  case grpListType.ItemIndex of
    { Подключенные ресурсы: }
    1: ListType := RESOURCE_CONNECTED;
    { Возобновляемые ресурсы: }
    2: ListType := RESOURCE_REMEMBERED;
    { Глобальные: }
  else
    ListType := RESOURCE_GLOBALNET;
  end;

  case grpResourceType.ItemIndex of
    { Дисковые ресурсы: }
    1: ResourceType := RESOURCETYPE_DISK;
    { Принтерные ресурсы: }
    2: ResourceType := RESOURCETYPE_PRINT;
    { Все: }
  else
    ResourceType := RESOURCETYPE_ANY;
  end;

  Screen.Cursor := crHourGlass;

  try
    { Удаляем любые старые элементы из дерева: }
    for Loop := tvResources.Items.Count - 1 downto 0 do
      tvResources.Items[Loop].Delete;
  except
  end;

  { Начинаем перечисление: }
  r := WNetOpenEnum(ListType, ResourceType, 0, nil, hEnum);
  if r <> NO_ERROR then
  begin
    if r = ERROR_EXTENDED_ERROR then
      MessageDlg('Невозможно сделать обзор сети.' + #13 +
        'Произошла сетевая ошибка.', mtError, [mbOK], 0)
    else
      MessageDlg('Невозможно сделать обзор сети.',
        mtError, [mbOK], 0);
    Exit;
  end;

  try
    { Мы получили правильный дескриптор перечисления; опрашиваем ресурсы: }
    while (1 = 1) do
    begin
      EntryCount := 1;
      NetResLen := SizeOf(NetRes);
      r := WNetEnumResource(hEnum, EntryCount, @NetRes, NetResLen);
      case r of
        0:
          begin
            { Это контейнер, организуем итерацию: }
            if NetRes[0].dwUsage = RESOURCEUSAGE_CONTAINER then
              DoEnumerationContainer(NetRes[0])
            else
              { Здесь получаем подключенные и возобновляемые ресурсы: } if ListType
                in [RESOURCE_REMEMBERED, RESOURCE_CONNECTED] then

                AddConnection(NetRes[0]);
          end;

        { Получены все ресурсы: }
        ERROR_NO_MORE_ITEMS: Break;
        { Другие ошибки: }
      else
        begin
          MessageDlg('Ошибка опроса ресурсов.', mtError, [mbOK], 0);
          Break;
        end;
      end;
    end;

  finally
    Screen.Cursor := crDefault;
    { Закрываем дескриптор перечисления: }
    WNetCloseEnum(hEnum);
  end;
end;

{

Перечисление заданного контейнера:
Данная функция обычно вызывается рекурсивно.
}

procedure TfrmMain.DoEnumerationContainer(NetResContainer:
  TNetResource);
var

  NetRes: array[0..10] of TNetResource;
  TopContainerIndex: Integer;
  r, hEnum, EntryCount, NetResLen: DWORD;
begin

  { Добавляем имя контейнера к найденным сетевым ресурсам: }
  AddContainer(NetResContainer);
  { Делаем этот элемент текущим корневым уровнем: }
  TopContainerIndex := tvResources.Items.Count - 1;
  { Начинаем перечисление: }
  if ListType = RESOURCE_GLOBALNET then
    { Перечисляем глобальные объекты сети: }
    r := WNetOpenEnum(ListType, ResourceType, RESOURCEUSAGE_CONTAINER,
      @NetResContainer, hEnum)
  else
    { Перечисляем подключаемые и возобновляемые ресурсы (другие получить здесь невозможно):
    }

    r := WNetOpenEnum(ListType, ResourceType, RESOURCEUSAGE_CONTAINER,
      nil, hEnum);
  { Невозможно перечислить ресурсы данного контейнера;
  выводим соответствующее предупреждение и едем дальше: }
  if r <> NO_ERROR then
  begin
    AddShareString(TopContainerIndex, '<Не могу опросить ресурсы
      (Ошибка #'+

      IntToStr(r) + '>');
      WNetCloseEnum(hEnum);
      Exit;
  end;

  { Мы получили правильный дескриптор перечисления; опрашиваем ресурсы: }
  while (1 = 1) do
  begin
    EntryCount := 1;
    NetResLen := SizeOf(NetRes);
    r := WNetEnumResource(hEnum, EntryCount, @NetRes, NetResLen);
    case r of
      0:
        begin
          { Другой контейнер для перечисления;
          необходим рекурсивный вызов: }
          if (NetRes[0].dwUsage = RESOURCEUSAGE_CONTAINER) or
            (NetRes[0].dwUsage = 10) then
            DoEnumerationContainer(NetRes[0])
          else
            case NetRes[0].dwDisplayType of
              { Верхний уровень: }
              RESOURCEDISPLAYTYPE_GENERIC,
                RESOURCEDISPLAYTYPE_DOMAIN,
                RESOURCEDISPLAYTYPE_SERVER: AddContainer(NetRes[0]);
              { Ресурсы общего доступа: }
              RESOURCEDISPLAYTYPE_SHARE:
                AddShare(TopContainerIndex, NetRes[0]);

            end;
        end;
      ERROR_NO_MORE_ITEMS: Break;
    else
      begin
        MessageDlg('Ошибка #' + IntToStr(r) + ' при перечислении
          ресурсов.',mtError,[mbOK],0);
          Break;
      end;
    end;
  end;

  { Закрываем дескриптор перечисления: }
  WNetCloseEnum(hEnum);
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin

  DoEnumeration;
end;

{

Добавляем элементы дерева; помечаем, что это контейнер:
}

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;

{

Добавляем дочерние элементы к контейнеру, обозначенному как текущий верхний уровень:
}

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;

{

Добавляем дочерние элементы к контейнеру, обозначенному как текущий верхний уровень;
это просто добавляет строку для таких задач, как, например,
перечисление контейнера. То есть некоторые контейнерные
ресурсы общего доступа нам не доступны.
}

procedure TfrmMain.AddShareString(TopContainerIndex: Integer;
  ItemName: string);
begin

  tvResources.Items.AddChild(tvResources.Items[TopContainerIndex], ItemName);
end;

{

Добавляем соединения к дереву.
По большому счету к этому моменту все сетевые ресурсы типа
возобновляемых и текущих соединений уже отображены.
}

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;

{

Раскрываем все контейнеры дерева:
}

procedure TfrmMain.mniExpandAllClick(Sender: TObject);
begin

  tvResources.FullExpand;
end;

{

Схлопываем все контейнеры дерева:
}

procedure TfrmMain.mniCollapseAllClick(Sender: TObject);
begin

  tvResources.FullCollapse;
end;

{

Записываем дерево в выбранном файле:
}

procedure TfrmMain.mniSaveToFileClick(Sender: TObject);
begin

  if dlgSave.Execute then
    tvResources.SaveToFile(dlgSave.FileName);
end;

{

Загружаем дерево из выбранного файла:
}

procedure TfrmMain.mniLoadFromFileClick(Sender: TObject);
begin

  if dlgOpen.Execute then
    tvResources.LoadFromFile(dlgOpen.FileName);
end;

{

Обновляем:
}

procedure TfrmMain.btnOKClick(Sender: TObject);
begin

  DoEnumeration;
end;

end.

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.