Главная страница
    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.46 MB
Время: 0.037 c
3-1100155505
newby
2004-11-11 09:45
2004.12.12
Округление в футере EHLib DBGrid


14-1100918992
DelphiN!
2004-11-20 05:49
2004.12.12
Подмена системных файлов


6-1096646286
BKGG
2004-10-01 19:58
2004.12.12
Sockets


4-1098954487
Colonel
2004-10-28 13:08
2004.12.12
Обработчик клавиатуры/мыши


3-1100159430
denis24
2004-11-11 10:50
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
Английский Французский Немецкий Итальянский Португальский Русский Испанский