Hallo,
gibts irgendwo ein Beispiel dafür wie ich per VB6 eine Datei kopieren kann und dabei so wie bei Windows üblich die Progressbar laufen lassen kann?
Hab schon in den Büchern gewälzt, finde aber nichts passendes.
Viele Grüsse
Werner
Gruß!
Also, wenn du eine Progress-Bar haben willst, dann kannst du, soweit ich das weiß, nicht den normalen filecopy-befehl von VB verwenden, weil der dir sowas nicht anbietet…
Ich würde sagen, du liest die quelldatei bit für bit und schreibst auf der anderen seite die Zieldatei bit für bit.
Wenn du dir vorher die größe der quelldatei ausgelesen hast, dann kannst du mit einem zähler (bei welchem bit du gerade stehst) dir eine progressbar anzeigen lassen…
zum thema bitweises kopieren schau dir mal die MSDN zum Thema „open“ an.
Es ist schon lange her, aber die Syntax war ähnlich diesem:
OPEN AS FOR
(Die jeweils nächste freie Zugriffsnummer bekommst du mit dem Befehl „FREEFILE“)
Ich hoffe, du kannst was damit anfangen,
Gruß,
Tom
Frag doch einfach die Dateigröße der Kopie ab und setze sie in das Verhältnis zur Abfrqage der Dateigröße der Originaldatei.
Gruß Christian
Hallo Thomas,
mein vorschlag nutze den in Windows eingebauten kopierdialog.
Folgenden Code als Klasse einbinden.
Eine besonderheit die Dateinamen und NUR diese müssen,
wenn es sich um mehrer Dateien handelt, als Array übergeben
werden.
Alle Möglichkeiten der API-Function habe ich noch nicht ergründet.
MfG CB
Option Explicit
’ Shell File Operations
Enum ShellFlagsEnum
FOF_MULTIDESTFILES = &H1
FOF_CONFIRMMOUSE = &H2
FOF_SILENT = &H4 ’ don’t create progress/report
FOF_RENAMEONCOLLISION = &H8
FOF_NOCONFIRMATION = &H10 ’ Don’t prompt the user.
FOF_WANTMAPPINGHANDLE = &H20 ’ Fill in SHFILEOPSTRUCT.hNameMappings
’ Must be freed using SHFreeNameMappings
FOF_ALLOWUNDO = &H40
FOF_FILESONLY = &H80 ’ on *.*, do only files
FOF_SIMPLEPROGRESS = &H100 ’ means don’t show names of files
FOF_NOCONFIRMMKDIR = &H200 ’ don’t confirm making any needed dirs
End Enum
Private Const FO_MOVE = &H1
Private Const FO_COPY = &H2
Private Const FO_DELETE = &H3
Private Const FO_RENAME = &H4
'Private Const FOF_MULTIDESTFILES = &H1
'Private Const FOF_CONFIRMMOUSE = &H2
'Private Const FOF_SILENT = &H4 ’ don’t create progress/report
'Private Const FOF_RENAMEONCOLLISION = &H8
'Private Const FOF_NOCONFIRMATION = &H10 ’ Don’t prompt the user.
'Private Const FOF_WANTMAPPINGHANDLE = &H20 ’ Fill in SHFILEOPSTRUCT.hNameMappings
’ ’ Must be freed using SHFreeNameMappings
'Private Const FOF_ALLOWUNDO = &H40
'Private Const FOF_FILESONLY = &H80 ’ on *.*, do only files
'Private Const FOF_SIMPLEPROGRESS = &H100 ’ means don’t show names of files
'Private Const FOF_NOCONFIRMMKDIR = &H200 ’ don’t confirm making any needed dirs
Private 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 ’ only used if FOF_SIMPLEPROGRESS
End Type
Private Declare Function SHFileOperation Lib „shell32.dll“ Alias „SHFileOperationA“ (lpFileOp As SHFILEOPSTRUCT) As Long
’ Dateioperationen
Public Sub Copy(DateiNamen() As String, strQuellVerzeichnis As String, strZielVerzeichnis As String, intFlags As ShellFlagsEnum)
Dim filenames As String
Dim i As Integer
Dim shellinfo As SHFILEOPSTRUCT
Dim ret As Long
For i = 0 To UBound(DateiNamen)
filenames = filenames & strQuellVerzeichnis & „“ & DateiNamen(i) + Chr(0)
Next i
filenames = filenames + Chr(0)
With shellinfo
.Hwnd = Screen.ActiveForm.Hwnd
.wFunc = FO_COPY
.pFrom = filenames
.pTo = strZielVerzeichnis
.fFlags = intFlags + FOF_CONFIRMMOUSE
.fAnyOperationsAborted = False
End With
SHFileOperation shellinfo
End Sub
Public Function Move(DateiNamen() As String, strQuellVerzeichnis As String, strZielVerzeichnis As String, Optional inklusiveUnterverzeichnisse)
Dim filenames$
Dim i As Integer
Dim shellinfo As SHFILEOPSTRUCT
For i = 0 To UBound(DateiNamen)
filenames = filenames & strQuellVerzeichnis & DateiNamen(i) + Chr(0)
Next i
filenames = filenames + Chr(0)
With shellinfo
.Hwnd = Screen.ActiveForm.Hwnd
.wFunc = FO_MOVE
.pFrom = filenames
.pTo = strZielVerzeichnis
If Not IsMissing(inklusiveUnterverzeichnisse) Then
If Not inklusiveUnterverzeichnisse Then .fFlags = FOF_FILESONLY
End If
End With
SHFileOperation shellinfo
End Function
Public Function Delete(DateiNamen$(), Optional inklusiveUnterverzeichnisse)
Dim filenames$
Dim i As Integer
Dim shellinfo As SHFILEOPSTRUCT
For i = 0 To UBound(DateiNamen)
filenames = filenames & DateiNamen(i) + Chr(0)
Next i
filenames = filenames + Chr(0)
With shellinfo
.Hwnd = Screen.ActiveForm.Hwnd
.wFunc = FO_DELETE
.pFrom = filenames
.pTo = „“ + Chr(0)
If Not IsMissing(inklusiveUnterverzeichnisse) Then
If Not inklusiveUnterverzeichnisse Then .fFlags = FOF_FILESONLY
End If
End With
SHFileOperation shellinfo
End Function
Hallo Werner,
mein vorschlag nutze den in Windows eingebauten kopierdialog.
Folgenden Code als Klasse einbinden.
Eine besonderheit die Dateinamen und NUR diese müssen,
wenn es sich um mehrer Dateien handelt, als Array übergeben
werden.
Alle Möglichkeiten der API-Function habe ich noch nicht ergründet.
MfG CB
Option Explicit
’ Shell File Operations
Enum ShellFlagsEnum
FOF_MULTIDESTFILES = &H1
FOF_CONFIRMMOUSE = &H2
FOF_SILENT = &H4 ’ don’t create progress/report
FOF_RENAMEONCOLLISION = &H8
FOF_NOCONFIRMATION = &H10 ’ Don’t prompt the user.
FOF_WANTMAPPINGHANDLE = &H20 ’ Fill in SHFILEOPSTRUCT.hNameMappings
’ Must be freed using SHFreeNameMappings
FOF_ALLOWUNDO = &H40
FOF_FILESONLY = &H80 ’ on *.*, do only files
FOF_SIMPLEPROGRESS = &H100 ’ means don’t show names of files
FOF_NOCONFIRMMKDIR = &H200 ’ don’t confirm making any needed dirs
End Enum
Private Const FO_MOVE = &H1
Private Const FO_COPY = &H2
Private Const FO_DELETE = &H3
Private Const FO_RENAME = &H4
'Private Const FOF_MULTIDESTFILES = &H1
'Private Const FOF_CONFIRMMOUSE = &H2
'Private Const FOF_SILENT = &H4 ’ don’t create progress/report
'Private Const FOF_RENAMEONCOLLISION = &H8
'Private Const FOF_NOCONFIRMATION = &H10 ’ Don’t prompt the user.
'Private Const FOF_WANTMAPPINGHANDLE = &H20 ’ Fill in SHFILEOPSTRUCT.hNameMappings
’ ’ Must be freed using SHFreeNameMappings
'Private Const FOF_ALLOWUNDO = &H40
'Private Const FOF_FILESONLY = &H80 ’ on *.*, do only files
'Private Const FOF_SIMPLEPROGRESS = &H100 ’ means don’t show names of files
'Private Const FOF_NOCONFIRMMKDIR = &H200 ’ don’t confirm making any needed dirs
Private 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 ’ only used if FOF_SIMPLEPROGRESS
End Type
Private Declare Function SHFileOperation Lib „shell32.dll“ Alias „SHFileOperationA“ (lpFileOp As SHFILEOPSTRUCT) As Long
’ Dateioperationen
Public Sub Copy(DateiNamen() As String, strQuellVerzeichnis As String, strZielVerzeichnis As String, intFlags As ShellFlagsEnum)
Dim filenames As String
Dim i As Integer
Dim shellinfo As SHFILEOPSTRUCT
Dim ret As Long
For i = 0 To UBound(DateiNamen)
filenames = filenames & strQuellVerzeichnis & „“ & DateiNamen(i) + Chr(0)
Next i
filenames = filenames + Chr(0)
With shellinfo
.Hwnd = Screen.ActiveForm.Hwnd
.wFunc = FO_COPY
.pFrom = filenames
.pTo = strZielVerzeichnis
.fFlags = intFlags + FOF_CONFIRMMOUSE
.fAnyOperationsAborted = False
End With
SHFileOperation shellinfo
End Sub
Public Function Move(DateiNamen() As String, strQuellVerzeichnis As String, strZielVerzeichnis As String, Optional inklusiveUnterverzeichnisse)
Dim filenames$
Dim i As Integer
Dim shellinfo As SHFILEOPSTRUCT
For i = 0 To UBound(DateiNamen)
filenames = filenames & strQuellVerzeichnis & DateiNamen(i) + Chr(0)
Next i
filenames = filenames + Chr(0)
With shellinfo
.Hwnd = Screen.ActiveForm.Hwnd
.wFunc = FO_MOVE
.pFrom = filenames
.pTo = strZielVerzeichnis
If Not IsMissing(inklusiveUnterverzeichnisse) Then
If Not inklusiveUnterverzeichnisse Then .fFlags = FOF_FILESONLY
End If
End With
SHFileOperation shellinfo
End Function
Public Function Delete(DateiNamen$(), Optional inklusiveUnterverzeichnisse)
Dim filenames$
Dim i As Integer
Dim shellinfo As SHFILEOPSTRUCT
For i = 0 To UBound(DateiNamen)
filenames = filenames & DateiNamen(i) + Chr(0)
Next i
filenames = filenames + Chr(0)
With shellinfo
.Hwnd = Screen.ActiveForm.Hwnd
.wFunc = FO_DELETE
.pFrom = filenames
.pTo = „“ + Chr(0)
If Not IsMissing(inklusiveUnterverzeichnisse) Then
If Not inklusiveUnterverzeichnisse Then .fFlags = FOF_FILESONLY
End If
End With
SHFileOperation shellinfo
End Function
Versehen: Der text sollte an Werner gehen
siehe Titel
Hallo und Danke,
das ist schon das was ich suche! Allerdings hab ich noch ein problem mit dem Beispiel, wie ich es genau in VB einbaue, ein simples Beispiel hast du nicht noch parat? Weiß bin schon unverschämt, aber so gut bin ich in VB noch nicht.
Gruss
Werner
Hallo Werner,
hinzufügen eines klassenmoduls.
umbennen des Klassemoduls z.B. clsFileIO
dann ganzen text in dieses Klassenmodul einfügen.
dann Deklarieren und Initialisieren der klasse
Dim FileIO as New clsFileIO
dann die DATEINAMEN in ein Array(z.B. Dateinamen()) einlesen
Aufruf der Methoden der Klasse.
FileIO.Copy Dateinamen(),VonPfad,NachPfad
analog dazu die Methoden Move und Delete
der Dialog erscheint aber nur wenn der Vorgang mindestens 15 sekunden dauert
MfG CB
Hallo Christian,
Jetzt bin ich endlich mal zum Testen gekommen, aber leider stell ich mich wohl etwas zu dumm an, wie Deklariere und Initialisiere ich die klasse?
Weiß sind anfängerfragen …
Bekomme nähmlich so die Fehlermeldung Sub or Function not defined.
Grüsse
Werner
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
hallo Werner,
nachfolgenden text in ein Modul oder Form einfügen und ausführen.
Es werden alle dateien aus c:\ nach c:\shellcopytemp kopiert.
ich hoffe er hilft dir weiter.
MfG CB
public sub Kopieren
Dim intIdx As Integer
Dim strText As String
Dim ShellCopy As New FileOP
Dim strZielPfad As String
Dim strQuellDateien() As String
Dim strQuellPfad As String
ReDim strQuellDateien(0)
strZielPfad = „c:\ShellCopyTemp“
strQuellPfad = „c:“
strQuellDateien(0) = Dir(strQuellPfad & „*.*“, vbArchive + vbHidden + vbReadOnly + vbSystem)
Do Until strQuellDateien(UBound(strQuellDateien)) = „“
ReDim Preserve strQuellDateien(UBound(strQuellDateien) + 1)
strQuellDateien(UBound(strQuellDateien)) = Dir()
Loop
ReDim Preserve strQuellDateien(UBound(strQuellDateien) - 1)
If Not UBound(strQuellDateien) = 0 Then
ShellCopy.Copy strQuellDateien, strQuellPfad, strZielPfad, FOF_NOCONFIRMATION + FOF_NOCONFIRMMKDIR
End If
end sub