VB Ring３下解锁文件的模块

最新推荐文章于 2019-09-16 15:56:03 发布

geniuslychee

最新推荐文章于 2019-09-16 15:56:03 发布

阅读量669

点赞数

分类专栏： VB 文章标签： vb function attributes string object system

VB 专栏收录该内容

5 篇文章 0 订阅

订阅专栏

这篇文章参考了这个地址http://www.xfocus.net/articles/200708/935.html

Attribute VB_Name = "modLockFileInfo"
Option Explicit

Private   Declare   Function   NtQueryInformationProcess   Lib   "NTDLL.DLL"   (ByVal   ProcessHandle   As   Long,   _
                                                                ByVal   ProcessInformationClass   As   PROCESSINFOCLASS,   _
                                                                ByVal   ProcessInformation   As   Long,   _
                                                                ByVal   ProcessInformationLength   As   Long,   _
                                                                ByRef   ReturnLength   As   Long)   As   Long

Private   Enum   PROCESSINFOCLASS
        ProcessBasicInformation   =   0
        ProcessQuotaLimits
        ProcessIoCounters
        ProcessVmCounters
        ProcessTimes
        ProcessBasePriority
        ProcessRaisePriority
        ProcessDebugPort
        ProcessExceptionPort
        ProcessAccessToken
        ProcessLdtInformation
        ProcessLdtSize
        ProcessDefaultHardErrorMode
        ProcessIoPortHandlers
        ProcessPooledUsageAndLimits
        ProcessWorkingSetWatch
        ProcessUserModeIOPL
        ProcessEnableAlignmentFaultFixup
        ProcessPriorityClass
        ProcessWx86Information
        ProcessHandleCount
        ProcessAffinityMask
        ProcessPriorityBoost
        ProcessDeviceMap
        ProcessSessionInformation
        ProcessForegroundInformation
        ProcessWow64Information
        ProcessImageFileName
        ProcessLUIDDeviceMapsEnabled
        ProcessBreakOnTermination
        ProcessDebugObjectHandle
        ProcessDebugFlags
        ProcessHandleTracing
        ProcessIoPriority
        ProcessExecuteFlags
        ProcessResourceManagement
        ProcessCookie
        ProcessImageInformation
        MaxProcessInfoClass
End   Enum

Private   Type   PROCESS_BASIC_INFORMATION
        ExitStatus   As   Long   "NTSTATUS
        PebBaseAddress   As   Long   "PPEB
        AffinityMask   As   Long   "ULONG_PTR
        BasePriority   As   Long   "KPRIORITY
        UniqueProcessId   As   Long   "ULONG_PTR
        InheritedFromUniqueProcessId   As   Long   "ULONG_PTR
End   Type

Private   Type   FILE_NAME_INFORMATION
          FileNameLength   As   Long
          FileName(3)   As   Byte
End   Type

Private   Type   NM_INFO
        Info   As   FILE_NAME_INFORMATION
        strName(259)   As   Byte
End   Type

Private   Enum   FileInformationClass
        FileDirectoryInformation   =   1
        FileFullDirectoryInformation   =   2
        FileBothDirectoryInformation   =   3
        FileBasicInformation   =   4
        FileStandardInformation   =   5
        FileInternalInformation   =   6
        FileEaInformation   =   7
        FileAccessInformation   =   8
        FileNameInformation   =   9
        FileRenameInformation   =   10
        FileLinkInformation   =   11
        FileNamesInformation   =   12
        FileDispositionInformation   =   13
        FilePositionInformation   =   14
        FileFullEaInformation   =   15
        FileModeInformation   =   16
        FileAlignmentInformation   =   17
        FileAllInformation   =   18
        FileAllocationInformation   =   19
        FileEndOfFileInformation   =   20
        FileAlternateNameInformation   =   21
        FileStreamInformation   =   22
        FilePipeInformation   =   23
        FilePipeLocalInformation   =   24
        FilePipeRemoteInformation   =   25
        FileMailslotQueryInformation   =   26
        FileMailslotSetInformation   =   27
        FileCompressionInformation   =   28
        FileObjectIdInformation   =   29
        FileCompletionInformation   =   30
        FileMoveClusterInformation   =   31
        FileQuotaInformation   =   32
        FileReparsePointInformation   =   33
        FileNetworkOpenInformation   =   34
        FileAttributeTagInformation   =   35
        FileTrackingInformation   =   36
        FileMaximumInformation
End   Enum

Private   Declare   Function   NtQuerySystemInformation   Lib   "NTDLL.DLL"   (ByVal   SystemInformationClass   As   SYSTEM_INFORMATION_CLASS,   _
                                                                ByVal   pSystemInformation   As   Long,   _
                                                                ByVal   SystemInformationLength   As   Long,   _
                                                                ByRef   ReturnLength   As   Long)   As   Long

Private   Declare   Function   NtQueryInformationFile   Lib   "NTDLL.DLL"   (ByVal   FileHandle   As   Long,   _
                                                                ByRef   IoStatusBlock   As   Any,   _
                                                                ByRef   FileInformation   As   Any,   _
                                                                ByVal   Length   As   Long,   _
                                                                ByVal   FileClass   As   FileInformationClass)   As   Long

Private   Enum   SYSTEM_INFORMATION_CLASS
        SystemBasicInformation
        SystemProcessorInformation                           "//   obsolete...delete
        SystemPerformanceInformation
        SystemTimeOfDayInformation
        SystemPathInformation
        SystemProcessInformation
        SystemCallCountInformation
        SystemDeviceInformation
        SystemProcessorPerformanceInformation
        SystemFlagsInformation
        SystemCallTimeInformation
        SystemModuleInformation
        SystemLocksInformation
        SystemStackTraceInformation
        SystemPagedPoolInformation
        SystemNonPagedPoolInformation
        SystemHandleInformation
        SystemObjectInformation
        SystemPageFileInformation
        SystemVdmInstemulInformation
        SystemVdmBopInformation
        SystemFileCacheInformation
        SystemPoolTagInformation
        SystemInterruptInformation
        SystemDpcBehaviorInformation
        SystemFullMemoryInformation
        SystemLoadGdiDriverInformation
        SystemUnloadGdiDriverInformation
        SystemTimeAdjustmentInformation
        SystemSummaryMemoryInformation
        SystemMirrorMemoryInformation
        SystemPerformanceTraceInformation
        SystemObsolete0
        SystemExceptionInformation
        SystemCrashDumpStateInformation
        SystemKernelDebuggerInformation
        SystemContextSwitchInformation
        SystemRegistryQuotaInformation
        SystemExtendServiceTableInformation
        SystemPrioritySeperation
        SystemVerifierAddDriverInformation
        SystemVerifierRemoveDriverInformation
        SystemProcessorIdleInformation
        SystemLegacyDriverInformation
        SystemCurrentTimeZoneInformation
        SystemLookasideInformation
        SystemTimeSlipNotification
        SystemSessionCreate
        SystemSessionDetach
        SystemSessionInformation
        SystemRangeStartInformation
        SystemVerifierInformation
        SystemVerifierThunkExtend
        SystemSessionProcessInformation
        SystemLoadGdiDriverInSystemSpace
        SystemNumaProcessorMap
        SystemPrefetcherInformation
        SystemExtendedProcessInformation
        SystemRecommendedSharedDataAlignment
        SystemComPlusPackage
        SystemNumaAvailableMemory
        SystemProcessorPowerInformation
        SystemEmulationBasicInformation
        SystemEmulationProcessorInformation
        SystemExtendedHandleInformation
        SystemLostDelayedWriteInformation
        SystemBigPoolInformation
        SystemSessionPoolTagInformation
        SystemSessionMappedViewInformation
        SystemHotpatchInformation
        SystemObjectSecurityMode
        SystemWatchdogTimerHandler
        SystemWatchdogTimerInformation
        SystemLogicalProcessorInformation
        SystemWow64SharedInformation
        SystemRegisterFirmwareTableInformationHandler
        SystemFirmwareTableInformation
        SystemModuleInformationEx
        SystemVerifierTriageInformation
        SystemSuperfetchInformation
        SystemMemoryListInformation
        SystemFileCacheInformationEx
        MaxSystemInfoClass     "//   MaxSystemInfoClass   should   always   be   the   last   enum
End   Enum

Private   Type   SYSTEM_HANDLE
        UniqueProcessId   As   Integer
        CreatorBackTraceIndex   As   Integer
        ObjectTypeIndex   As   Byte
        HandleAttributes   As   Byte
        HandleValue   As   Integer
        pObject   As   Long
        GrantedAccess   As   Long
End   Type

Private Const STATUS_INFO_LENGTH_MISMATCH = &HC0000004

Private   Enum   SYSTEM_HANDLE_TYPE
        OB_TYPE_UNKNOWN   =   0
        OB_TYPE_TYPE   =   1
        OB_TYPE_DIRECTORY
        OB_TYPE_SYMBOLIC_LINK
        OB_TYPE_TOKEN
        OB_TYPE_PROCESS
        OB_TYPE_THREAD
        OB_TYPE_UNKNOWN_7
        OB_TYPE_EVENT
        OB_TYPE_EVENT_PAIR
        OB_TYPE_MUTANT
        OB_TYPE_UNKNOWN_11
        OB_TYPE_SEMAPHORE
        OB_TYPE_TIMER
        OB_TYPE_PROFILE
        OB_TYPE_WINDOW_STATION
        OB_TYPE_DESKTOP
        OB_TYPE_SECTION
        OB_TYPE_KEY
        OB_TYPE_PORT
        OB_TYPE_WAITABLE_PORT
        OB_TYPE_UNKNOWN_21
        OB_TYPE_UNKNOWN_22
        OB_TYPE_UNKNOWN_23
        OB_TYPE_UNKNOWN_24
        OB_TYPE_IO_COMPLETION
        OB_TYPE_FILE
End   Enum

"typedef   struct   _SYSTEM_HANDLE_INFORMATION
"{
"       ULONG                       uCount;
"       SYSTEM_HANDLE       aSH[];
"}   SYSTEM_HANDLE_INFORMATION,   *PSYSTEM_HANDLE_INFORMATION;

Private   Type   SYSTEM_HANDLE_INFORMATION
        uCount   As   Long
        aSH()   As   SYSTEM_HANDLE
End   Type

Private   Declare   Function   NtDuplicateObject   Lib   "NTDLL.DLL"   (ByVal   SourceProcessHandle   As   Long,   _
                                                                ByVal   SourceHandle   As   Long,   _
                                                                ByVal   TargetProcessHandle   As   Long,   _
                                                                ByRef   TargetHandle   As   Long,   _
                                                                ByVal   DesiredAccess   As   Long,   _
                                                                ByVal   HandleAttributes   As   Long,   _
                                                                ByVal   Options   As   Long)   As   Long

Private Const DUPLICATE_CLOSE_SOURCE = &H1

Private Const DUPLICATE_SAME_ACCESS = &H2

Private Const DUPLICATE_SAME_ATTRIBUTES = &H4

Private   Declare   Function   NtOpenProcess   Lib   "NTDLL.DLL"   (ByRef   ProcessHandle   As   Long,   _
                                                                ByVal   AccessMask   As   Long,   _
                                                                ByRef   ObjectAttributes   As   OBJECT_ATTRIBUTES,   _
                                                                ByRef   ClientID   As   CLIENT_ID)   As   Long

Private   Type   OBJECT_ATTRIBUTES
        Length   As   Long
        RootDirectory   As   Long
        ObjectName   As   Long
        Attributes   As   Long
        SecurityDescriptor   As   Long
        SecurityQualityOfService   As   Long
End   Type

Private   Type   CLIENT_ID
        UniqueProcess   As   Long
        UniqueThread     As   Long
End   Type

Private   Type   IO_STATUS_BLOCK
        Status   As   Long
        uInformation   As   Long
End   Type

Private Const PROCESS_QUERY_INFORMATION As Long = (&H400)

Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000

Private Const SYNCHRONIZE As Long = &H100000

Private Const PROCESS_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)

Private Const PROCESS_DUP_HANDLE As Long = (&H40)

Private Declare Function NtClose Lib "NTDLL.DLL" (ByVal ObjectHandle As Long) As Long

Private   Declare   Sub   CopyMemory   Lib   "kernel32.dll"   Alias   "RtlMoveMemory"   (ByRef   Destination   As   Any,   _
                                                                            ByRef   Source   As   Any,   _
                                                                            ByVal   Length   As   Long)

Private   Declare   Function   CreateFile   Lib   "kernel32"   Alias   "CreateFileA"   (ByVal   lpFileName   As   String,   ByVal   dwDesiredAccess   As   Long,   ByVal   dwShareMode   As   Long,   lpSecurityAttributes   As   Any,   ByVal   dwCreationDisposition   As   Long,   ByVal   dwFlagsAndAttributes   As   Long,   ByVal   hTemplateFile   As   Long)   As   Long
Private   Declare   Function   GetCurrentProcessId   Lib   "kernel32"   ()   As   Long
Private   Declare   Function   GetCurrentProcess   Lib   "kernel32"   ()   As   Long
Private   Declare   Function   TerminateProcess   Lib   "kernel32"   (ByVal   hProcess   As   Long,   ByVal   uExitCode   As   Long)   As   Long

"typedef   struct   _OBJECT_NAME_INFORMATION
"{
"         UNICODE_STRING     Name;
"}   OBJECT_NAME_INFORMATION,   *POBJECT_NAME_INFORMATION;
"typedef   enum   _OBJECT_INFORMATION_CLASS
"{
"         ObjectBasicInformation,                           //   0         Y               N
"         ObjectNameInformation,                             //   1         Y               N
"         ObjectTypeInformation,                             //   2         Y               N
"         ObjectAllTypesInformation,                     //   3         Y               N
"         ObjectHandleInformation                           //   4         Y               Y
"}   OBJECT_INFORMATION_CLASS;
Private   Enum   OBJECT_INFORMATION_CLASS
        ObjectBasicInformation   =   0
        ObjectNameInformation
        ObjectTypeInformation
        ObjectAllTypesInformation
        ObjectHandleInformation
End   Enum
"
"typedef   struct   _UNICODE_STRING
"{
"         USHORT   Length;
"         USHORT   MaximumLength;
"         PWSTR   Buffer;
"}   UNICODE_STRING,   *PUNICODE_STRING;
Private   Type   UNICODE_STRING
        uLength   As   Integer
        uMaximumLength   As   Integer
        pBuffer(3)   As   Byte
End   Type

Private   Type   OBJECT_NAME_INFORMATION
        pName   As   UNICODE_STRING
End   Type
Private   Const   STATUS_INFO_LEN_MISMATCH   =   &HC0000004
Private   Const   HEAP_ZERO_MEMORY   =   &H8
Private   Declare   Function   GetProcessHeap   Lib   "kernel32"   ()   As   Long
Private   Declare   Function   HeapFree   Lib   "kernel32"   (ByVal   hHeap   As   Long,   ByVal   dwFlags   As   Long,   lpMem   As   Any)   As   Long
Private   Declare   Function   HeapReAlloc   Lib   "kernel32"   (ByVal   hHeap   As   Long,   ByVal   dwFlags   As   Long,   lpMem   As   Any,   ByVal   dwBytes   As   Long)   As   Long
Private   Declare   Function   HeapAlloc   Lib   "kernel32"   (ByVal   hHeap   As   Long,   ByVal   dwFlags   As   Long,   ByVal   dwBytes   As   Long)   As   Long
"Private   Declare   Function   NtQueryObject   Lib   "NTDLL.DLL"   (ByVal   ObjectHandle   As   Long,   _
"                                                                                                                 ByVal   ObjectInformationClass   As   OBJECT_INFORMATION_CLASS,   _
"                                                                                                                 ObjectInformation   As   Any,   ByVal   ObjectInformationLength   As   Long,   _
"                                                                                                                 ReturnLength   As   Long)   As   Long
Private   Declare   Function   NtQueryObject   Lib   "NTDLL.DLL"   (ByVal   ObjectHandle   As   Long,   _
                                                                                                                ByVal   ObjectInformationClass   As   OBJECT_INFORMATION_CLASS,   _
                                                                                                                ByVal   ObjectInformation   As   Long,   ByVal   ObjectInformationLength   As   Long,   _
                                                                                                                ReturnLength   As   Long)   As   Long
Private   Declare   Function   lstrlenW   Lib   "kernel32"   (ByVal   lpString   As   Long)   As   Long
Private   Declare   Function   QueryDosDevice   Lib   "kernel32"   Alias   "QueryDosDeviceA"   (ByVal   lpDeviceName   As   String,   ByVal   lpTargetPath   As   String,   ByVal   ucchMax   As   Long)   As   Long
Private   Declare   Function   GetLogicalDriveStrings   Lib   "kernel32"   Alias   "GetLogicalDriveStringsA"   (ByVal   nBufferLength   As   Long,   ByVal   lpBuffer   As   String)   As   Long
Private   Declare   Function   lstrcpyW   Lib   "kernel32"   (ByVal   lpString1   As   String,   ByVal   lpString2   As   Long)   As   Long
Private   Declare   Function   lstrcpyA   Lib   "kernel32"   (ByVal   lpString1   As   String,   ByVal   lpString2   As   Long)   As   Long
Public   Declare   Function   GetFileName   Lib   "UnlockDll.dll"   (ByVal   hFile   As   Long)   As   Long
Private   Declare   Function   MessageBox   Lib   "user32"   Alias   "MessageBoxA"   (ByVal   hwnd   As   Long,   ByVal   lpText   As   String,   ByVal   lpCaption   As   String,   ByVal   wType   As   Long)   As   Long

Private   Function   NT_SUCCESS(ByVal   nStatus   As   Long)   As   Boolean
        NT_SUCCESS   =   (nStatus   >=   0)
End   Function

Public   Function   GetHandleByProcessId(ByVal   dwProcessId   As   Long)   As   Long
        Dim   ntStatus   As   Long
        Dim   objCid   As   CLIENT_ID
        Dim   objOa   As   OBJECT_ATTRIBUTES
        Dim   lngHandles   As   Long
        Dim   i   As   Long
        Dim   objBasic   As   PROCESS_BASIC_INFORMATION
        Dim   objInfo()   As   SYSTEM_HANDLE
        Dim   hProcess   As   Long,   hProcessToDup   As   Long,   hProcessHandle   As   Long
        Dim   hFile   As   Long
        objOa.Length = Len(objOa)
        objCid.UniqueProcess = dwProcessId
        ntStatus   =   NtOpenProcess(hProcess,   PROCESS_ALL_ACCESS,   objOa,   objCid)
        If   hProcess   < >   0   Then
                GetHandleByProcessId   =   hProcess
                Exit   Function
        End   If
        ntStatus   =   0
        Dim   bytBuf()   As   Byte
        Dim   nSize   As   Long
        nSize   =   1
Do
                ReDim   bytBuf(nSize)
                ntStatus   =   NtQuerySystemInformation(SystemHandleInformation,   VarPtr(bytBuf(0)),   nSize,   0&)
                If   (Not   NT_SUCCESS(ntStatus))   Then
                        If   (ntStatus   < >   STATUS_INFO_LENGTH_MISMATCH)   Then
                                Erase   bytBuf
                                Exit   Function
                        End   If
                Else
                        Exit   Do
                End   If
                nSize   =   nSize   *   2
                ReDim   bytBuf(nSize)
        Loop
        CopyMemory   lngHandles,   bytBuf(0),   4
        ReDim   objInfo(lngHandles   -   1)
        CopyMemory   objInfo(0),   bytBuf(4),   Len(objInfo(0))   *   lngHandles
        For   i   =   0   To   lngHandles   -   1
                If   objInfo(i).ObjectTypeIndex   =   OB_TYPE_PROCESS   Then   "   And   objInfo(i).UniqueProcessId   =   dwProcessId   Then
                        objCid.UniqueProcess   =   objInfo(i).UniqueProcessId
                        ntStatus   =   NtOpenProcess(hProcessToDup,   PROCESS_DUP_HANDLE,   objOa,   objCid)
                        If   (NT_SUCCESS(ntStatus))   Then
                                ntStatus   =   NtDuplicateObject(hProcessToDup,   objInfo(i).HandleValue,   GetCurrentProcess,   hProcessHandle,   PROCESS_ALL_ACCESS,   0,   DUPLICATE_SAME_ATTRIBUTES)
                                If   (NT_SUCCESS(ntStatus))   Then
                                        ntStatus   =   NtQueryInformationProcess(hProcessHandle,   ProcessBasicInformation,   VarPtr(objBasic),   Len(objBasic),   0)
                                        If   (NT_SUCCESS(ntStatus))   Then
                                                If   (objBasic.UniqueProcessId   =   dwProcessId)   Then
                                                        ntStatus   =   NtDuplicateObject(hProcessToDup,   objInfo(i).HandleValue,   GetCurrentProcess,   hProcessHandle,   PROCESS_ALL_ACCESS,   0,   DUPLICATE_SAME_ATTRIBUTES)
                                                        If   (NT_SUCCESS(ntStatus))   Then
                                                                GetHandleByProcessId   =   hProcessHandle
                                                                Exit   Function
                                                        End   If
                                                End   If
                                        End   If
                                End   If
                        End   If
                End   If
        Next
End   Function

"char   *GetFileFullPath(HANDLE   hFile)
"{
"         HANDLE   hHeap   =   GetProcessHeap();
"         DWORD   retSize   =   0;
"         POBJECT_NAME_INFORMATION   pName   =   (POBJECT_NAME_INFORMATION)HeapAlloc(hHeap,   HEAP_ZERO_MEMORY,   0x1000);
"         NTSTATUS   ns   =   NtQueryObject(hFile,   ObjectNameInformation,   (PVOID)pName,   0x1000,   &retSize);
"         DWORD   i   =   1;
"         while(ns   ==   STATUS_INFO_LEN_MISMATCH)
"         {
"                 pName   =   (POBJECT_NAME_INFORMATION)HeapReAlloc(hHeap,   HEAP_ZERO_MEMORY,   (LPVOID)pName,   0x1000   *   i);
"                 ns   =   NtQueryObject(hFile,   ObjectNameInformation,   (PVOID)pName,   0x1000,   NULL);
"                 i++;
"         }
"         int   intNameSize   =   wcslen(pName- >Name.Buffer);
"         char   *strObjectPath   =   new   char[intNameSize];
"         wsprintf(strObjectPath,   "%S",   pName- >Name.Buffer);
"         char   strDrives[512];
"         if   (GetLogicalDriveStrings(512,strDrives))
"         {
"                 char   *sp=strDrives;
"                 char   strDrive[3],szName[260];
"                 int   intSize   =   strlen(strDrives);
"                 int   intStep   =   0;
"                 Do
"                 {
"                         memset(szName,0,260);
"                         memset(strDrive,0,3);
"                         strncpy(strDrive,sp,2);
"                         strDrive[2]= "/0 ";
"                         QueryDosDevice(strDrive,szName,sizeof(szName));
"                         if   (strstr(strObjectPath,szName)==strObjectPath)
"                         {
"                                 char   *strSubPath   =   strObjectPath;
"                                 strSubPath+=   strlen(szName);
"                                 char   strFileName[260];
"                                 strcpy(strFileName,strDrive);
"                                 strcat(strFileName,strSubPath);
"                                 memset(strObjectPath,0,intNameSize);
"                                 strcpy(strObjectPath,strFileName);
"                                 //printf("%s/n",strFileName);
"                                 delete   pName;
"                                 return   strObjectPath;
"                         }
"                         sp+=4;
"                         intStep+=4;
"                 }   while(!(intStep <intSize));
"         }
"         delete   pName;
"         return   strObjectPath;
"}

Public   Function   GetFileFullPath(ByVal   hFile   As   Long)   As   String
        Dim   hHeap   As   Long,   dwSize   As   Long,   objName   As   UNICODE_STRING,   pName   As   Long
        Dim   ntStatus   As   Long,   i   As   Long,   lngNameSize   As   Long,   strDrives   As   String,   strArray()   As   String
        Dim   dwDriversSize   As   Long,   strDrive   As   String,   strTmp   As   String,   strTemp   As   String
        On   Error   GoTo   ErrHandle
        hHeap   =   GetProcessHeap
        pName   =   HeapAlloc(hHeap,   HEAP_ZERO_MEMORY,   &H1000)
        "这里可能会死锁所以最好使用线程来获取文件名但是可惜VB不支持
        ntStatus   =   NtQueryObject(hFile,   ObjectNameInformation,   pName,   &H1000,   dwSize)
        If   (NT_SUCCESS(ntStatus))   Then
                i   =   1
                Do   While   (ntStatus   =   STATUS_INFO_LEN_MISMATCH)
                        pName   =   HeapReAlloc(hHeap,   HEAP_ZERO_MEMORY,   pName,   &H1000   *   i)
                        ntStatus   =   NtQueryObject(hFile,   ObjectNameInformation,   pName,   &H1000,   ByVal   0)
                        i   =   i   +   1
                Loop
        End   If
        HeapFree   hHeap,   0,   pName
        "lstrlenW(pName   +   Len(objName)
        strTemp   =   String(512,   Chr(0))
        lstrcpyW   strTemp,   pName   +   Len(objName)
        strTemp   =   StrConv(strTemp,   vbFromUnicode)
        strTemp   =   Left(strTemp,   InStr(strTemp,   Chr(0))   -   1)
        strDrives   =   String(512,   Chr(9))
        dwDriversSize   =   GetLogicalDriveStrings(512,   strDrives)
        If   dwDriversSize   Then
                strArray   =   Split(strDrives,   Chr(0))
                For   i   =   0   To   UBound(strArray)
                        If   strArray(i)   < >   ""   Then
                                strDrive   =   Left(strArray(i),   2)
                                strTmp   =   String(260,   Chr(0))
                                Call   QueryDosDevice(strDrive,   strTmp,   256)
                                strTmp   =   Left(strTmp,   InStr(strTmp,   Chr(0))   -   1)
                                If   InStr(LCase(strTemp),   LCase(strTmp))   =   1   Then
                                        GetFileFullPath   =   strDrive   &   Mid(strTemp,   Len(strTmp)   +   1,   Len(strTemp)   -   Len(strTmp))
                                        Exit   Function
                                End   If
                        End   If
                Next
        End   If
ErrHandle:
End   Function

Public   Function   GetLockFileHandle(ByVal   strFileName   As   String,   ByVal   dwProcessId   As   Long)   As   Long
        Dim   ntStatus   As   Long
        Dim   objCid   As   CLIENT_ID
        Dim   objOa   As   OBJECT_ATTRIBUTES
        Dim   lngHandles   As   Long
        Dim   i   As   Long
        Dim   objInfo   As   SYSTEM_HANDLE_INFORMATION,   lngType   As   Long
        Dim   hProcess   As   Long,   hProcessToDup   As   Long,   hFileHandle   As   Long
        Dim   hFile   As   Long
        "Dim   objIo   As   IO_STATUS_BLOCK,   objFn   As   FILE_NAME_INFORMATION,   objN   As   NM_INFO
        Dim   bytBytes()   As   Byte,   strSubPath   As   String,   strTmp   As   String
        strSubPath   =   Mid(strFileName,   3,   Len(strFileName)   -   2)
        hFile   =   CreateFile("NUL",   &H80000000,   0,   ByVal   0&,   3,   0,   0)
        If   hFile   =   -1   Then
                GetLockFileHandle   =   0
                Exit   Function
        End   If
        objOa.Length   =   Len(objOa)
        objCid.UniqueProcess   =   dwProcessId
        ntStatus   =   0
        Dim   bytBuf()   As   Byte
        Dim   nSize   As   Long
        nSize   =   1
        Do
                ReDim   bytBuf(nSize)
                ntStatus   =   NtQuerySystemInformation(SystemHandleInformation,   VarPtr(bytBuf(0)),   nSize,   0&)
                If   (Not   NT_SUCCESS(ntStatus))   Then
                        If   (ntStatus   < >   STATUS_INFO_LENGTH_MISMATCH)   Then
                                Erase   bytBuf
                                Exit   Function
                        End   If
                Else
                        Exit   Do
                End   If
                nSize   =   nSize   *   2
                ReDim   bytBuf(nSize)
        Loop
        lngHandles   =   0
        CopyMemory   objInfo.uCount,   bytBuf(0),   4
        lngHandles   =   objInfo.uCount
        ReDim   objInfo.aSH(lngHandles   -   1)
        Call   CopyMemory(objInfo.aSH(0),   bytBuf(4),   Len(objInfo.aSH(0))   *   lngHandles)
        For   i   =   0   To   lngHandles   -   1
                If   objInfo.aSH(i).HandleValue   =   hFile   And   objInfo.aSH(i).UniqueProcessId   =   GetCurrentProcessId   Then
                        lngType   =   objInfo.aSH(i).ObjectTypeIndex
                        Exit   For
                End   If
        Next
        NtClose   hFile
        For   i   =   0   To   lngHandles   -   1
                If   objInfo.aSH(i).ObjectTypeIndex   =   lngType   And   objInfo.aSH(i).UniqueProcessId   =   dwProcessId   Then
                        ntStatus   =   NtOpenProcess(hProcessToDup,   PROCESS_DUP_HANDLE,   objOa,   objCid)
                        If   hProcessToDup   =   0   Then   hProcessToDup   =   GetHandleByProcessId(dwProcessId)
                        If   hProcessToDup   < >   0   Then
                                ntStatus   =   NtDuplicateObject(hProcessToDup,   objInfo.aSH(i).HandleValue,   GetCurrentProcess,   hFileHandle,   0,   0,   DUPLICATE_SAME_ATTRIBUTES)
                                If   (NT_SUCCESS(ntStatus))   Then
                                        "这里获取完整路径存在问题不能获取驱动器
"                                         ntStatus   =   NtQueryInformationFile(hFileHandle,   objIo,   objN,   Len(objN),   FileNameInformation)
"                                         ReDim   bytBytes(objN.Info.FileNameLength   -   1)
"                                         Call   CopyMemory(bytBytes(0),   objN.Info.FileName(0),   objN.Info.FileNameLength   +   4)
"                                         If   LCase(strSubPath)   =   LCase(bytBytes)   Then
"                                                 UnlockFileEx   CLng(txtProcessId.Text),   hFileHandle
"                                                 Debug.Print   bytBytes
"                                         End   If
"                                         strTmp   =   GetFileNameEx(hFileHandle)
                                        strTmp   =   GetFileFullPath(hFileHandle)
"                                         Debug.Print   strTmp
                                        If   LCase(strTmp)   =   LCase(strFileName)   Then
                                                GetLockFileHandle   =   objInfo.aSH(i).HandleValue
                                                Exit   Function
                                        End   If
                                End   If
                        End   If
                End   If
        Next
End   Function

转载自：http://blog.csdn.net/chenhui530/archive/2007/10/03/1810300.aspx

geniuslychee

关注

0
点赞
踩
0

收藏

觉得还不错? 一键收藏
0
评论
VB Ring３下解锁文件的模块

这篇文章参考了这个地址http://www.xfocus.net/articles/200708/935.html Attribute VB_Name = "modLockFileInfo" Option Explicit Private Declare Function NtQueryInformationProcess Lib "NTDLL.DLL"
复制链接

扫一扫