Ellerine sağlık Güzel Paylaşım

yine güzel çözümler yine sen, sağol usta

Forma: listbox atiyoruz isim>lstFile commandbutton>cmdEnum ve birde textbox>txtPath Kod: Option Explicit Private Type LARGE_INTEGER lowpart As Long highpart As Long End Type Private Type UNICODE_STRING uLength As Integer uMaximumLength As Integer pBuffer As Long End Type Private Type IO_STATUS_BLOCK Status As Long uInformation 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 FILE_BOTH_DIRECTORY_INFORMATION NextEntryOffset As Long FileIndex As Long CreationTime As LARGE_INTEGER LastAccessTime As LARGE_INTEGER LastWriteTime As LARGE_INTEGER ChangeTime As LARGE_INTEGER EndOfFile As LARGE_INTEGER Al Size As LARGE_INTEGER FileAttributes As Long FileNameLength As Long EaSize As Long ShortNameLength As Byte ShortName(23) As Byte FileName As Byte FileName1 As Integer End Type Private Const FileBothDirectoryInformation = 3 Private Const SYNCHRONIZE = &H100000 Private Const FILE_ANY_ACCESS = 0 Private Const FILE_LIST_DIRECTORY = 1 Private Const FILE_DIRECTORY_FILE = 1 Private Const FILE_SYNCHRONOUS_IO_NONALERT = &H20 Private Const FILE_OPEN_FOR_BACKUP_INTENT = &H4000 Private Const OBJ_CASE_INSENSITIVE = &H40 Private Declare Function NtQueryDirectoryFile Lib "ntdll. dll" As Long Private Declare Function NtClose Lib "ntdll. dll" As Long Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" Private Declare Function NtOpenFile Lib "ntdll. dll" As Long Private Declare Sub RtlInitUnicodeString Lib "ntdll. dll" Private Declare Sub ZeroMemory Lib "ntdll. dll" Alias "RtlZeroMemory" Private Function FindFirstFile(ByVal strDirectory As String, bytBuffer As Byte) As Long Dim strFolder As String Dim obAttr As OBJECT_ATTRIBUTES Dim objIoStatus As IO_STATUS_BLOCK Dim ntStatus As Long Dim hFind As Long Dim strUnicode As UNICODE_STRING strFolder = "\?\" strFolder = strFolder & strDirectory RtlInitUnicodeString strUnicode, StrPtr obAttr. Length = LenB obAttr. Attributes = OBJ_CASE_INSENSITIVE obAttr. ObjectName = VarPtr obAttr. RootDirectory = 0 obAttr. SecurityDescriptor = 0 obAttr. SecurityQualityOfService = 0 ntStatus = NtOpenFile(hFind, _ FILE_LIST_DIRECTORY Or SYNCHRONIZE Or FILE_ANY_ACCESS, _ obAttr, _ objIoStatus, _ 3, _ FILE_DIRECTORY_FILE Or FILE_SYNCHRONOUS_IO_NONALERT Or FILE_OPEN_FOR_BACKUP_INTENT) If ntStatus = 0 And hFind <> -1 Then ntStatus = NtQueryDirectoryFile(hFind, _ 0, _ 0, _ 0, _ objIoStatus, _ bytBuffer(0), _ UBound , _ FileBothDirectoryInformation, _ 1, _ ByVal 0&, _ 0) If ntStatus = 0 Then FindFirstFile = hFind Else NtClose hFind End If End If End Function Private Function FindNextFile(ByVal hFind As Long, bytBuffer As Byte) As Boolean Dim ntStatus As Long Dim objIoStatus As IO_STATUS_BLOCK ntStatus = NtQueryDirectoryFile(hFind, _ 0, _ 0, _ 0, _ objIoStatus, _ bytBuffer(0), _ UBound , _ FileBothDirectoryInformation, _ 0, _ ByVal 0&, _ 0) If ntStatus = 0 Then FindNextFile = True Else FindNextFile = False End If End Function Private Sub cmdEnum_Click Dim pDir As FILE_BOTH_DIRECTORY_INFORMATION Dim hFind As Long Dim bytBuffer As Byte Dim bytName As Byte Dim strPath As String Dim strFileName As String 520 Dim dwFileNameOffset As Long Dim dwDirOffset As Long Me. lstFile. Clear ReDim bytBuffer(LenB + 260 2 - 3) strPath = txtPath. Text If Right(strPath, 1) <> "\" Then strPath = strPath & "\" hFind = FindFirstFile CopyMemory pDir, bytBuffer(0), LenB ReDim bytName(pDir. FileNameLength - 1) dwFileNameOffset = VarPtr(bytBuffer(&H5E)) CopyMemory bytName(0), ByVal dwFileNameOffset, pDir. FileNameLength strFileName = strPath & CStr Me. lstFile. AddItem strFileName Erase bytBuffer ReDim bytBuffer((LenB + CLng(260 2 - 3)) CLng(&H2000)) If FindNextFile Then dwDirOffset = 0 '±éÀú o ́æ Do While 1 ZeroMemory pDir, LenB CopyMemory pDir, ByVal VarPtr(bytBuffer , LenB Erase bytName ReDim bytName(pDir. FileNameLength - 1) dwFileNameOffset = dwDirOffset + &H5E dwFileNameOffset = VarPtr(bytBuffer CopyMemory bytName(0), ByVal dwFileNameOffset, pDir. FileNameLength strFileName = strPath & CStr Me. lstFile. AddItem strFileName If pDir. NextEntryOffset = 0 Then Exit Do dwDirOffset = dwDirOffset + pDir. NextEntryOffset Loop End If NtClose hFind End Sub textbox icine aramak istediginiz klasorun yazin ve entere basin ne kadar hizli listelendigini goreceksiniz... hadi kolay