Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Сети";
Текущий архив: 2004.12.12;
Скачать: [xml.tar.bz2];

Вниз

Сканирование сети и проблемы с этим   Найти похожие ветки 

 
Stef   (2004-10-01 19:38) [0]

Подскажиете.
Программа осуществляет сканирование сети (какие компы и какие IP) (код ниже).
Когда происходит сканирование то обнавруживаются компы которые даже не включены. Они оставляют некий "след", из-за этого программа находит название компа но не может определить его IP и это приводит к тому что сканирование происходит долго.
Вопрос.
1. Подскажите как сделать что бы сканирование игнорировала "не существующие" на данный момент компов.
2. Почему вообще существует этот некий "след".

Вот код основных процедур:

....
Const
NetApi32 = "NetApi32.dll";
function NetMessageBufferSend(
     servername:PWideChar ;
     msgname:PWideChar ;
     fromname:PWideChar ;
     buf:PWideChar ;
     buflen:DWORD):DWORD;stdcall;

var
 Form1: TForm1;
 t: _Token_Privileges;
 ht: cardinal;
 rl: cardinal;
 Computer      : Array[1..500] of String[25];
 ComputerCount : Integer;
 EnumHandle  : THandle;
 WorkgroupRS : TNetResource;
 Buf         : Array[1..500] of TNetResource;
 BufSize     : Cardinal;{Integer;}
 Entriess    : Cardinal;{Integer;}
 Result      : Integer;
 Workgroup,g : String;

implementation

function NetMessageBufferSend; external NetApi32 name "NetMessageBufferSend";

{$R *.dfm}

function 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
begin
Result := False;
end;
finally
 WSACleanup;
end
end;

Function SendLanMessage(FromName,ToName:String;Text:String):Boolean;
Var
RName,TName,HostName: LPCWSTR;
buf: Pointer;
size: Integer;
Begin
Result:=True;
HostName:=nil;
size := SizeOf (WideChar) * Length (FromName)+1;
GetMem (RName, Size);
RName :=StringToWideChar (FromName, RName, Length (FromName)+1);
size := SizeOf (WideChar) * Length (ToName)+1;
GetMem (TName, Size);
TName :=StringToWideChar (ToName, TName, Length (ToName) + 1);
size := SizeOf (WideChar) * Length (text)+1;
GetMem (buf, Size);
 try
   PWideChar (Buf) := StringToWideChar (text, buf, Length (text) + 1);
   If NetMessageBufferSend (HostName, rname, tname, buf, size) <> NO_ERROR
     then  Result:=False;
 finally
   FreeMem(buf);
   if assigned(TNAME) then FreeMem(TName);
   if assigned(RNAME) then FreeMem(RName);
   if assigned(HOSTNAME) then FreeMem(HOSTNAME);
 end;
End;

function NetSend(const AMessage, AToComputer: AnsiString): LongWord;
type
TNetMessageBufferSend = function (ServerName, ToName, FromName: PWideChar;
Buffer: Pointer; BufLen: DWord): LongWord stdcall;
var
NetApi32: HMODULE;
NetMessageBufferSend: TNetMessageBufferSend;
MessageW, ToComputerW: WideString;
begin
Windows.SetLastError(NO_ERROR);
NetApi32 := LoadLibrary("NetApi32.dll");
if NetApi32 <= HINSTANCE_ERROR then
begin
  Result := Windows.GetLastError;
  Exit;
end;
try
  NetMessageBufferSend := GetProcAddress(NetApi32, "NetMessageBufferSend");
  if @NetMessageBufferSend = nil then
  begin
    Result := ERROR_INVALID_FUNCTION;
    Exit;
  end;
  MessageW := WideString(AMessage);
  ToComputerW := WideString(AToComputer);
  Result := NetMessageBufferSend(nil, PWideChar(ToComputerW), nil,
    PWideChar(MessageW), Length(MessageW) * SizeOf(WideChar));
finally
  FreeLibrary(NetApi32);
end;
end;

Procedure TForm1.Scan_set;
var i:integer;
   Computer : Array[1..500] of String[25];
   ComputerCount : Integer;
   IP: string;
begin
ComputerCount := 0;
Workgroup := EditSetGroupName.Text + #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
  Entriess := 1;
  BufSize := SizeOf(Buf);
  Result :=  WNetEnumResource( EnumHandle,Entriess,@Buf,BufSize );
  If (Result = NO_ERROR) and (Entriess = 1) then
    begin
     Inc( ComputerCount );
     Computer[ ComputerCount ] := StrPas(Buf[1].lpRemoteName);g:="";
     if Computer[ ComputerCount ]<>"" then
       for i:=3 to length(Computer[ ComputerCount ]) do g:=g+Computer[ ComputerCount ][i];

     with ListView1.Items.Add do
     begin
      Caption:=g;
      try
        if HostToIp(g, IP) then SubItems.Add(IP)
          else SubItems.Add("-");
      except
      end;
     end;

    end;

Until (Entriess <> 1) or (Result <> NO_ERROR);
WNetCloseEnum( EnumHandle );
end;

end.


 
Stef   (2004-10-02 13:42) [1]

не ужели ни кто не знает


 
Дмитрий Ботвин   (2004-10-04 13:27) [2]

След от выключенных компов остается, потому что ты сканируешь
средствами LAN-менеджера. А он так работает - анологично сетевому
окружению Windows. Можно тока посоветовать прерывать функцию HostToIP если HostToIP=nil. А цикле сканирования пропускать
строки, в которых IP не определен....



Страницы: 1 вся ветка

Форум: "Сети";
Текущий архив: 2004.12.12;
Скачать: [xml.tar.bz2];

Наверх









Память: 0.83 MB
Время: 0.059 c
6-1096834754
Asia
2004-10-04 00:19
2004.12.12
TStringGrid


1-1101839603
Ищущий ответ
2004-11-30 21:33
2004.12.12
Почему не работает код?


1-1101888371
Yurij-7
2004-12-01 11:06
2004.12.12
Логин в сети


1-1101736159
hgd
2004-11-29 16:49
2004.12.12
Как открыть папку


1-1101899743
Islander
2004-12-01 14:15
2004.12.12
Как определить, что содержимое папки изменилось?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский