, um hier einen code für pb4 zu posten :
Code: Alles auswählen
Option Explicit
'Ce code est adapté de l'article de Mark Russinovich,
'expert en Windows NT/2000/XP
'http://www.sysinternals.com/ntw2k/source/fmifs.shtml
'
' structure de la commande OUTPUT
'
Public Type TEXTOUTPUT
Lines As Long
Output As String
End Type
'
' Commande passée à la callback
'
Public Enum CALLBACKCOMMAND
Progress = 0
DONEWITHSTRUCTURE
UNKNOWN2
UNKNOWN3
UNKNOWN4
UNKNOWN5
INSUFFICIENTRIGHTS
UNKNOWN7
UNKNOWN8
UNKNOWN9
UNKNOWNA
DONE
UNKNOWNC
UNKNOWND
Output
STRUCTUREPROGRESS
End Enum
'
' focntion Chkdsk
'
Public Declare Sub Chkdsk Lib "fmifs.dll" (ByVal DriveRoot As Long, _
ByVal Format As Long, _
ByVal CorrectErrors As Byte, _
ByVal Verbose As Byte, _
ByVal CheckOnlyIfDirty As Byte, _
ByVal ScanDrive As Byte, _
ByVal Unused2 As Long, _
ByVal Unused3 As Long, _
ByVal Callback As Long)
'des focntions pour le controle de la mémoire et des pointeurs
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function IsBadReadPtr Lib "kernel32" (ByVal lp As Long, ByVal ucb As Long) As Long
Public Declare Function IsBadStringPtr Lib "kernel32" Alias "IsBadStringPtrA" (ByVal lpsz As Long, ByVal ucchMax As Long) As Long
Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
Public Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Public Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const OPEN_EXISTING = 3
'
' FMIFS fontion callback
'
Public Function PFMIFSCALLBACK(ByVal Command As Long, ByVal SubAction As Long, ByVal ActionInfo As Long) As Byte
Dim percent As Long
Dim status As Long
Dim OutStrPtr As Long, OutLines As Long
Dim OutLen As Long, Output As String
DoEvents
'
' La callback recoit d'autres messages sans importance
'
Select Case Command
Case 0 'PROGRESS
' si c un message de progression, ActionInfo contient un pointeur vers un long qui représente le pourcentage
'on le copie
CopyMemory ByVal VarPtr(percent), ByVal ActionInfo, 4
'on actualise l'affichage
Form1.PB.Value = percent
Case 14 'OUTPUT
'si c un message d'affichage, ActionInfo contient un pointeur vers un long et vers un pointeur vers une chaine de caracteres
'on verifie si ActionInfo est un pointeur valide pour lecture
If IsBadReadPtr(ByVal ActionInfo, 8) = 0 Then
'si oui, on copie le nombre de lignes du message
CopyMemory ByVal VarPtr(OutLines), ByVal ActionInfo, 4
'on copie le pointeur vers une chaine
CopyMemory ByVal VarPtr(OutStrPtr), ByVal ActionInfo + 4, 4
'on verifie si ce pointeur est un pointeur de texte valide
If IsBadStringPtr(ByVal OutStrPtr, 255) = 0 Then
'si oui, on cherhce la longueur du texte
OutLen = lstrlen(ByVal OutStrPtr)
'on prépare un buffer
Output = Space(OutLen * 2)
'on copie le texte
CopyMemory ByVal StrPtr(Output), ByVal OutStrPtr, OutLen * 2
'on le convertit d'unicode en Ansi
Output = StrConv(Output, vbUnicode, 1036)
'on le convertit de OEM Ansi en Ansi
OemToChar Output, Output
'on supprime les caracteres apres le null
Output = Mid$(Output, 1, InStr(Output, vbNullChar) - 1)
'on affiche le message
Form1.List1.AddItem Output
End If
End If
Case 11 'DONE
'si c un message qui annonce la fin d'un traitement
'on copie le status
CopyMemory ByVal VarPtr(status), ByVal ActionInfo, 1
'si le status est 0 c qu'il s'est produit une erreur
If status = 0 Then
Form1.List1.AddItem "Une erreur s'est produite pendant la vérification du disque !"
Else
Form1.List1.AddItem "Terminé avec succés !"
End If
Case Else
'sinon commande inconnue
Form1.List1.AddItem "Callback Command Unknown. (Command=" & Command & ",SubAction=" & SubAction & ",ActionInfo=" & ActionInfo & ")"
End Select
Form1.List1.ListIndex = Form1.List1.NewIndex
'on renvoie toujours 1
PFMIFSCALLBACK = 1
End FunctionCode: Alles auswählen
;MediaFlag
#FMIFS_HARDDISK = $C
#FMIFS_FLOPPY = $8
;ClusterSize
#FMIFS_SizeDefault = 0
#FMIFS_Size512 = 512
#FMIFS_Size1K = 1024
#FMIFS_Size2K = 2048
#FMIFS_Size4K = 4096
#FMIFS_Size8K = 8192
#FMIFS_Size16K = 16384
#FMIFS_Size32K = 32768
#FMIFS_Size64K = 65536
#FMIFS_Size128K = 131072
#FMIFS_Size256K = 262144
;Command
#FMIFS_Progress = 0
#FMIFS_DoneWithStructure = 1
#FMIFS_InsufficientRights = 6
#FMIFS_WriteProtected = 7
#FMIFS_Done = 11
#FMIFS_OutPut = 14
#FMIFS_StructureProgress = 15
Procedure FormatexCallBack(lngCommand.l,lngSubAction.l,ActionInfo.l)
Select lngCommand
Case #FMIFS_Progress
CopyMemory(ActionInfo,@lngInfo,4)
Debug lngInfo
Case #FMIFS_DoneWithStructure
Debug "done"
Case #FMIFS_InsufficientRights
Case #FMIFS_WriteProtected
Debug "WriteProtected"
Case #FMIFS_Done
CopyMemory(ActionInfo,@Result,1)
Debug result
Case #FMIFS_OutPut
Case #FMIFS_StructureProgress
EndSelect
ProcedureReturn = 1
EndProcedure
Procedure PWCHAR(tmp.s)
tmplen = Len(tmp) * 2
wbuf = AllocateMemory(tmplen)
MultiByteToWideChar_(#CP_ACP, 0, tmp, -1, wbuf, tmplen)
ProcedureReturn wbuf
EndProcedure
OpenLibrary (0, "FMIFS.DLL")
CallFunction (0, "FormatEx",PWCHAR("A:\"),#FMIFS_FLOPPY,PWCHAR("FAT"),PWCHAR("1234"),0,#FMIFS_SizeDefault,@FormatExCallback())
CloseLibrary(0)
