07. april 2004 - 16:29Der er
7 kommentarer og 4 løsninger
Hente filer ind i et array
Hej
Jeg skal læse en mappe, og finde alle filer af typen .jpg i mappen, disse filers fuldstændige URL skal så gemmes i et array, så jeg senere kan gennemgå dem og så flytte filerne ( Det skal gøres på denne måde, jeg kan sagtens flytte filerne ) men jeg skal have dem i et array, så jeg kan flytte dem en af gangen.
Samtidig ønsker jeg om det er muligt at få info om filerne, så som fil størrelse og lign.
I dette særtema ser vi på, hvordan cloud og AI bliver fundamentet for virksomhedernes digitale forretning, og hvordan de nye muligheder for automatisering og forretningsværdi kan udnyttes uden at miste overblik, sikkerhed og menneskelig kontrol.
Private Sub Form_Load() With ImgInfo If .ReadInfo("D:\System\Dokumenter\Billeder\Eksempel.jpg") Then MsgBox "Type: " & .ImageType MsgBox "Depth: " & .Depth MsgBox "Width/Height: " & .Width & " x " & .Height MsgBox "Size: " & .Size & " byte" End If End With End Sub '--------------------- Form1 ---------------------
Private Const MAX_PATH As Long = 260 Private Const INVALID_HANDLE_VALUE As Long = -1 Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
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 Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Const BUFFERSIZE As Long = 65535
Private m_Size As Long Private m_Width As Long Private m_Height As Long Private m_Depth As Byte Private m_ImageType As String
Public Property Get Width() As Long Width = m_Width End Property
Public Property Get Height() As Long Height = m_Height End Property
Public Property Get Depth() As Byte Depth = m_Depth End Property
Public Property Get ImageType() As String ImageType = m_ImageType End Property
Public Property Get Size() As Long Size = m_Size End Property
Public Function ReadInfo(ByVal strPath As String) As Boolean Dim bytBuffer() As Byte Dim intFile As Integer
If FileExists(strPath) Then intFile = FreeFile Open strPath For Binary Access Read As #intFile m_Size = LOF(intFile) ReDim bytBuffer(BUFFERSIZE) As Byte Get #intFile, 1, bytBuffer() Close #intFile Else Exit Function End If
'PNG file If bytBuffer(0) = 137 And bytBuffer(1) = 80 And bytBuffer(2) = 78 Then m_ImageType = "PNG" Select Case bytBuffer(25) Case 0 m_Depth = bytBuffer(24) Case 2 m_Depth = bytBuffer(24) * 3 Case 3 m_Depth = CByte(8) Case 4 m_Depth = bytBuffer(24) * 2 Case 6 m_Depth = bytBuffer(24) * 4 Case Else m_ImageType = "Unknown" End Select If m_ImageType = "PNG" Then m_Width = Mult(bytBuffer(19), bytBuffer(18)) m_Height = Mult(bytBuffer(23), bytBuffer(22)) ReadInfo = True Exit Function End If End If
'GIF file If bytBuffer(0) = 71 And bytBuffer(1) = 73 And bytBuffer(2) = 70 Then m_ImageType = "GIF" m_Width = Mult(bytBuffer(6), bytBuffer(7)) m_Height = Mult(bytBuffer(8), bytBuffer(9)) m_Depth = (bytBuffer(10) And 7) + 1 ReadInfo = True Exit Function End If
'BMP file If bytBuffer(0) = 66 And bytBuffer(1) = 77 Then m_ImageType = "BMP" m_Width = Mult(bytBuffer(18), bytBuffer(19)) m_Height = Mult(bytBuffer(22), bytBuffer(23)) m_Depth = bytBuffer(28) ReadInfo = True Exit Function End If
'WBMP file If bytBuffer(0) = 0 And bytBuffer(1) = 0 Then m_Width = WMult(bytBuffer(2), bytBuffer(3)) m_Height = WMult(bytBuffer(4), bytBuffer(5)) If m_Width > 0 And m_Height > 0 Then m_ImageType = "WBMP" m_Depth = CByte(1) ReadInfo = True Exit Function Else m_Width = 0 m_Height = 0 End If End If
'JPEG file If m_ImageType = "Unknown" Then Dim lngPos As Long Do If (bytBuffer(lngPos) = &HFF And _ bytBuffer(lngPos + 1) = &HD8 And _ bytBuffer(lngPos + 2) = &HFF) Or (lngPos >= BUFFERSIZE - 10) Then Exit Do lngPos = lngPos + 1 Loop lngPos = lngPos + 2 If lngPos >= BUFFERSIZE - 10 Then Exit Function Do Do If bytBuffer(lngPos) = &HFF And bytBuffer(lngPos + 1) <> &HFF Then Exit Do lngPos = lngPos + 1 If lngPos >= BUFFERSIZE - 10 Then Exit Function Loop lngPos = lngPos + 1 Select Case bytBuffer(lngPos) Case &HC0 To &HC3, &HC5 To &HC7, &HC9 To &HCB, &HCD To &HCF Exit Do End Select lngPos = lngPos + Mult(bytBuffer(lngPos + 2), bytBuffer(lngPos + 1)) If lngPos >= BUFFERSIZE - 10 Then Exit Function Loop m_ImageType = "JPG" m_Height = Mult(bytBuffer(lngPos + 5), bytBuffer(lngPos + 4)) m_Width = Mult(bytBuffer(lngPos + 7), bytBuffer(lngPos + 6)) m_Depth = bytBuffer(lngPos + 8) * 8 ReadInfo = True End If End Function
Private Function WMult(ByVal byt1 As Byte, ByVal byt2 As Byte) As Long If byt1 < 128 Then WMult = CLng(byt1) Else WMult = CLng((byt1 Mod 128) * 128 + byt2) End If End Function
Private Function Mult(ByVal byt1 As Byte, ByVal byt2 As Byte) As Long Mult = CLng(byt1 + (byt2 * CLng(256))) End Function
Private Function FileExists(ByVal strFile As String) As Boolean Dim hFile As Long Dim WFD As WIN32_FIND_DATA hFile = FindFirstFile(strFile, WFD) FileExists = CBool(hFile <> INVALID_HANDLE_VALUE) Call FindClose(hFile) End Function '--------------------- Class1 --------------------
Opret en form, og sæt en filelistbox på den. Copy-paste følgende kode:
Private Sub Form_Load()
Dim FileArray() As String 'Arrayet har dimensionen NUL til at starte med Dim i As Long 'En tæller-variabel
'Alle JPG ind i din filelist File1.Path = "C:\billeder" '<- Ret stien File1.Pattern = "*.jpg" File1.Visible = False 'Drop dette hvis FileList skal være synlig på formen
'Indlæs fra file1 fil array For i = 0 To File1.ListCount - 1 ReDim Preserve FileArray(i) 'Giver arrayet ny dimension, gemmer oprindeligt indhold (PRESERVE) FileArray(i) = File1.List(i) 'Indlæser i array Next i
'Skriv f.eks. arrayet ud i en msgbox, for test For i = 0 To UBound(FileArray) MsgBox "Fil i array på plads " & i & ": " & FileArray(i) Next i End Sub
Funktionen dir() virkede, og er langt den nemmeste måde.. se kildekode i et svar længere oppe..
Først hentes alle filerne ved dir(strSti, VbNormal) dernæst bruges filen dir() til at gå videre til næste fil.
Virker perfekt :) Takker for jeres svar :) og martin får 50% for hans store indsats ;)
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.