论坛广场 › WINDOWS核心编程 › [转载]陈辉的文件解锁模块

HoviDelphic 发表于 2010-7-6 23:53:51

[转载]陈辉的文件解锁模块

本帖最后由 HoviDelphic 于 2010-7-7 00:16 编辑

最近很多人玩锁定文件，我就转载个文件解锁吧，代码都是陈辉写的，我只是做了一点点整理。
能对抗使用ZwCreateFile进行文件独占的代码，无论是Ring 3的还是Ring 0的。
顺便爆个料，老马说陈辉现在在微点干。。。
======
modGetAllProcesses.bas

Option Explicit
Private Declare Function ZwQueryInformationProcess Lib "ntdll" (ByVal ProcessHandle As Long, ByVal ProcessInformationClass As Long, ByVal ProcessInformation As Long, ByVal ProcessInformationLength As Long, ByRef ReturnLength As Long) As Long
Private Declare Function ZwQuerySystemInformation Lib "ntdll" (ByVal SystemInformationClass As Long, ByVal pSystemInformation As Long, ByVal SystemInformationLength As Long, ByRef ReturnLength As Long) As Long
Private Declare Function ZwDuplicateObject Lib "ntdll" (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 Declare Function ZwOpenProcess Lib "ntdll" (ByRef ProcessHandle As Long, ByVal AccessMask As Long, ByRef ObjectAttributes As OBJECT_ATTRIBUTES, ByRef ClientID As CLIENT_ID) As Long
Private Declare Function ZwClose Lib "ntdll" (ByVal ObjectHandle As Long) As Long
Private Declare Function RtlAdjustPrivilege Lib "ntdll" (ByVal Privilege As Long, ByVal Enable As Boolean, ByVal Client As Boolean, WasEnabled As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByVal lpcbNeeded As Long) As Long
Private Declare Function GetModuleFileNameEx Lib "psapi" Alias "GetModuleFileNameExA" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function VarPtrArray Lib "msvbvm60" Alias "VarPtr" (Ptr() As Any) As Long
Private Type PROCESS_BASIC_INFORMATION
    ExitStatus As Long
    PebBaseAddress As Long
    AffinityMask As Long
    BasePriority As Long
    UniqueProcessId As Long
    InheritedFromUniqueProcessId As Long
End Type
Private Type SYSTEM_HANDLE_TABLE_ENTRY_INFO
    UniqueProcessId As Integer
    CreatorBackTraceIndex As Integer
    ObjectTypeIndex As Byte
    HandleAttributes As Byte
    HandleValue As Integer
    pObject As Long
    GrantedAccess As Long
End Type
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 LARGE_INTEGER
    LowPart As Long
    HighPart As Long
End Type
Private Type UNICODE_STRING
    Length As Integer
    MaximumLength As Integer
    Buffer As Long
End Type
Private Type IO_COUNTERSEX
    ReadOperationCount As LARGE_INTEGER
    WriteOperationCount As LARGE_INTEGER
    OtherOperationCount As LARGE_INTEGER
    ReadTransferCount As LARGE_INTEGER
    WriteTransferCount As LARGE_INTEGER
    OtherTransferCount As LARGE_INTEGER
End Type
Private Type VM_COUNTERS
    PeakVirtualSize As Long
    VirtualSize As Long
    PageFaultCount As Long
    PeakWorkingSetSize As Long
    WorkingSetSize As Long
    QuotaPeakPagedPoolUsage As Long
    QuotaPagedPoolUsage As Long
    QuotaPeakNonPagedPoolUsage As Long
    QuotaNonPagedPoolUsage As Long
    PagefileUsage As Long
    PeakPagefileUsage As Long
End Type
Private Enum THREAD_STATE
    StateInitialized
    StateReady
    StateRunning
    StateStandby
    StateTerminated
    StateWait
    StateTransition
    StateUnknown
End Enum
Private Enum KWAIT_REASON
    Executive
    FreePage
    PageIn
    PoolAllocation
    DelayExecution
    Suspended
    UserRequest
    WrExecutive
    WrFreePage
    WrPageIn
    WrPoolAllocation
    WrDelayExecution
    WrSuspended
    WrUserRequest
    WrEventPair
    WrQueue
    WrLpcReceive
    WrLpcReply
    WrVirtualMemory
    WrPageOut
    WrRendezvous
    Spare2
    Spare3
    Spare4
    Spare5
    Spare6
    WrKernel
    MaximumWaitReason
End Enum
Private Type SYSTEM_THREADS
    KernelTime As LARGE_INTEGER
    UserTime As LARGE_INTEGER
    CreateTime As LARGE_INTEGER
    WaitTime As Long
    StartAddress As Long
    ClientID As CLIENT_ID
    Priority As Long
    BasePriority As Long
    ContextSwitchCount As Long
    State As THREAD_STATE
    WaitReason As KWAIT_REASON
End Type
Private Type SYSTEM_PROCESSES
    NextEntryDelta As Long
    ThreadCount As Long
    Reserved1(5) As Long
    CreateTime As LARGE_INTEGER
    UserTime As LARGE_INTEGER
    KernelTime As LARGE_INTEGER
    ProcessName As UNICODE_STRING
    BasePriority As Long
    ProcessId As Long
    InheritedFromProcessId As Long
    HandleCount As Long
    SessionId As Long
    Reserved2 As Long
    VmCounters As VM_COUNTERS
    PrivatePageCount As Long
    IoCounters As IO_COUNTERSEX
    Threads(0) As SYSTEM_THREADS
End Type
Private Type SafeArray
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
    cElements As Long
    lLbound As Long
End Type
Private Const STATUS_INFO_LENGTH_MISMATCH = &HC0000004
Private Const DUPLICATE_CLOSE_SOURCE = &H1
Private Const DUPLICATE_SAME_ACCESS = &H2
Private Const DUPLICATE_SAME_ATTRIBUTES = &H4
Private Const PROCESS_VM_READ = &H10&
Private Const PROCESS_QUERY_INFORMATION As Long = &H400
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Const PROCESS_DUP_HANDLE As Long = &H40
Private Const SE_DEBUG_PRIVILEGE = 20
Private Const FADF_AUTO As Integer = 1
Private Const FADF_FIXEDSIZE As Integer = 16
Public Function NT_SUCCESS(ByVal Status As Long) As Boolean
    NT_SUCCESS = (Status >= 0)
End Function
Public Sub GetAllProcessA(ByRef lpProcessIdAry() As Long)
    Dim st As Long
    Dim BytBuf() As Byte
    Dim sp() As SYSTEM_PROCESSES
    Dim pArray As SafeArray
    Dim NextEntry As Long
    Dim NumOfProcess As Long
    Dim ArySize As Long
    Erase lpProcessIdAry
    ArySize = 1
    Do
      ReDim BytBuf(ArySize)
      st = ZwQuerySystemInformation(5, VarPtr(BytBuf(0)), ArySize, 0) '5 - SystemProcessInformation
      If (Not NT_SUCCESS(st)) Then
         If (st <> STATUS_INFO_LENGTH_MISMATCH) Then
            Erase BytBuf
            Exit Sub
         End If
      Else
         Exit Do
      End If
      ArySize = ArySize * 2
      ReDim BytBuf(ArySize)
    Loop
    With pArray
      .cDims = 1
      .fFeatures = FADF_AUTO Or FADF_FIXEDSIZE
      .cbElements = 244
      .cElements = 1
      .lLbound = 0
    End With
    CopyMemory ByVal VarPtrArray(sp), VarPtr(pArray), 4
    Do
      pArray.pvData = VarPtr(BytBuf(NextEntry))
      NumOfProcess = NumOfProcess + 1
      ReDim Preserve lpProcessIdAry(NumOfProcess - 1)
      lpProcessIdAry(NumOfProcess - 1) = sp(0).ProcessId
      If sp(0).NextEntryDelta = 0 Then
            Exit Do
      Else
            NextEntry = NextEntry + sp(0).NextEntryDelta
      End If
    Loop
    Erase sp
    Erase BytBuf
    CopyMemory ByVal VarPtr(pArray), 0, Len(pArray)
End Sub


modLockFileInfo.bas

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 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
    UniqueThreadAs Long
End Type
Private Type IO_STATUS_BLOCK
    Status As Long
    uInformation As Long
End Type
Private Const PROCESS_CREATE_THREAD = &H2
Private Const PROCESS_VM_WRITE = &H20
Private Const PROCESS_VM_OPERATION = &H8
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 Enum OBJECT_INFORMATION_CLASS
    ObjectBasicInformation = 0
    ObjectNameInformation
    ObjectTypeInformation
    ObjectAllTypesInformation
    ObjectHandleInformation
End Enum
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
Public 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
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, _
                                                      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
Public 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 Declare Function CreateRemoteThread Lib "kernel32" (ByVal hProcess As Long, lpThreadAttributes As Any, ByVal dwStackSize As Long, lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, lpExitCode As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Private Declare Function GetFileType Lib "kernel32" (ByVal hFile As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Function NT_SUCCESS(ByVal nStatus As Long) As Boolean
    NT_SUCCESS = (nStatus >= 0)
End Function
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)
    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
    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 CloseLockFileHandle(ByVal strFileName As String, ByVal dwProcessId As Long) As Boolean
    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
    Dim blnIsOk As Boolean
    strSubPath = Mid(strFileName, 3, Len(strFileName) - 2)
    hFile = CreateFile("NUL", &H80000000, 0, ByVal 0&, 3, 0, 0)
    If hFile = -1 Then
      CloseLockFileHandle = False
      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
    blnIsOk = True
    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
                ntStatus = NtDuplicateObject(hProcessToDup, objInfo.aSH(i).HandleValue, GetCurrentProcess, hFileHandle, 0, 0, DUPLICATE_SAME_ATTRIBUTES)
                If (NT_SUCCESS(ntStatus)) Then
                  '这里如果直接调用NtQueryObject可能会挂起解决方法是用线程去处理当线程处理时间超过一定时间就把它干掉
                  '由于VB对多线程支持很差，其实应该说是对CreateThread支持很差，什么原因不要问我，相信网上也写有不少
                  '文件是关于它的,这里我选择了另一个函数也可以建立线程但是它是建立远程线程的，不过它却很稳定正好解决了
                  '我们这里的问题它就是CreateRemoteThread,^_^还记得我说过它很强大吧~~哈哈。
                  ntStatus = MyGetFileType(hFileHandle)
                  If ntStatus Then
                        strTmp = GetFileFullPath(hFileHandle)
                  End If
                  NtClose hFileHandle
                  If InStr(LCase(strTmp), LCase(strFileName)) Then
                        If Not CloseRemoteHandle(dwProcessId, objInfo.aSH(i).HandleValue, strFileName) Then
                            blnIsOk = False
                        End If
                  End If
                End If
            End If
      End If
    Next
    CloseLockFileHandle = blnIsOk
End Function
'检测所有进程
Public Function CloseLoackFiles(ByVal strFileName As String) As Boolean
    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, blnIsOk As Boolean, strProcessName As String
    '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
      CloseLoackFiles = False
      Exit Function
    End If
    objOa.Length = Len(objOa)
    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
    blnIsOk = True
    For i = 0 To lngHandles - 1
      If objInfo.aSH(i).ObjectTypeIndex = lngType Then
            objCid.UniqueProcess = objInfo.aSH(i).UniqueProcessId
            ntStatus = NtOpenProcess(hProcessToDup, PROCESS_DUP_HANDLE, objOa, objCid)
            If hProcessToDup <> 0 Then
                ntStatus = NtDuplicateObject(hProcessToDup, objInfo.aSH(i).HandleValue, GetCurrentProcess, hFileHandle, 0, 0, DUPLICATE_SAME_ATTRIBUTES)
                If (NT_SUCCESS(ntStatus)) Then
                  '这里如果直接调用NtQueryObject可能会挂起解决方法是用线程去处理当线程处理时间超过一定时间就把它干掉
                  '由于VB对多线程支持很差，其实应该说是对CreateThread支持很差，什么原因不要问我，相信网上也写有不少
                  '文件是关于它的,这里我选择了另一个函数也可以建立线程但是它是建立远程线程的，不过它却很稳定正好解决了
                  '我们这里的问题它就是CreateRemoteThread,^_^还记得我说过它很强大吧~~哈哈。
                  ntStatus = MyGetFileType(hFileHandle)
                  If ntStatus Then
                        strTmp = GetFileFullPath(hFileHandle)
                  Else
                        strTmp = ""
                  End If
                  NtClose hFileHandle
                  If InStr(LCase(strTmp), LCase(strFileName)) Then
                        If Not CloseRemoteHandle(objInfo.aSH(i).UniqueProcessId, objInfo.aSH(i).HandleValue, strTmp) Then
                            blnIsOk = False
                        End If
                  End If
                End If
            End If
      End If
    Next
    CloseLoackFiles = blnIsOk
End Function
Private Function GetProcessCommandLine(ByVal dwProcessId As Long) As String
    Dim objCid As CLIENT_ID
    Dim objOa As OBJECT_ATTRIBUTES
    Dim ntStatus As Long, hKernel As Long, strName As String
    Dim hProcess As Long, dwAddr As Long, dwRead As Long
    objOa.Length = Len(objOa)
    objCid.UniqueProcess = dwProcessId
    ntStatus = NtOpenProcess(hProcess, &H10, objOa, objCid)
    If hProcess = 0 Then
      GetProcessCommandLine = ""
      Exit Function
    End If
    hKernel = GetModuleHandle("kernel32")
    dwAddr = GetProcAddress(hKernel, "GetCommandLineA")
    CopyMemory dwAddr, ByVal dwAddr + 1, 4
    If ReadProcessMemory(hProcess, ByVal dwAddr, dwAddr, 4, dwRead) Then
      strName = String(260, Chr(0))
      If ReadProcessMemory(hProcess, ByVal dwAddr, ByVal strName, 260, dwRead) Then
            strName = Left(strName, InStr(strName, Chr(0)) - 1)
            NtClose hProcess
            GetProcessCommandLine = strName
            Exit Function
      End If
    End If
    NtClose hProcess
End Function
'解锁指定进程的锁定文件
Public Function CloseRemoteHandle(ByVal dwProcessId, ByVal hHandle As Long, Optional ByVal strLockFile As String = "") As Boolean
    Dim hMyProcessAs Long, hRemProcess As Long, blnResult As Long, hMyHandle As Long
    Dim objCid As CLIENT_ID
    Dim objOa As OBJECT_ATTRIBUTES
    Dim ntStatus As Long, strProcessName As String, hProcess As Long, strMsg As String
    objCid.UniqueProcess = dwProcessId
    objOa.Length = Len(objOa)
    hMyProcess = GetCurrentProcess()
    ntStatus = NtOpenProcess(hRemProcess, PROCESS_DUP_HANDLE, objOa, objCid)
    If hRemProcess Then
      ntStatus = NtDuplicateObject(hRemProcess, hHandle, GetCurrentProcess, hMyHandle, 0, 0, DUPLICATE_CLOSE_SOURCE Or DUPLICATE_SAME_ACCESS)
      If (NT_SUCCESS(ntStatus)) Then
      'If DuplicateHandle(hRemProcess, hMyProcess, hHandle, hMyHandle, 0, 0, DUPLICATE_CLOSE_SOURCE Or DUPLICATE_SAME_ACCESS) Then
            blnResult = NtClose(hMyHandle)
            If blnResult >= 0 Then
                strProcessName = GetProcessCommandLine(dwProcessId)
                'If InStr(LCase(strProcessName), LCase(strLockFile)) Then
                'If InStr(LCase(strProcessName), "explorer.exe") = 0 And dwProcessId <> GetCurrentProcessId Then
                  'objCid.UniqueProcess = dwProcessId
                  'ntStatus = NtOpenProcess(hProcess, 1, objOa, objCid)
                  'If hProcess <> 0 Then TerminateProcess hProcess, 0
                'End If
            End If
      End If
      Call NtClose(hRemProcess)
    End If
    CloseRemoteHandle = blnResult >= 0
End Function
'解锁指定进程的锁定文件
Public Function CloseRemoteHandleEx(ByVal dwProcessId, ByVal hHandle As Long, Optional ByVal strLockFile As String = "") As Boolean
    Dim hRemProcess As Long, hThread As Long, lngResult As Long, pfnThreadRtn As Long, hKernel As Long
    Dim objCid As CLIENT_ID
    Dim objOa As OBJECT_ATTRIBUTES, strMsg As String
    Dim ntStatus As Long, strProcessName As String, hProcess As Long
    objCid.UniqueProcess = dwProcessId
    objOa.Length = Len(objOa)
    ntStatus = NtOpenProcess(hRemProcess, PROCESS_QUERY_INFORMATION Or PROCESS_CREATE_THREAD Or PROCESS_VM_OPERATION Or PROCESS_VM_WRITE, objOa, objCid)
'    hMyProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_CREATE_THREAD Or PROCESS_VM_OPERATION Or PROCESS_VM_WRITE, 0, dwProcessId)
    If hRemProcess = 0 Then
      CloseRemoteHandleEx = False
      Exit Function
    End If
    hKernel = GetModuleHandle("kernel32")
    If hKernel = 0 Then
      CloseRemoteHandleEx = False
      Exit Function
    End If
    pfnThreadRtn = GetProcAddress(hKernel, "CloseHandle")
    If pfnThreadRtn = 0 Then
      FreeLibrary hKernel
      CloseRemoteHandleEx = False
      Exit Function
    End If
    hThread = CreateRemoteThread(hRemProcess, ByVal 0&, 0&, ByVal pfnThreadRtn, ByVal hHandle, 0, 0&)
    If hThread = 0 Then
      FreeLibrary hKernel
      CloseRemoteHandleEx = False
      Exit Function
    End If
    GetExitCodeThread hThread, lngResult
    CloseRemoteHandleEx = CBool(lngResult)
    strProcessName = GetProcessCommandLine(dwProcessId)
    'If InStr(strProcessName, strLockFile) Then
    '    objCid.UniqueProcess = dwProcessId
    '    ntStatus = NtOpenProcess(hProcess, 1, objOa, objCid)
      'If hProcess <> 0 Then TerminateProcess hProcess, 0
    'End If
    NtClose hThread
    NtClose hRemProcess
    FreeLibrary hKernel
End Function
Private Function MyGetFileType(ByVal hFile As Long) As Long
    Dim hRemProcess As Long, hThread As Long, lngResult As Long, pfnThreadRtn As Long, hKernel As Long
    Dim dwEax As Long, dwTimeOut As Long
    hRemProcess = GetCurrentProcess
    hKernel = GetModuleHandle("kernel32")
    If hKernel = 0 Then
      MyGetFileType = 0
      Exit Function
    End If
    pfnThreadRtn = GetProcAddress(hKernel, "GetFileType")
    If pfnThreadRtn = 0 Then
      FreeLibrary hKernel
      MyGetFileType = 0
      Exit Function
    End If
    hThread = CreateRemoteThread(hRemProcess, ByVal 0&, 0&, ByVal pfnThreadRtn, ByVal hFile, 0, ByVal 0&)
    dwEax = WaitForSingleObject(hThread, 100)
    If dwEax = &H102 Then
      Call GetExitCodeThread(hThread, dwTimeOut)
      Call TerminateThread(hThread, dwTimeOut)
      NtClose hThread
      MyGetFileType = 0
      Exit Function
    End If
    If hThread = 0 Then
      FreeLibrary hKernel
      MyGetFileType = False
      Exit Function
    End If
    GetExitCodeThread hThread, lngResult
    MyGetFileType = lngResult
    NtClose hThread
    NtClose hRemProcess
    FreeLibrary hKernel
End Function


modUnlockFile.bas

Public Sub UnlockFile(Byval szFileName As String)
    Dim i As Long
    Dim pids() As Long
    Call GetAllProcessA(pids)
    For i = 0 To UBound(pids)
      CloseLockFileHandle szFileName, pids(i)
    Next
    Erase pids
End Sub

HoviDelphic 发表于 2010-7-7 00:16:57

陈辉博客：http://blog.csdn.net/chenhui530
有很多很有价值的技术文章。

马大哈 发表于 2010-7-7 13:14:19

陈辉这小子最近比较忙.

本网站最菜的人 发表于 2010-7-7 20:25:12

阿杰 发表于 2010-7-7 21:30:08

这个不错,比较实用

乔丹二世 发表于 2010-7-8 21:39:43

不错的源码

查看完整版本: [转载]陈辉的文件解锁模块