Newsgroup: it.comp.lang.visual-basic
Titolo: xcopy

Esiste secondo voi un comando che copy una directory con sottodirectory e
file compresi ???
tipo il vecchio xcopy di Dos Grazie......................io conosco solo
filecopy ceh copia il singolo file

 wrote in message 85quga$7o3$1...@nslave1.tin.it...


 file compresi ???
Cut&Paste da un vecchio mex di Luca Dormio, ricuperato da 
www.deja.com
 : 
__________________________________
Prova con SHFileOperation:
 
Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long 
 
Public Type SHFILEOPSTRUCT
        hwnd As Long
        wFunc As Long
        pFrom As String
        pTo As String
        fFlags As Integer
        fAnyOperationsAborted As Boolean
        hNameMappings As Long
        lpszProgressTitle As String '  usato solo se FOF_SIMPLEPROGRESS End Type
 
'costanti per wFunc
Public Const FO_COPY = &H2
Public Const FO_DELETE = &H3
Public Const FO_MOVE = &H1
Public Const FO_RENAME = &H4
 
'costanti per fFlags
Public Const FOF_ALLOWUNDO = &H40
Public Const FOF_CONFIRMMOUSE = &H2
Public Const FOF_FILESONLY = &H80                  '  con *.*, elabora solo i file
Public Const FOF_MULTIDESTFILES = &H1
Public Const FOF_NOCONFIRMATION = &H10            '  Non richiede conferma all'utente.
Public Const FOF_NOCONFIRMMKDIR = &H200            '  non conferma la creazione di directory necessarie
Public Const FOF_RENAMEONCOLLISION = &H8
Public Const FOF_SILENT = &H4                      '  non crea un rapporto avanzamento
Public Const FOF_SIMPLEPROGRESS = &H100            '  non visualizza i nomi dei file
Public Const FOF_WANTMAPPINGHANDLE = &H20          '  Inserisce SHFILEOPSTRUCT.hNameMappings
 
e quindi:
 
Dim shFileOp As SHFILEOPSTRUCT
 
With shFileOp
    .hwnd = Me.hwnd
    .pFrom = "C:\Test"
    .pTo = "C:\Test2"
    .wFunc = FO_COPY
    .fFlags = FOF_NOCONFIRMMKDIR
End With
SHFileOperation shFileOp
 __________________________________
 
Bye, G.
-- 
---------------------------------------------
    Le risposte alle tue domande le trovi
    sul Sito Comune di questo NewsGroup:
 
http://www.murialdo.it/it_lang_vb
       ... e nell'help in linea !
---------------------------------------------
Real E-address: 
gaet...@hotmail.com

Hello Alex
this is the XCOPY.BAS module
if U have problem with it send me to NG
Bye
Fabio
***********
Option Explicit
Global Const ATTR_DIRECTORY = 16
Function CopyFiles(srcPath As String, dstPath As String, IncludeSubDirs As
Integer, FilePat As String) As Integer
' This routine copies all files matching FilePat from scrPath to dstPath.
' If IncludeSubDirs is set to True, all files in subdirs will be incuded
(and
' the subdirs themselves of course), like XCOPY /S
Dim DirOK As Integer, i As Integer
Dim DirReturn As String
ReDim d(100) As String
Dim dCount As Integer
Dim CurrFile$
Dim CurrDir$
Dim dstPathBackup As String
Dim f%
   On Error GoTo DirErr
   CurrDir$ = CurDir$
   ' If Path lacks a "\", add one to the end
   If Right$(srcPath, 1) <> "\" Then srcPath = srcPath & "\"
   srcPath = UCase$(srcPath)
   If Right$(dstPath, 1) <> "\" Then dstPath = dstPath & "\"
   dstPath = UCase$(dstPath)
   dstPathBackup = dstPath
   ' Initialize var to hold filenames
   DirReturn = Dir(srcPath & "*.*", ATTR_DIRECTORY)
   ' Find all subdirs
   Do While DirReturn <> ""
      ' Make sure we don't do anything with "." and "..", they aren't real
files
      If DirReturn <> "." And DirReturn <> ".." Then
         If (GetAttr(srcPath & DirReturn) And ATTR_DIRECTORY) =
ATTR_DIRECTORY Then
            ' It's a dir. Add it to dirlist
            dCount = dCount + 1
            d(dCount) = srcPath & DirReturn
         End If
      End If
      DirReturn = Dir
   Loop
   ' Now do all the files matching FilePath (and make sure we don't do the
dirs)
   DirReturn = Dir(srcPath & FilePat, 0)
   ' Find all files
   Do While DirReturn <> ""
      ' Make sure we don't get a dir
      If Not ((GetAttr(srcPath & DirReturn) And ATTR_DIRECTORY) =
ATTR_DIRECTORY) Then
         ' It's a file. Copy it
         Frm_Copy!Lbl_CopyInfo.Caption = "Copying " & srcPath & DirReturn &
" to " & dstPath & DirReturn
         Frm_Copy!Lbl_CopyInfo.Refresh
         ' Make sure the file doesn't already exist. If it exists, prompt
the user
         ' to overwrite it.
         On Error Resume Next
         f% = FreeFile
         Open dstPath & DirReturn For Input As #f%
         Close #f%
         If Err = 0 Then
            ' Prompt the user
            f% = MsgBox("The file " & dstPath & DirReturn & " already
exists. Do you wish to overwrite it?", 4 + 32 + 256)
            If f% = 6 Then FileCopy srcPath & DirReturn, dstPath & DirReturn
         Else
            FileCopy srcPath & DirReturn, dstPath & DirReturn
         End If
      End If
      DirReturn = Dir
   Loop
   ' Now do all subs
   For i = 1 To dCount
      ' Check the 'IncludeSubDirs' value. If it's true, we have to make
      ' a dir called 'd(i)' in dstPath, and then assign dstPath & d(i) as
      ' dstPath
      If IncludeSubDirs Then
         On Error GoTo PathErr
         dstPath = dstPath & Right$(d(i), Len(d(i)) - Len(srcPath))
         ' If the Path exists, then this will work out, if not, an error
         ' will be generated and trapped, and the dir will be made
         ChDir dstPath
         On Error GoTo DirErr
      Else
         ' Since we aren't recoursing, we're done
         CopyFiles = True
         GoTo ExitFunc
      End If
      DirOK = CopyFiles(d(i), dstPath, IncludeSubDirs, FilePat)
      ' Reset dstPath to the value assigned at the argument-line
      dstPath = dstPathBackup
   Next
   CopyFiles = True
ExitFunc:
   ChDir CurrDir$
   Exit Function
DirErr:
   Frm_Copy!Lbl_CopyInfo = "Error: " & Error$(Err)
   CopyFiles = False
   Resume ExitFunc
PathErr:
   ' Didn't find the Dir'ed path
   If Err = 75 Or Err = 76 Then
      Frm_Copy!Lbl_CopyInfo.Caption = "Making directory " & dstPath
      Frm_Copy!Lbl_CopyInfo.Refresh
      MkDir dstPath
      Resume Next
   End If
   GoTo DirErr
End Function

 file compresi ???



[CLIP]
Che ne dici di farne un semplice progetto ed inviarlo al WM del Sito Comune
di questo NG? :-)
http://www.murialdo.it/it_lang_vb
Ciao
By -MES-   Maronese Ettore
http://www.maronese.com/mes
(con OCX per stampare i recordset)
Sito Comune di programmatori Visual Basic
http://www.murialdo.it/it_lang_vb


Az!
Pue questo e' da Sito Comune!
