Avatar billede the_saint Nybegynder
07. april 2004 - 16:29 Der 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.

Mvh.
Mikkel
Avatar billede the_saint Nybegynder
07. april 2004 - 16:32 #1
Dim fs, f, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile("C:\test\logo.jpg")
    s = f.Size
    MsgBox s

Fandt en løsning på hvordan man fik info om filerne.. Men jeg kender kun til size og datecreated, er der andre ?
Avatar billede vbcoder Nybegynder
07. april 2004 - 16:39 #2
hmm - jeg er stødt på et lille komponent der kan fortælle en masse om filerne.

vender lige tilbage med en url

jeg bruger den faktisk selv på min webserver og jeg har brugt den i vb

//vbcoder
Avatar billede vbcoder Nybegynder
07. april 2004 - 16:42 #3
http://www.reneris.com/tools/

her er link til udvikleren og dokumentationen

har du brug for eksempler i vb så sig til ;-)

//vbcoder
Avatar billede martin_moth Mester
07. april 2004 - 17:02 #4
Det er beskrevet på eksperten, jeg gav selv svaret :o)

Har ikke lige tid til at finde det, men prøv at søg.

Med fso kan du finde filstørrelse osv, som the_sanit viser det
Avatar billede sjh Nybegynder
07. april 2004 - 17:13 #5
ellers prøv den her:

'--------------------- Form1 ---------------------
Option Explicit

Private ImgInfo As New Class1

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 ---------------------

'--------------------- Class1 --------------------
Option Explicit

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

  m_Size = 0
  m_Width = 0
  m_Height = 0
  m_Depth = 0
  m_ImageType = "Unknown"

  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 --------------------
Avatar billede the_saint Nybegynder
07. april 2004 - 22:04 #7
Af der ingen simple metoder til at få alle JPG filer i en bestemt mappe ( angivet vha. en string ) ?

Dem jeg har fået vidst her er meget avanceret :| Og da jeg er forholdsvis ny til det.

Hvis jeg bare kunne få et simpelt array indeholdende FullPath. Må kunne gøres simplere :\
Avatar billede the_saint Nybegynder
07. april 2004 - 22:26 #8
http://www.freevbcode.com/ShowCode.Asp?ID=41 <-- Kan ikke teste før tirsdag, men det ser da ud til at være en løsning..

Har fundet ud af at det må være dir() jeg skal have fat i
Avatar billede martin_moth Mester
08. april 2004 - 11:49 #9
Det kan sagtens gøres meget simplere (kortere). Skal nok skrive noget kode til dig på max 20 linier - bare ikke lige i dag, men inden tirsdag :o)
Avatar billede martin_moth Mester
08. april 2004 - 12:11 #10
Havde da lige 2 min:

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
Avatar billede the_saint Nybegynder
08. april 2004 - 16:16 #11
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 ;)
Avatar billede Ny bruger Nybegynder

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.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester