2 Вопроса

[t4lli]

1) Как сделать что бы прога посчитала сколько иконок на рабочем столе(ярлыков и папок) , и создала на форме столько PictureBOx'ов сколько на рабочем столе иконок?

2) Как узнать все работающие процессы , и запихнуть их в ComboBox?

[A.A.Z.]

1) Сорри, что без комментариев...

Код: Выделить всё

Const CSIDL_DESKTOP = &H0
Const NOERROR = 0
Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Private Type SHITEMID
cb As Long
abID As Byte
End Type

Private Type ITEMIDLIST
mkid As SHITEMID
End Type

Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Dim Pictures() As PictureBox

Private Sub Form_Load()
Dim Files&, Dirs&
FindFiles GetDesktopPath$(), "*.*", Files, Dirs
MakePictureBoxes Dirs + Files
MsgBox "На рабочем столе найдено " & Files & " файлов и " & Dirs & " папок. Создано " & Files & " + " & Dirs & " = " & Files + Dirs & " PictureBox'ов." & vbCrLf & "Обращаться к ним можно через массив Pictures(Index 1 To " & Files + Dirs & "), или напрямую: Picture1, Picture2 и.т.д.", vbInformation
End Sub

Function GetDesktopPath$()
Dim r As Long, Path$, Desktop$, Dirs&, Files&
Dim IDL As ITEMIDLIST
r = SHGetSpecialFolderLocation(100, CSIDL_DESKTOP, IDL)
If r = NOERROR Then
Path = Space$(512)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path)
Desktop = Left$(Path, InStr(Path, Chr$(0)) - 1)
End If
GetDesktopPath = Desktop
End Function

Function FindFiles(ByVal Path As String, ByVal SearchStr As String, FileCount As Long, DirCount As Long)
Dim FileName As String
Dim DirName As String
Dim dirNames() As String
Dim nDir As Integer
Dim I As Integer
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
If Right(Path, 1) <> "\" Then Path = Path & "\"
nDir = 0
ReDim dirNames(nDir)
Cont = True
hSearch = FindFirstFile(Path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
DirName = StripNulls(WFD.cFileName)
If (DirName <> ".") And (DirName <> "..") Then
   If GetFileAttributes(Path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
    dirNames(nDir) = DirName
    DirCount = DirCount + 1
    nDir = nDir + 1
    ReDim Preserve dirNames(nDir)
   End If
  End If
  Cont = FindNextFile(hSearch, WFD)
  Loop
  Cont = FindClose(hSearch)
End If
hSearch = FindFirstFile(Path & SearchStr, WFD)
Cont = True
If hSearch <> INVALID_HANDLE_VALUE Then
  While Cont
   FileName = StripNulls(WFD.cFileName)
   If (FileName <> ".") And (FileName <> "..") Then
    FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
    FileCount = FileCount + 1
   End If
   Cont = FindNextFile(hSearch, WFD)
  Wend
  Cont = FindClose(hSearch)
End If
End Function

Sub MakePictureBoxes(ByVal Num&)
Dim I&
ReDim Pictures(1 To Num + 1)
For I = 1 To Num + 1
Set Pictures(I) = Me.Controls.Add("VB.PictureBox", "Picture" & I)
Pictures(I).Visible = True
Pictures(I).Height = 450
Pictures(I).Width = 4500
If I > 1 Then Pictures(I).Top = Pictures(I - 1).Top + Pictures(I - 1).Height Else Pictures(I).Top = 0
Me.Height = Pictures(I).Top + Pictures(I).Height
Next
End Sub

Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
  OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function

2) Код с комментариями, но на английском. Добавь на форму Combo1, добавь модуль и вставь код:
Это в форму:

Код: Выделить всё

Private Sub Form_Load()
GetProcesses ""
End Sub

Это в модуль:

Код: Выделить всё

'In a module

Public Declare Function GetProcessMemoryInfo Lib "PSAPI.DLL" (ByVal hProcess As Long, ppsmemCounters As PROCESS_MEMORY_COUNTERS, ByVal cb As Long) As Long
Public Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function CloseHandle Lib "Kernel32.dll" (ByVal Handle As Long) As Long
Public Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Public Declare Function EnumProcesses Lib "PSAPI.DLL" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Public Declare Function GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Public Declare Function EnumProcessModules Lib "PSAPI.DLL" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Public Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Public Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)



Public Const PROCESS_QUERY_INFORMATION = 1024
Public Const PROCESS_VM_READ = 16
Public Const MAX_PATH = 260
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public Const TH32CS_SNAPPROCESS = &H2&
Public Const hNull = 0
Public Const WIN95_System_Found = 1
Public Const WINNT_System_Found = 2
Public Const Default_Log_Size = 10000000
Public Const Default_Log_Days = 0
Public Const SPECIFIC_RIGHTS_ALL = &HFFFF
Public Const STANDARD_RIGHTS_ALL = &H1F0000


Type MEMORYSTATUS
    dwLength As Long
    dwMemoryLoad As Long
    dwTotalPhys As Long
    dwAvailPhys As Long
    dwTotalPageFile As Long
    dwAvailPageFile As Long
    dwTotalVirtual As Long
    dwAvailVirtual As Long
End Type


Type PROCESS_MEMORY_COUNTERS
    cb 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


Public Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long ' This process
    th32DefaultHeapID As Long
    th32ModuleID As Long ' Associated exe
    cntThreads As Long
    th32ParentProcessID As Long ' This process's parent process
    pcPriClassBase As Long ' Base priority of process threads
    dwFlags As Long
    szExeFile As String * 260 ' MAX_PATH
    End Type


Public Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long '1 = Windows 95.
    '2 = Windows NT
    szCSDVersion As String * 128
End Type


Public Function GetProcesses()

    Dim booResult As Boolean
    Dim lngLength As Long
    Dim lngProcessID As Long
    Dim strProcessName As String
    Dim lngSnapHwnd As Long
    Dim udtProcEntry As PROCESSENTRY32
    Dim lngCBSize As Long 'Specifies the size, In bytes, of the lpidProcess array
    Dim lngCBSizeReturned As Long 'Receives the number of bytes returned
    Dim lngNumElements As Long
    Dim lngProcessIDs() As Long
    Dim lngCBSize2 As Long
    Dim lngModules(1 To 200) As Long
    Dim lngReturn As Long
    Dim strModuleName As String
    Dim lngSize As Long
    Dim lngHwndProcess As Long
    Dim lngLoop As Long
    Dim b As Long
    Dim c As Long
    Dim e As Long
    Dim d As Long
    Dim pmc As PROCESS_MEMORY_COUNTERS
    Dim lret As Long
    Dim strProcName2 As String
    Dim strProcName As String

    'Turn on Error handler
    On Error GoTo Error_handler

   booResult = False


    'ProcessInfo.bolRunning = False

    Select Case getVersion()
        'I'm not bothered about windows 95/98 becasue this class probably wont be used on it anyway.
        Case WIN95_System_Found 'Windows 95/98

        Case WINNT_System_Found 'Windows NT

            lngCBSize = 8 ' Really needs To be 16, but Loop will increment prior to calling API
            lngCBSizeReturned = 96

            Do While lngCBSize <= lngCBSizeReturned
                DoEvents
                'Increment Size
                lngCBSize = lngCBSize * 2
                'Allocate Memory for Array
                ReDim lngProcessIDs(lngCBSize / 4) As Long
                'Get Process ID's
                lngReturn = EnumProcesses(lngProcessIDs(1), lngCBSize, lngCBSizeReturned)
            Loop

            'Count number of processes returned
            lngNumElements = lngCBSizeReturned / 4
            'Loop thru each process

            For lngLoop = 1 To lngNumElements
            DoEvents

            'Get a handle to the Process and Open
            lngHwndProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lngProcessIDs(lngLoop))

            If lngHwndProcess <> 0 Then
                'Get an array of the module handles for the specified process
                lngReturn = EnumProcessModules(lngHwndProcess, lngModules(1), 200, lngCBSize2)

                'If the Module Array is retrieved, Get the ModuleFileName
                If lngReturn <> 0 Then

                    'Buffer with spaces first to allocate memory for byte array
                    strModuleName = Space(MAX_PATH)

                    'Must be set prior to calling API
                    lngSize = 500

                    'Get Process Name
                    lngReturn = GetModuleFileNameExA(lngHwndProcess, lngModules(1), strModuleName, lngSize)

                    'Remove trailing spaces
                    strProcessName = Left(strModuleName, lngReturn)

                    'Check for Matching Upper case result
                    strProcessName = UCase$(Trim$(strProcessName))

                    strProcName2 = GetElement(Trim(Replace(strProcessName, Chr$(0), "")), "\", 0, 0, GetNumElements(Trim(Replace(strProcessName, Chr$(0), "")), "\") - 1)
                   
                    Form1.Combo1.AddItem LCase(strProcName2)
                   
                End If
            End If
            'Close the handle to this process
            lngReturn = CloseHandle(lngHwndProcess)
            DoEvents
        Next

    End Select

IsProcessRunning_Exit:

'Exit early to avoid error handler
Exit Function
Error_handler:
    Err.Raise Err, Err.Source, "ProcessInfo", Error
    Resume Next
End Function


Private Function getVersion() As Long

    Dim osinfo As OSVERSIONINFO
    Dim retvalue As Integer

    osinfo.dwOSVersionInfoSize = 148
    osinfo.szCSDVersion = Space$(128)
    retvalue = GetVersionExA(osinfo)
    getVersion = osinfo.dwPlatformId

End Function


Private Function StrZToStr(s As String) As String
    StrZToStr = Left$(s, Len(s) - 1)
End Function



Public Function GetElement(ByVal strList As String, ByVal strDelimiter As String, ByVal lngNumColumns As Long, ByVal lngRow As Long, ByVal lngColumn As Long) As String

    Dim lngCounter As Long

    ' Append delimiter text to the end of the list as a terminator.
    strList = strList & strDelimiter

    ' Calculate the offset for the item required based on the number of columns the list
    ' 'strList' has i.e. 'lngNumColumns' and from which row the element is to be
    ' selected i.e. 'lngRow'.
    lngColumn = IIf(lngRow = 0, lngColumn, (lngRow * lngNumColumns) + lngColumn)

    ' Search for the 'lngColumn' item from the list 'strList'.
    For lngCounter = 0 To lngColumn - 1

        ' Remove each item from the list.
        strList = Mid$(strList, InStr(strList, strDelimiter) + Len(strDelimiter), Len(strList))

        ' If list becomes empty before 'lngColumn' is found then just
        ' return an empty string.
        If Len(strList) = 0 Then
            GetElement = ""
            Exit Function
        End If

    Next lngCounter

    ' Return the sought list element.
    GetElement = Left$(strList, InStr(strList, strDelimiter) - 1)

End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Function GetNumElements (ByVal strList As String,
'                         ByVal strDelimiter As String)
'                         As Integer
'
'  strList      = The element list.
'  strDelimiter = The delimiter by which the elements in
'                 'strList' are seperated.
'
'  The function returns an integer which is the count of the
'  number of elements in 'strList'.
'
'  Author: Roger Taylor
'
'  Date:26/12/1998
'
'  Additional Information:
'
'  Revision History:
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function GetNumElements(ByVal strList As String, ByVal strDelimiter As String) As Integer

    Dim intElementCount As Integer

    ' If no elements in the list 'strList' then just return 0.
    If Len(strList) = 0 Then
        GetNumElements = 0
        Exit Function
    End If

    ' Append delimiter text to the end of the list as a terminator.
    strList = strList & strDelimiter

    ' Count the number of elements in 'strlist'
    While InStr(strList, strDelimiter) > 0
        intElementCount = intElementCount + 1
        strList = Mid$(strList, InStr(strList, strDelimiter) + 1, Len(strList))
    Wend

    ' Return the number of elements in 'strList'.
    GetNumElements = intElementCount

End Function


'If you're using VB4 or VB5, uncomment the following function:
'Function Replace(sInput As String, WhatToReplace As String, ReplaceWith As String) As String
    'Dim Ret As Long
    'Replace = sInput
    'Ret = -Len(ReplaceWith) + 1
    'Do
        'Ret = InStr(Ret + Len(ReplaceWith), Replace, WhatToReplace, vbTextCompare)
        'If Ret = 0 Then Exit Do
        'Replace = Left$(Replace, Ret - 1) + ReplaceWith + Right$(Replace, Len(Replace) - Ret - Len(WhatToReplace) + 1)
    'Loop
'End Function

[t4lli]

thank you very much A.A.Z. !!!!!

[STanli]

A.A.Z., ты это всё сам писал или откудато копировал, если сам то сколько это времени заняло?

[A.A.Z.]

Есть вещь такая - API-Guide. Второе почти все оттуда, правда там был пример, который только отслеживал нужный тебе процесс, а первое "склеил" из двух примеров и несного своего - определение системных папок + поиск файлов - API, ну а создание PictureBox'ов сам сделал.

ЗЫ STanli, зря ты так! Все самое лучшее использует API!

[STanli]

Я понимаю что API это круто но как их все запомнить их вроде около 10000 даже не запомнить а хотябы знать что такая есть и что делает, как называется, всё это очень сложно и как мне кажется это не возможно знать(ХЗ как другие пользуются).
Ну даже теже модули, по моим представлениям это чтото не нужное и вобще лишнее =)
Может быть если бы я этим хоть раз воспользовался тогда понял истенное предназночение этой "страшной" вещи.
Может подскажети пример самого нужного и простого модуля(и вобще что это такое и с чем это едят?)

[STanli]

Скачал api-guide\установил\зашол\понажимал на всё\ничего не понял\нажал alt+F4\ и ещё раз убедился что АПИ это лишнее

[t4lli]

А если еще к PictureBox'am создать Label'i в каторых были бы имена папок и фаилов , не подскажиш как это реализовать A.A.Z ???? Please

[codemaster]

Я понимаю что API это круто но как их все запомнить их вроде около 10000 даже не запомнить а хотябы знать что такая есть и что делает, как называется, всё это очень сложно и как мне кажется это не возможно знать(ХЗ как другие пользуются).
Ну даже теже модули, по моим представлениям это чтото не нужное и вобще лишнее =)

Есть чудненькая книга "Архитектура Windows"
с изучением ее придет понимание какая API функция требуется для твоих целей.

Все функции сгрупированы и совершенно не обязательно их знать "в лицо".

[Keen]

А если еще к PictureBox'am создать Label'i в каторых были бы имена папок и фаилов , не подскажиш как это реализовать A.A.Z ???? Please

Создаешь массив объектов этих самых Label'ов в столбик, в их теги заноси соот. значения и индификаторы (ну так папка или файл), напр. для файла:

Код: Выделить всё

label(0).tag="file:c:\mydir\myfile"

и при нажатии обрабатываешь с помощью ф-ии mid$() чтобы узнать индификатор ну и так далее.

[STanli]

codemaster, может эту чудесную книгу скачать гденеть можно?

[codemaster]

codemaster, может эту чудесную книгу скачать гденеть можно?

незнаю но думаю в библиотеке она точно найдется

http://www.ozon.ru/context/detail/id/115448/

[t4lli]

Напишите пожалуйста по-подробнее

Создаешь массив объектов этих самых Label'ов в столбик, в их теги заноси соот. значения и индификаторы (ну так папка или файл), напр. для файла: Код:
label(0).tag="file:c:\mydir\myfile"
и при нажатии обрабатываешь с помощью ф-ии mid$() чтобы узнать индификатор ну и так далее.

[STanli]

codemaster, ну это магазин =) "деревянную" я могу и так купить, мне бы "нормальную" в html хотяб.

[A.A.Z.]

t4lli, вот, настряпал...

Код: Выделить всё

Const CSIDL_DESKTOP = &H0
Const NOERROR = 0
Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Private Type SHITEMID
cb As Long
abID As Byte
End Type

Private Type ITEMIDLIST
mkid As SHITEMID
End Type

Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Dim Pictures() As PictureBox, Labels() As Label, PathArr()

Private Sub Form_Load()
Dim Files&, Dirs&, I&
FindFiles GetDesktopPath$(), "*.*", Files, Dirs
Files = Files - 2
Debug.Print Dirs, Files
For I = LBound(PathArr) To UBound(PathArr)
Debug.Print PathArr(I)
Next
MakePictureBoxes Dirs + Files, PathArr()
MsgBox "Íà ðàáî÷åì ñòîëå íàéäåíî " & Files & " ôàéëîâ è " & Dirs & " ïàïîê. Ñîçäàíî " & Files & " + " & Dirs & " = " & Files + Dirs & " PictureBox'îâ." & vbCrLf & "Îáðàùàòüñÿ ê íèì ìîæíî ÷åðåç ìàññèâ Pictures(Index 1 To " & Files + Dirs & "), èëè íàïðÿìóþ: Picture1, Picture2 è.ò.ä.", vbInformation
End Sub

Function GetDesktopPath$()
Dim r As Long, Path$, Desktop$, Dirs&, Files&
Dim IDL As ITEMIDLIST
r = SHGetSpecialFolderLocation(100, CSIDL_DESKTOP, IDL)
If r = NOERROR Then
Path = Space$(512)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path)
Desktop = Left$(Path, InStr(Path, Chr$(0)) - 1)
End If
GetDesktopPath = Desktop
End Function

Function FindFiles(ByVal Path As String, ByVal SearchStr As String, FileCount As Long, DirCount As Long)
Dim FileName As String
Dim DirName As String
Dim dirNames() As String
Dim nDir As Integer
Dim I As Integer
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
Dim J As Long
If Right(Path, 1) <> "\" Then Path = Path & "\"
nDir = 0
ReDim dirNames(nDir)
Cont = True
hSearch = FindFirstFile(Path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
DirName = StripNulls(WFD.cFileName)
If (DirName <> ".") And (DirName <> "..") Then
   If GetFileAttributes(Path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
    dirNames(nDir) = DirName
    DirCount = DirCount + 1
    nDir = nDir + 1
    ReDim Preserve dirNames(nDir)
   End If
  End If
  Cont = FindNextFile(hSearch, WFD)
  Loop
  Cont = FindClose(hSearch)
End If
hSearch = FindFirstFile(Path & SearchStr, WFD)
Cont = True
If hSearch <> INVALID_HANDLE_VALUE Then
  While Cont
   FileName = StripNulls(WFD.cFileName)
   If (FileName <> ".") And (FileName <> "..") Then
    ReDim Preserve PathArr(J)
    PathArr(J) = FileName
    J = J + 1
    FindFiles = FindFiles + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
    FileCount = FileCount + 1
   End If
   Cont = FindNextFile(hSearch, WFD)
  Wend
  Cont = FindClose(hSearch)
End If
End Function

Sub MakePictureBoxes(ByVal Num&, Paths())
Dim I&
ReDim Pictures(1 To Num + 1)
ReDim Labels(1 To Num + 1)
For I = 1 To Num
Set Pictures(I) = Me.Controls.Add("VB.PictureBox", "Picture" & I)
Set Labels(I) = Me.Controls.Add("VB.Label", "Label" & I)
Pictures(I).Visible = True
Pictures(I).Height = 450
Pictures(I).Width = 4500
Labels(I).Visible = True
Set Labels(I).Container = Pictures(I)
Labels(I).Caption = CStr(Paths(I - 1))
If I > 1 Then Pictures(I).Top = Pictures(I - 1).Top + Pictures(I - 1).Height Else Pictures(I).Top = 0
Me.Height = Pictures(I).Top + Pictures(I).Height
Next
Me.Height = Me.Height + Pictures(1).Height + 75
Me.Width = Pictures(1).Width
End Sub

Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
  OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function

[pitbull]

ДА API это руль А A.A.Z как всегда раньше всех успел.