PureBasic Forums - English

Code: Select all

Dim objArgs, source, mask
Dim objShellApp, objFSO, objFolder
Dim oFolder, oFolderItems

Const LENGTH = 27

Set objArgs = Wscript.Arguments
If objArgs.Count <> 2 Then WScript.Quit -1
source   = objArgs(0)
mask     = objArgs(1)

Set objShellApp = CreateObject("Shell.Application")
Set objFSO      = WScript.CreateObject("Scripting.FileSystemObject")
Set objFolder   = objFSO.GetFolder(source)

If Not objFSO.FolderExists(source) Then WScript.Quit -2

ScanSubFolders objFolder

Set objArgs      = Nothing
Set objShellApp  = Nothing
Set objFSO       = Nothing
Set objFolder    = Nothing

WScript.Quit 0

'=============================================================================
Sub ScanSubFolders(objFolder)
  Dim objSubFolder, strPath
    
  strPath          = objFolder.Path
  Set oFolder      = objShellApp.NameSpace(strPath)
  Set oFolderItems = oFolder.Items
  oFolderItems.Filter 64 + 128, mask
    
  If oFolderItems.Count > 0 Then
    For Each objItem In oFolderItems
      WScript.Echo strPath & Chr(9) & objItem.Name & Chr(9) & oFolder.GetDetailsOf(objItem,LENGTH)
    Next
  End If  
    
  Set oFolder      = Nothing
  Set oFolderItems = Nothing

  On Error Resume Next
  For Each objSubFolder In objFolder.SubFolders
    If Err.Number = 0 Then
      On Error Goto 0
      ScanSubFolders objSubFolder
    Else
      Err.Clear
      On Error Goto 0
      WScript.Echo "Can't enumerate subfolders for folder [" & objFolder.Path & "]."
    End If
  Next
End Sub

Code: Select all

If InitMovie() = 0
  MessageRequester("Error", "Can't initialize movie playback !", 0)
  End
EndIf

Procedure IsMouseOver(hWnd) 
  GetWindowRect_(hWnd,r.RECT) 
  GetCursorPos_(p.POINT) 
  Result = PtInRect_(r,p\y << 32 + p\x) 
  ProcedureReturn Result 
EndProcedure 

LoadFont(0,"Comic Sans ms",14)
hWnd = OpenWindow(0, 0, 0, 800, 600, "ListIcon Example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
If hWnd
  LIG_Wnd = ListIconGadget(0, 10, 10, 780, 500, "", 0, #PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection)
  AddGadgetColumn(0, 1, "MP3 File Name", 620)
  AddGadgetColumn(0, 2, "Duration", 155)
  ButtonGadget(1,10,565,80,24,"RUN")
  SetGadgetFont(0,FontID(0))
  
  InitialPath$ = "E:\Music"
  InitialMask$ = "*.mp3"
  If FileSize(InitialPath$) <> -2
    InitialPath$ = "C:\"
  EndIf
  vbs$ = "mp3.vbs"
  out$ = "Text.txt"
  Volume = 100
    
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Quit = 1
        
      Case #WM_LBUTTONDBLCLK
        If IsMouseOver(LIG_Wnd) <> 0
          CountItems = CountGadgetItems(0) -1
          If CountItems <> -1
            For a = 0 To CountItems
              If GetGadgetItemState(0, a) & #PB_ListIcon_Selected
                If GetGadgetItemText(0, a, 2) <> ""
                  SoundFileName$ = GetGadgetItemText(0, a, 0)
                  If LoadMovie(0, SoundFileName$)
                    PlayMovie(0, hWnd)
                    MovieAudio(0, Volume, 0)
                  Else
                    MessageRequester("Error", "Can't load the sound.", 0)
                  EndIf
                EndIf
                Break
              EndIf
            Next
          EndIf
        EndIf

      Case #PB_Event_Gadget
        Select EventGadget()
          Case 1
            Path$ = PathRequester("Specify a folder to scan", InitialPath$)
            If Path$ <> ""
              InitialPath$ = Path$
              ClearGadgetItems(0)
              
              RunProgram("cmd "," /c cscript //nologo "+vbs$+" "+#DQUOTE$+Path$+#DQUOTE$+" "+InitialMask$+" > "+out$,"",#PB_Program_Open|#PB_Program_Wait|#PB_Program_Hide)
              If ReadFile(0, out$)
                FormatFile = ReadStringFormat(0)
                Path$ = ""

                While Eof(0) = 0 
                  text$ = ReadString(0, FormatFile)
                  fullpath$ = StringField(text$, 1, Chr(9))
                  filename$ = StringField(text$, 2, Chr(9))
                  duration$ = StringField(text$, 3, Chr(9))
                  
                  If fullpath$ <> Path$
                    Path$ = fullpath$
                    AddGadgetItem(0, -1, "")
                    AddGadgetItem(0, -1, Chr(10) + Path$)
                    AddGadgetItem(0, -1, Chr(10) + RSet(Chr(175), Len(Path$), Chr(175)))
                  EndIf
                  AddGadgetItem(0, -1, fullpath$ + "\" + filename$ + Chr(10) + filename$ + Chr(10) + duration$)
                Wend
                CloseFile(0)
                DeleteFile(out$,#PB_FileSystem_Force)
              Else
                MessageRequester("Information","Couldn't open the output-file!")
              EndIf
            EndIf
        EndSelect
    EndSelect
  Until Quit = 1
EndIf