- Код: Выделить всё
library ssxp_handle;
uses
SysUtils,
Classes,
windows;
{$R *.res}
type
pIO_STATUS_BLOCK = ^IO_STATUS_BLOCK;
IO_STATUS_BLOCK = Packed Record
Status : Cardinal;
Information : DWORD;
end;
TFNI = Packed Record
FileNameLength : DWORD;
FileName : array [0..MAX_PATH - 1] of WideChar;
end;
function ZwQueryInformationFile(hFile : THandle;
IOB : pIO_STATUS_BLOCK; FileInformation : Pointer;
Length : DWORD;FileInformationClass : DWORD): Cardinal; stdcall; external 'ntdll.dll';
function Test(ParamHandle : Pointer) : DWORD;stdcall;
var
IO_S_B : IO_STATUS_BLOCK;
FNI : TFNI;
Handle : THandle;
begin
Handle := THandle(ParamHandle);
ZeroMemory(@FNI,SizeOf(FNI));
ZwQueryInformationFile(Handle,@IO_S_B,@FNI,SizeOf(FNI),9);
end;
function hFile_Test(ParamHandle : THandle;ParamProcessId : DWORD) : BOOL; stdcall;
var
hThread : THandle;
Handle : THandle;
hProcess : THandle;
begin
hProcess := OpenProcess(PROCESS_DUP_HANDLE,FALSE,ParamProcessId);
if hProcess <> INVALID_HANDLE_VALUE then
begin
DuplicateHandle(hProcess,ParamHandle,GetCurrentProcess,@Handle,0,FALSE,DUPLICATE_SAME_ACCESS);
hThread := CreateThread(nil,0,@Test,@Handle,0,PDWORD(0)^);
Case WaitForSingleObject(hthread,50) of
WAIT_TIMEOUT:
begin
TerminateThread(hThread,0);
hFile_test := FALSE;
end;
WAIT_OBJECT_0:
begin
hFile_test := TRUE;
end;
end;
end
else
begin
hFile_test := FALSE;
end;
end;
exports hFile_Test;
begin
end.
Visual Basic:
- Код: Выделить всё
Declare Function hFile_Test Lib "c:\Test.dll" (ByVal dwHandle As Long, ByVal dwProcessId As Long) As Boolean
Sub GetHandles()
Dim TSize As Long
Dim SHI_Handles() As TSYSTEM_HANDLE_INFORMATION
Dim ReturnVariable As Long, ReturnVariable2 As Long
Dim mPtr As Long
Dim i As Long
Dim hThread As Long
Dim ThreadId As Long
Dim wfso As Long
Dim Current_hProcess As Long
TSize = 1000
Do
mPtr = VirtualAlloc(0, TSize, MEM_COMMIT, PAGE_READWRITE)
ReturnVariable = ZwQuerySystemInformation(SystemHandleInformation, mPtr, TSize, ReturnVariable2)
If ReturnVariable = STATUS_INFO_LEGTH_MISMATCH Then
Call VirtualFree(mPtr, TSize, MEM_DECOMMIT)
TSize = TSize * 2
Else
Exit Do
End If
Loop
Call CopyMemory(ByVal VarPtr(HandleCount), ByVal mPtr, 4)
ReDim SHI_Handles(HandleCount)
mPtr = mPtr + 4
Current_hProcess = GetCurrentProcess
For i = 0 To Int(HandleCount / 2)
Call CopyMemory(ByVal VarPtr(SHI_Handles(i)), ByVal mPtr, 16)
mPtr = mPtr + 16
If SHI_Handles(i).ObjectTypeNumber = hFileType Then
ReDim Preserve Handles(i)
Handles(i).Handle = SHI_Handles(i).Handle
Handles(i).ProcessID = SHI_Handles(i).ProcessID
If hFile_Test(SHI_Handles(i).Handle, SHI_Handles(i).ProcessID) Then
frmMain.List1.AddItem "yes yes yes yes yes"
End If
End If
End If
Next
MsgBox f
Call VirtualFree(mPtr, TSize, MEM_DECOMMIT)
End Sub
Задача:
1) С помошью hFile_Test (VB) проверяю описатель на зависание в DLL. Т.к. пытался это сделать на VB, от чего летели одни ошибки...
В данном случае в List1 пищутся одни "yes yes yes yes yes", тоесть hFile_Test всегда возвращает TRUE, почему?
Посоветуйте, что мне изменить...
Примечание: Писал этот код целиком на Delphi, все работает, а совместно c VB не хочеть...
Заранее благодарен.
