• XSS.stack #1 – первый литературный журнал от юзеров форума

Check NetBios ресурсов

triblekill

RAID-массив
Забанен
Регистрация
24.05.2023
Сообщения
62
Решения
1
Реакции
17
Пожалуйста, обратите внимание, что пользователь заблокирован
Здрасте, пишу тут софт лёгкий который проверяет заданный ip на наличие NetBios ресурсов ловлю серьёзные утечки памяти при использовании в многопотоке код процедуры пока такой:

Код:
function CheckNetBiosResources(const IPAddress: string): Boolean;
var
  netResource: TNetResource;
  buffer: array [0..4096] of TNetResource;
  bufferSize: DWORD;
  entriesCount: DWORD;
  enumHandle: THandle;
begin
  Result := False;
  try
    FillChar(netResource, SizeOf(netResource), 0);
    netResource.dwScope := RESOURCE_GLOBALNET;
    netResource.dwType := RESOURCETYPE_ANY;
    netResource.dwDisplayType := RESOURCEDISPLAYTYPE_SHARE;
    netResource.lpRemoteName := PWideChar('\\' + IPAddress);
    bufferSize := SizeOf(buffer);
    entriesCount := $FFFFFFFF;
    if WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @netResource, enumHandle) = NO_ERROR then
      if WNetEnumResource(enumHandle, entriesCount, @buffer, bufferSize) = NO_ERROR then
        Result := True;
  finally
    WNetCloseEnum(enumHandle);
  end;
end;

function Runtime(ip: string): Boolean;
var
  t: TThread;
  r: Boolean;
  event: TEvent;
begin
  event := TEvent.Create(nil, True, False, '');
  t := TThread.CreateAnonymousThread(
    procedure
    begin
      r := CheckNetBiosResources(ip);
      event.SetEvent;
    end
  );
  t.FreeOnTerminate := True;
  t.Start;
  event.WaitFor(1000); //Таймер выполнения процедуры иначе долго будет отрабатывать если ресурса нету
  t.Terminate;
  event.Free;
  Result := r;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
if
Runtime('127.0.0.1')
then
memo1.lines.add('Ресурсы Доступны')
else
memo1.lines.add('Ресурсы Не Доступны');
end;
 


Напишите ответ...
  • Вставить:
Прикрепить файлы
Верх