:: MVP ::
|
|
:: RSS ::
|
|
|
Как получить IP-адрес?
// Способ первый
// На компьютере может быть установлено несколько сетевых
// плат, тогда у этого компьютера будет несколько IP-адресов.
// Эта процедура найдет все IP-адреса.
uses
{...,} WinSock;
procedure TForm1.Button1Click(Sender: TObject);
type
InAddr = array [0..10] of PInAddr;
TInAddr = ^InAddr;
var
Host: PHostEnt;
pPtr: TInAddr;
Buffer: array [0..63] of AnsiChar;
i: Integer;
Socket: TWSAData;
begin
ListBox1.Clear;
WSAStartup($101, Socket);
GetHostName(Buffer, SizeOf(Buffer));
Host := GetHostByName(Buffer);
if Host = nil then
Exit;
i := 0;
pPtr := TInAddr(Host^.h_addr_list);
while pPtr^[i] <> nil do
begin
ListBox1.Items.Add(inet_ntoa(pPtr^[i]^));
Inc(i);
end;
WSACleanup;
end;
// Способ второй
uses
IdStack;
function LocalIP: string;
var
AAddresses: TStrings;
begin
AAddresses := TStringList.Create;
try
TIdStack.IncUsage;
try
GStack.AddLocalAddressesToList( AAddresses );
finally
TIdStack.DecUsage;
end;
if AAddresses.Count > 0 then
Result := AAddresses.Strings[0];
finally
AAddresses.Free;
end;
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
ShowMessage( LocalIP );
end;
// Способ третий
// С помощью TIdUDPServer посылаем широковещательное сообщение, и с его же помощью
// сами получаем его и в ABinding узнаем с какого IP оно пришло. Таким образом мы
// узнаем IP адрес интерфейса с маршрутом по умолчанию.
uses
{...,} IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer, IdGlobal, IdSocketHandle;
type
TForm1 = class(TForm)
IdUDPServer: TIdUDPServer;
private
FMyIP: string;
procedure OnUDPServerUDPRead(AThread: TIdUDPListenerThread;
const AData: TIdBytes; ABinding: TIdSocketHandle);
{...}
end;
var
Form1: TForm1;
implementation
const
ConstUDPSendString = 'eryt54634edf';
procedure TForm1.Button1Click(Sender: TObject);
begin
IdUDPServer := TIdUDPServer.Create;
IdUDPServer.DefaultPort := 46734;
IdUDPServer.BroadcastEnabled := True;
IdUDPServer.OnUDPRead := OnUDPServerUDPRead;
IdUDPServer.Active := True;
IdUDPServer.Broadcast(ConstUDPSendString, IdUDPServer.DefaultPort);
while FMyIP = '' do
Application.ProcessMessages;
ShowMessage(FMyIP);
IdUDPServer.Destroy;
end;
procedure TForm1.OnUDPServerUDPRead(AThread: TIdUDPListenerThread;
const AData: TIdBytes; ABinding: TIdSocketHandle);
begin
AThread.Synchronize(AThread,
procedure
begin
if BytesToString(AData).Equals(ConstUDPSendString) and FMyIP.IsEmpty then
FMyIP := ABinding.PeerIP;
end
);
end;
|
Как получить список компьютеров в рабочей группе?
procedure TForm1.FindAllComputers(Workgroup: String);
var
Computer: array[1..500] of string[25];
ComputerCount: integer;
EnumHandle: THandle;
WorkgroupRS: TNetResource;
Buf: array[1..500] of TNetResource;
BufSize: cardinal;
Entries: cardinal;
Result: integer;
i: integer;
begin
ComputerCount := 0;
Workgroup := Workgroup + #0;
FillChar( WorkgroupRS, SizeOf( WorkgroupRS ) , 0 );
With WorkgroupRS do
begin
dwScope := 2;
dwType := 3;
dwDisplayType := 1;
dwUsage := 2;
lpRemoteName := @Workgroup[1];
end;
WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @WorkgroupRS, EnumHandle );
Repeat
Entries := 1;
BufSize := SizeOf( Buf );
Result := WNetEnumResource( EnumHandle, Entries, @Buf, BufSize );
If ( Result = NO_ERROR ) and ( Entries = 1 ) then
begin
Inc( ComputerCount );
Computer[ComputerCount] := StrPas( Buf[1].lpRemoteName );
end;
Until ( Entries <> 1 ) or ( Result <> NO_ERROR );
WNetCloseEnum( EnumHandle );
for i := 1 to ComputerCount do
ListBox1.Items.Add( Computer[i] );
end;
|
Как получить доменное имя по IP-адресу?
uses
{...,} WinSock;
function TForm1.IPAddrToName(IPAddr : String): String;
var
SockAddrIn: TSockAddrIn;
HostEnt: PHostEnt;
WSAData: TWSAData;
begin
WSAStartup( $101, WSAData );
SockAddrIn.sin_addr.s_addr := inet_addr( PChar( IPAddr ) );
HostEnt := gethostbyaddr( @SockAddrIn.sin_addr.S_addr, 4, AF_INET );
if HostEnt <> nil then
result := StrPas( Hostent^.h_name )
else
result := '';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Form1.Caption := IPAddrToName( Edit1.Text );
end;
|
Как получить IP-адрес по доменному имени?
uses
{...,} WinSock;
function TForm1.HostToIP(Name: string; var Ip: string): boolean;
var
wsdata: TWSAData;
hostName: array [0..255] of char;
hostEnt: PHostEnt;
addr: PChar;
begin
WSAStartup( $0101, wsdata );
try
gethostname( hostName, sizeof( hostName ) );
StrPCopy( hostName, Name );
hostEnt := gethostbyname( hostName );
if Assigned( hostEnt ) then
if Assigned( hostEnt^.h_addr_list ) then
begin
addr := hostEnt^.h_addr_list^;
if Assigned( addr ) then
begin
Ip := Format( '%d.%d.%d.%d', [byte( addr[0] ),
byte( addr[1] ),
byte( addr[2] ),
byte( addr[3] )] );
Result := true;
end
else
Result := false;
end
else
Result := false
else
Result := false;
finally
WSACleanup;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
IP: string;
begin
if HostToIp( 'www.decoding.dax.ru', IP ) then
Caption := IP
else
Caption := 'не определено';
end;
|
Как просканировать все домены в локальной сети?
var
Form1: TForm1;
NetResource: PNetResource;
ts: TStrings;
function TForm1.FillNetLevel(NetRes: PNetResource; list: TStrings): Word;
type
PNRArr = ^TNRArr;
TNRArr = array[0..59] of TNetResource;
var
x: PNRArr;
tnr: TNetResource;
i: integer;
EntrReq,
SizeReq,
twx: Cardinal;
WSName: string;
begin
Result := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_ANY,
RESOURCEUSAGE_CONTAINER, NetRes, 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_DOMAIN: begin
if tnr.lpRemoteName <> '' then
WSName := tnr.lpRemoteName
else
WSName:= tnr.lpComment;
list.Add( WSName );
end;
else
FillNetLevel( @tnr, list );
end;
end;
end;
Dispose( x );
WNetCloseEnum( twx );
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ts := TStringList.Create;
FillNetLevel( NetResource, ts );
ListBox1.Items := ts;
end;
|
Как узнать все доступные сетевые pесуpсы?
uses
{...,} ComCtrls;
type
PNetResourceArray = ^TNetResourceArray;
TNetResourceArray = array[0..MaxInt div SizeOf( TNetResource )-1] of TNetResource;
procedure EnumResources(LpNR: PNetResource);
var
NetHandle: THandle;
BufSize: integer;
Size: integer;
NetResources: PNetResourceArray;
Count: Integer;
NetResult: integer;
i: integer;
NewItem: TListItem;
begin
if WNetOpenEnum( RESOURCE_GLOBALNET,
RESOURCETYPE_ANY,
// RESOURCETYPE_ANY - все ресурсы
// RESOURCETYPE_DISK - диски
// RESOURCETYPE_PRINT - принтеры
0, LpNR, NetHandle) <> NO_ERROR then Exit;
try
BufSize := 50 * SizeOf( TNetResource );
GetMem( NetResources, BufSize );
try
while true do
begin
Count := -1;
Size := BufSize;
NetResult := WNetEnumResource( NetHandle, Cardinal( Count ), NetResources, Cardinal( Size ) );
if NetResult = ERROR_MORE_DATA then
begin
BufSize := Size;
ReallocMem( NetResources, BufSize );
Continue;
end;
if NetResult <> NO_ERROR then Exit;
for i := 0 to Count-1 do
begin
with NetResources^[I] do
begin
if RESOURCEUSAGE_CONTAINER = ( DwUsage and RESOURCEUSAGE_CONTAINER ) then
EnumResources(@NetResources^[I]);
if dwDisplayType = RESOURCEDISPLAYTYPE_SHARE then
// ^^^^^^^^^^^^^^^^^^^^^^^^^^ - ресурс
// RESOURCEDISPLAYTYPE_SERVER - компьютер
// RESOURCEDISPLAYTYPE_DOMAIN - рабочая группа
// RESOURCEDISPLAYTYPE_GENERIC - сеть
begin
NewItem := Form1.ListView1.Items.Add;
NewItem.Caption := LpRemoteName;
end;
end;
end;
end;
finally
FreeMem( NetResources, BufSize );
end;
finally
WNetCloseEnum( NetHandle );
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
OldCursor: TCursor;
begin
OldCursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
with ListView1.Items do
begin
BeginUpdate;
Clear;
EnumResources( nil );
EndUpdate;
end;
Screen.Cursor := OldCursor;
end;
|
Как изменить NetBios-имя компьютера?
function SetComputerName( AComputerName: string ): boolean;
var
ComputerName: array[0..MAX_COMPUTERNAME_LENGTH + 1] of Char;
begin
StrPCopy( ComputerName, AComputerName );
Result := Windows.SetComputerName( ComputerName );
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if SetComputerName( 'NewName' ) then
ShowMessage( 'Новое имя начнет использоваться после перезагрузки.' )
else
ShowMessage( 'Не удалось изменить имя.' );
end;
|
Как синхронизировать два компьютера по времени?
// В качестве параметра передается IP или имя
// компьютера, с которым нужно синхронизироваться
procedure SynchronizationComp( Server: string );
begin
WinExec( PAnsiChar( 'net time \\' + Server + ' /set /yes' ), SW_HIDE );
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SynchronizationComp( '10.0.0.1' );
end;
|
Как получить время удаленного компьютера?
// Пример использования NetRemoteTOD
type
PTIME_OF_DAY_INFO = ^TIME_OF_DAY_INFO;
TIME_OF_DAY_INFO = record
tod_elapsedt : DWORD;
tod_msecs : DWORD;
tod_hours : DWORD;
tod_mins : DWORD;
tod_secs : DWORD;
tod_hunds : DWORD;
tod_timezone : Longint;
tod_tinterval: DWORD;
tod_day : DWORD;
tod_month : DWORD;
tod_year : DWORD;
tod_weekday : DWORD;
end;
function NetRemoteTOD(Server: PWChar; var pBuffer: PTIME_OF_DAY_INFO): DWORD;
stdcall; external 'NETAPI32.DLL';
function NetApiBufferFree(pBuffer: Pointer): DWORD;
stdcall; external 'NETAPI32.DLL';
{...}
implementation
{...}
procedure TForm1.Button1Click(Sender: TObject);
var
TOD: PTIME_OF_DAY_INFO;
begin
if NetRemoteTOD( '\\10.0.5.160', TOD ) = 0 then
try
with TOD^ do
ShowMessage( Format( 'Data %.2d.%.2d.%.4d Time %.2d:%.2d:%.2d',
[tod_day, tod_month, tod_year,
tod_hours - ( tod_timezone div 60 ),
tod_mins, tod_secs] ) );
finally
NetApiBufferFree( TOD );
end
else
RaiseLastOSError;
end;
|
Как получить снимок с IP камеры?
uses
{...,} IdHTTP, jpeg;
type
TForm1 = class(TForm)
IdHTTP1: TIdHTTP;
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
MMS: TMemoryStream;
Jpg: TJPEGImage;
public
end;
implementation
procedure TForm1.FormCreate(Sender: TObject);
begin
MMS := TMemoryStream.Create;
Jpg := TJpegImage.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Jpg.Free;
MMS.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
MMS.Clear;
IdHTTP1.Get( 'http://10.0.7.203:8080/shot.jpg', MMS );
MMS.Position := 0;
Jpg.LoadFromStream( MMS );
Image1.Picture.Assign( Jpg );
end;
|
При использовании материала - ссылка на сайт обязательна
|
|