VB-Homepage Tipp 070
Disketten formatieren und kopieren
Hier möchte ich eine Möglichkeit vorstellen, aus VB heraus auf systemeigene Prozeduren zu zugreifen um Disketten zu formatieren bzw. zu kopieren.

Erstmals will ich mal eine neue Form testen, den Quellcode zur Verfügung zu stellen. Und zwar in Form der jeweiligen Projekt und Formdatei.

Sie müssen sich den Text kopieren, eine Datei mit dem vorgegbenen Namen anlegen und den Text einfügen.

diskcopy.vbp
Form=diskcopy.frm
ProjWinSize=124,481,248,215
ProjWinShow=2
ExeName32="diskcopy.exe"
Name="Projekt1"
HelpContextID="0"
StartMode=0
VersionCompatible32="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName=""

diskcopy.frm
VERSION 4.00
Begin VB.Form Form1
BorderStyle = 4 'Fixed ToolWindow
Caption = "Formatieren und Kopieren von Disketten aus VB heraus"
ClientHeight = 1770
ClientLeft = 1140
ClientTop = 1515
ClientWidth = 5745
Height = 2175
Left = 1080
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1770
ScaleWidth = 5745
ShowInTaskbar = 0 'False
Top = 1170
Width = 5865
Begin VB.DriveListBox Drive1
Height = 315
Left = 2520
TabIndex = 2
Top = 120
Width = 3135
End
Begin VB.CommandButton cmdDiskCopy
Caption = "Diskette kopieren"
Height = 375
Left = 120
TabIndex = 1
Top = 600
Width = 2055
End
Begin VB.CommandButton cmdFormat
Caption = "Diskette formatieren"
Height = 375
Left = 120
TabIndex = 0
Top = 120
Width = 2055
End
Begin VB.Label Label2
Caption = "A.Gamper http://vb-homepage"
Height = 495
Left = 2520
TabIndex = 4
Top = 600
Width = 3135
End
Begin VB.Label Label1
Caption = "Orginalidee von : Duncan Diep (Duncan.Diep@myna.com)"
Height = 255
Left = 120
TabIndex = 3
Top = 1440
Width = 4455
End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Private Declare Function SHFormatDrive Lib "shell32" (ByVal hwnd As Long, ByVal Drive As Long, ByVal fmtID As Long, ByVal options As Long) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Sub Drive1_Change()
Dim DriveLetter$, DriveNumber&, DriveType&
DriveLetter = UCase(Drive1.Drive)
DriveNumber = (Asc(DriveLetter) - 65)
DriveType = GetDriveType(DriveLetter)
If DriveType <> 2 Then 'Floppies, etc
cmdDiskCopy.Enabled = False
Else
cmdDiskCopy.Enabled = True
End If
End Sub
Private Sub cmdFormat_Click()
Dim DriveLetter$, DriveNumber&, DriveType&
Dim RetVal&, RetFromMsg%
DriveLetter = UCase(Drive1.Drive)
DriveNumber = (Asc(DriveLetter) - 65)
DriveType = GetDriveType(DriveLetter)
If DriveType = 2 Then 'Disklaufwerke und Laufwerke mit austauschbarem Datenträger
RetVal = SHFormatDrive(Me.hwnd, DriveNumber, 0&, 0&)
Else
RetFromMsg = MsgBox("Dieses Laufwerk besitzt keinen austauschbaren Datenträger" & vbCrLf & "Trotzdem formatieren ??", 276, "DISK FORMATIEREN")
Select Case RetFromMsg
Case 6 'Yes
'Auskommentieren, wenn auch Festplatten formatiert werden sollen
'RetVal = SHFormatDrive(Me.hwnd, DriveNumber, 0&, 0&)
Case 7 'No
' Auswahl war Nein
End Select
End If
End Sub
Private Sub cmdDiskCopy_Click()
Dim DriveLetter$, DriveNumber&, DriveType&
Dim RetVal&, RetFromMsg&
DriveLetter = UCase(Drive1.Drive)
DriveNumber = (Asc(DriveLetter) - 65)
DriveType = GetDriveType(DriveLetter)
If DriveType = 2 Then 'Disklaufwerke und Laufwerke mit austauschbarem Datenträger
RetVal = Shell("rundll32.exe diskcopy.dll,DiskCopyRunDll " & DriveNumber & "," & DriveNumber, 1) 'Notice space after
Else
RetFromMsg = MsgBox("Das gewählte Laufwerk ist kein austauschbarer Datenträger" & vbCrLf & "Bitte Laufwerk auswählen.", 64, "DISK KOPIEREN")
End If
If cmdDiskCopy.Enabled = False Then cmdDiskCopy.Enabled = True 'kann bei einem Abbruch passieren
End Sub
Tipp-Download
Quelle :
Zurück zur Übersichtsseite