Пожалуйста, обратите внимание, что пользователь заблокирован
Здрасте, пишу тут софт лёгкий который проверяет заданный 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;