Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.
Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Выводит Список компьютеров в локальной сети
Так... писал для своих целей.
Этот код нужен часто... писать несложно ... разобраться легко
Код тестирован на 100%
Зависимости: Смотрите uses
Автор: Mirag, wwwMirage@yandex.ru, Mirag
Copyright: Mirag
Дата: 14 ноября 2002 г.
***************************************************** }
unit Net;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, Buttons, ImgList, ExtCtrls;
type
TNetForm = class
(TForm)
ListView1: TListView;
ImageList1: TImageList;
Button1: TButton;
Edit1: TEdit;
Timer: TTimer;
Label1: TLabel;
Button2: TButton;
{ procedure FormShow(Sender: TObject);}
procedure
BitBtn2Click(Sender: TObject);
procedure
BitBtn1Click(Sender: TObject);
procedure
Button1Click(Sender: TObject);
procedure
Button2Click(Sender: TObject);
procedure
TimerTimer(Sender: TObject);
procedure
FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
function
FillNetLevel(xxx: PNetResource; list: TListItems): Word;
function
GetComputer: string
;
end
;
var
NetForm: TNetForm;
name_server: integer;
implementation
uses
main, Info, Network_connect;
{$R *.DFM}
function
TNetForm.FillNetLevel(xxx: PNetResource; List: TListItems): Word;
type
PNRArr = ^TNRArr;
TNRArr = array
[0..59] of
TNetResource;
var
x: PNRArr;
tnr: TNetResource;
I: integer;
EntrReq,
SizeReq,
twx: THandle;
WSName: string
;
LI: TListItem;
begin
Result := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY,
RESOURCEUSAGE_CONTAINER, xxx, twx);
if
Result = ERROR_NO_NETWORK then
Exit;
if
Result = NO_ERROR then
begin
New(x);
EntrReq := 1;
SizeReq := SizeOf(TNetResource) * 59;
while
(twx <> 0) and
(WNetEnumResource(twx, EntrReq, x, SizeReq) <> ERROR_NO_MORE_ITEMS) do
begin
for
i := 0 to
EntrReq - 1 do
begin
Move(x^[i], tnr, SizeOf(tnr));
case
tnr.dwDisplayType of
RESOURCEDISPLAYTYPE_SERVER:
begin
if
tnr.lpRemoteName <> '' then
WSName := tnr.lpRemoteName
else
WSName := tnr.lpComment;
LI := list.Add;
LI.Caption := copy(WSName, 3, length(WSName) - 2);
//list.Add(WSName);
end
;
else
FillNetLevel(@tnr, list);
end
;
end
;
end
;
//Dispose(x);
WNetCloseEnum(twx);
end
;
end
;
{procedure TNetForm.FormShow(Sender: TObject);
begin
ListView1.Items.Clear;
FillNetLevel(nil,ListView1.Items);
end;}
function
TNetForm.GetComputer: string
;
begin
result := '';
if
(ShowModal = mrok) and
(ListView1.Selected <> nil
) then
result := ListView1.Selected.Caption;
end
;
procedure
TNetForm.BitBtn2Click(Sender: TObject);
begin
ModalResult := mrcancel;
end
;
procedure
TNetForm.BitBtn1Click(Sender: TObject);
begin
modalresult := mrok;
end
;
procedure
TNetForm.Button1Click(Sender: TObject);
var
i: integer;
j: integer;
name, k: string
;
begin
try
ListView1.Items.Clear;
FillNetLevel(nil
, ListView1.Items);
i := ListView1.Items.Count;
edit1.Text := IntToStr(i);
i := ListView1.Items.Count;
edit1.Text := IntToStr(i);
//i:=0;
if
i = 0 then
begin
Messagebox(0, 'Не найден ни один сетевой ресурс!' + #13#10+
'Вероятно ваша сеть неисправна!' + #13#10+
'Попробуйте перезагрузить компьютер.', 'Внимание!', MB_OK);
Main_form.Edit1.Text := 'FALSE';
end
;
if
i > 0 then
begin
Messagebox(0, 'Найдены сетевые ресурсы!' + #13#10+'Ваша сеть исправна!',
'Внимание!', MB_OK);
Main_form.Edit1.Text := 'TRUE';
end
;
button1.Enabled := false;
except
messagebox(0, 'Невозможно выполнить задачу', 'Внимание', MB_OK);
end
;
end
;
procedure
TNetForm.Button2Click(Sender: TObject);
begin
close;
end
;
procedure
TNetForm.TimerTimer(Sender: TObject);
begin
if
ListView1.Items.Count = 0 then
close;
end
;
procedure
TNetForm.FormCreate(Sender: TObject);
begin
button1.Enabled := true;
end
;
end
.