Bonjour,
Je cherche à obtenir le numéro de série de mon disque dur sous PB.
Vu qu'il n'y a plus accès aux interruptions assembleur, quelqu'un aurait-il la connaissance d'une fonction DLL qui remplirait cette tâche?
Récupérer le numéro de série du volume du disque dur
-
Kwai chang caine
- Messages : 6989
- Inscription : sam. 23/sept./2006 18:32
- Localisation : Isere
Bonjour ollivier
Moi j'ai ce code de RINGS pour PB 4.0, si ça peut te dépanner :
Bonne journée
Moi j'ai ce code de RINGS pour PB 4.0, si ça peut te dépanner :
Code : Tout sélectionner
; German forum: http://robsite.de/php/pureboard/viewtopic.php?t=1388&highlight=
; Author: Rings
; Date: 17. June 2003
; Retrieve harddisk`s modell,serial,firmware (Windows only)
; updated on 27. August 2003 - "[]" brackets in structures
Structure IDEREGS
bFeaturesReg.b
bSectorCountReg.b
bSectorNumberReg.b
bCylLowReg.b
bCylHighReg.b
bDriveHeadReg.b
bCommandReg.b
bReserved.b
EndStructure
Structure SENDCMDINPARAMS
cBufferSize.l
irDriveRegs.IDEREGS
bDriveNumber.b
bReserved.b[3]
dwReserved.l[4]
EndStructure
Structure DRIVERSTATUS
bDriveError.b
bIDEStatus.b
bReserved.b[2]
dwReserved.l[2]
EndStructure
Structure SENDCMDOUTPARAMS
cBufferSize.l
DStatus.DRIVERSTATUS
bBuffer.b[512]
EndStructure
#DFP_RECEIVE_DRIVE_DATA = $7C088
bin.SENDCMDINPARAMS
bout.SENDCMDOUTPARAMS
Procedure.s ChangeHighLowByte(Instring.s)
;Change BIG-Little Endian
sdummy.s=""
L=Len(Instring)
For I=1 To L Step 2
If (I+1)<=L
sdummy.s=sdummy.s + Mid(Instring,I+1,1)+Mid(Instring,I,1)
EndIf
Next I
ProcedureReturn sdummy.s
EndProcedure
mvarCurrentDrive=0 ;If you have more hard-disks change it here
hdh = CreateFile_("\\.\PhysicalDrive" + Str(mvarCurrentDrive),#GENERIC_READ | #GENERIC_WRITE, #FILE_SHARE_READ | #FILE_SHARE_WRITE,0, #OPEN_EXISTING, 0, 0)
If hdh
bin\bDriveNumber = mvarCurrentDrive
bin\cBufferSize = 512
If (mvarCurrentDrive & 1)
bin\irDriveRegs\bDriveHeadReg = $B0
Else
bin\irDriveRegs\bDriveHeadReg = $A0
EndIf
bin\irDriveRegs\bCommandReg = $EC
bin\irDriveRegs\bSectorCountReg = 1
bin\irDriveRegs\bSectorNumberReg = 1
br=0
Result=DeviceIoControl_( hdh, #DFP_RECEIVE_DRIVE_DATA, bin, SizeOf(SENDCMDINPARAMS), bout, SizeOf(SENDCMDOUTPARAMS), @br, 0)
If br>0
hddfr = 55:hddln = 40 :
Modell.s=ChangeHighLowByte(PeekS(@bout\bBuffer[0]+hddfr-1 ,hddln ) )
hddfr = 21:hddln = 20 :
Serial.s=Trim(ChangeHighLowByte(PeekS(@bout\bBuffer[0]+hddfr-1 ,hddln ) ))
hddfr = 47:hddln = 8
Firmware.s=ChangeHighLowByte(PeekS(@bout\bBuffer[0]+hddfr-1 ,hddln ) )
MessageRequester("Info about your harddisk","vendor(Modell)="+Modell.s + Chr(13) +"serial="+Serial.s+ Chr(13)+"Firmwareversion="+Firmware ,0)
EndIf
Else
Beep_(100,100)
EndIf
Merci Kcc. Par contre, je ne comprends pas trop pourquoi un fichier est créé?
Moi j'ai récup ce code-là du forum officiel. Flype a fait une modif mais je suis trop peu expérimenté pour savoir de quoi il s'agit.
Moi j'ai récup ce code-là du forum officiel. Flype a fait une modif mais je suis trop peu expérimenté pour savoir de quoi il s'agit.
Code : Tout sélectionner
; HDAvail - updated 10/07/2003 by TerryHough
; updated for PB4 & corrected VSN display 29/5/2006 by mskuma
; based on code samples from the PB Forum
; from PB forums by fweil
; post http://jconserv.net/purebasic/viewtopic.php?t=3770
; GetFreeDiskSpace - 09/24/2003 Updated by TerryHough
; from PB forums by GPI
; post http://jconserv.net/purebasic/viewtopic.php?t=7541
; ------------- Procedures to get Total and Free Disk Space --------------
Global Free$
Global Total$
Structure HiLow
lowlow.w
lowhi.w
hilow.w
hihi.w
EndStructure
; ----------------- Get the Free Disk Space ----------------
Procedure.s GetFreeSpace(p$)
#div=10
#mask=(1<<#div)-1
#mul=16-#div
If Left(p$,2)="\\"
a=FindString(p$,"\",3)
Else
a=FindString(p$,"\",1)
EndIf
If a=0 : a=Len(p$) : EndIf
p$=Left(p$,a)
If GetDiskFreeSpaceEx_(@p$,@free.HiLow,@Total.HiLow,@TotalFree.HiLow)
hilow=free\hilow&$ffff
hihi=free\hihi&$ffff
lowlow=free\lowlow&$ffff
lowhi=free\lowhi&$ffff
p=1
While hihi>0 Or hilow>0 Or lowhi>0
lowlow=(lowlow>>#div)+((lowhi&#mask)<<#mul)
lowhi =(lowhi >>#div)+((hilow&#mask)<<#mul)
hilow =(hilow >>#div)+((hihi&#mask)<<#mul)
hihi =(hihi>>#div)
p+1
Wend
If lowlow>1024
Free$= StrF(lowlow/1024,2)+" "+StringField("Byte,Kb,Mb,Gb,Tb",p+1,",")
Else
Free$= StrF(lowlow,2)+" "+StringField("Byte,Kb,Mb,Gb,Tb",p,",")
EndIf
Else
Free$="---"
EndIf
ProcedureReturn Free$
EndProcedure
; ----------------- Get the Total Disk Space ----------------
; created from GetFreeSpace by GPI shown above. Could be in one procedure.
Procedure.s GetTotalSpace(p$)
#div=10
#mask=(1<<#div)-1
#mul=16-#div
If Left(p$,2)="\\"
a=FindString(p$,"\",3)
Else
a=FindString(p$,"\",1)
EndIf
If a=0 : a=Len(p$) : EndIf
p$=Left(p$,a)
If GetDiskFreeSpaceEx_(@p$,@free.HiLow,@Total.HiLow,@TotalFree.HiLow)
hilow=Total\hilow&$ffff
hihi=Total\hihi&$ffff
lowlow=Total\lowlow&$ffff
lowhi=Total\lowhi&$ffff
p=1
While hihi>0 Or hilow>0 Or lowhi>0
lowlow=(lowlow>>#div)+((lowhi&#mask)<<#mul)
lowhi =(lowhi >>#div)+((hilow&#mask)<<#mul)
hilow =(hilow >>#div)+((hihi&#mask)<<#mul)
hihi =(hihi>>#div)
p+1
Wend
If lowlow>1024
Total$= StrF(lowlow/1024,2)+" "+StringField("Byte,Kb,Mb,Gb,Tb",p+1,",")
Else
Total$= StrF(lowlow,2)+" "+StringField("Byte,Kb,Mb,Gb,Tb",p,",")
EndIf
Else
Total$="---"
EndIf
ProcedureReturn Total$
EndProcedure
; ----------------- Procedures used by HDAvail program code --------------
Procedure DisplayHelp()
Help$ = ""
Help$ + "Checks the list of available drives and reports some information about them." + Chr(10)
Help$ + "This includes:" + Chr(10)
Help$ + Chr(9) + "Drive letter (ID)" + Chr(10)
Help$ + Chr(9) + "Drive label" + Chr(10)
Help$ + Chr(9) + "Drive serial number" + Chr(10)
Help$ + Chr(9) + "File system used" + Chr(10)
Help$ + Chr(9) + "Drive type" + Chr(10)
Help$ + Chr(9) + "Drive status" + Chr(10)
Help$ + Chr(9) + "Total drive space" + Chr(10)
Help$ + Chr(9) + "Free space available" + Chr(10)
Help$ + Chr(10)
Help$ + "Pressing F1 displays this information." + Chr(10)
Help$ + "Pressing F10 repeats the drive analysis." + Chr(10) + Chr(10)
Help$ + "Closing the program by pressing the ESCape key." + Chr(10)
MessageRequester("Available Drives",Help$,#MB_ICONINFORMATION)
EndProcedure
Procedure.s sGetDriveType(Parameter.s)
Result.s
Select GetDriveType_(Parameter)
Case 2
Result = "Removable Drive"
Case 3
Result = "Fixed Drive"
Case 4
Result = "Remote (Network)"
Case 5
Result = "CDRom Drive"
Case 6
Result = "RAM Drive"
Default
Result = "Unknown"
EndSelect
ProcedureReturn Result
EndProcedure
; ----------------- UpdateDrives identifies/analyzes available drives --------
Procedure UpdateDrives(Delay.l)
*Buffer = AllocateMemory(255)
ipt.l
C.l
Serial.l
LogicalDriveType.s
VName.s
FSName.s
Text.s
EOL.s
VName = Space(255)
FSName = Space(255)
Dim LogicalDrives.s(16) ; Allow room for up to 16 drives
; ClearGadgetItemList(10) ; Erase the list of items
LogicalDrives(1) = "" ; Set the first table entry to null
ipt = 1 ; Initialize the items counter to 1
; Get the drives names in *Buffer and split it into a table
;
; GetLogicalDriveStrings writes the list of drives names
; in a buffer, each name being Chr(0) separated.
; The end of the buffer contains a double Chr(0).
For i = 0 To GetLogicalDriveStrings_(255, *Buffer)
C = PeekB(*Buffer + i)
If C <> 0
LogicalDrives(ipt) = UCase(LogicalDrives(ipt) + Chr(C))
Else
ipt = ipt + 1
LogicalDrives(ipt) = ""
EndIf
Next
; Decrease the last entry number until no null item is found
While LogicalDrives(ipt) = ""
ipt = ipt - 1
Wend
; Loop to give further information about found drives
; Values I found in different documents are not so clear. This has to be checked.
For i = 1 To ipt
LogicalDriveType = sGetDriveType(LogicalDrives(i))
; Items are displayed using found parameters or filling status for not available drives
If GetVolumeInformation_(LogicalDrives(i), VName, 255, @Serial, 0, 0, FSName, 255)
GetFreeSpace(LogicalDrives(i))
GetTotalSpace(LogicalDrives(i))
Text = LogicalDrives(i) + Chr(10) + VName + Chr(10) + Str(Serial) + Chr(10) + FSName + Chr(10) + LogicalDriveType + Chr(10) + " " + Chr(10) + Total$ + Chr(10) + Free$
Else
Text = LogicalDrives(i) + Chr(10) + Chr(10) + Chr(10) + Chr(10) + LogicalDriveType
If GetLastError_() = 21
Text = Text + Chr(10) + "Device not ready"
Else
Text = Text + Chr(10) + "LastError: " + Str(GetLastError_())
EndIf
EndIf
AddGadgetItem(10, -1, Text)
Next
EndProcedure
; ----------------- Main program starts here ----------------
Quit.l
WEvent.l
EventMenu.l
Serial.l
Delay.l
Parameter.s
LogicalDriveType.s
VName.s
FSName.s
Text.s
Quit = #False
errmode = SetErrorMode_(#SEM_FAILCRITICALERRORS)
If OpenWindow(0, 0, 0, 624, 315, "Available Drives", #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_TitleBar)
AddKeyboardShortcut(0, #PB_Shortcut_F1, 20)
AddKeyboardShortcut(0, #PB_Shortcut_F10, 30)
AddKeyboardShortcut(0, #PB_Shortcut_Escape, 99)
If CreateGadgetList(WindowID(0))
ListIconGadget(10, 10, 30, 604, 246, "Drive", 50, #PB_ListIcon_GridLines)
AddGadgetColumn(10, 1, "Label", 80)
AddGadgetColumn(10, 2, "Serial", 50)
AddGadgetColumn(10, 3, "FS", 50)
AddGadgetColumn(10, 4, "Type", 110)
AddGadgetColumn(10, 5, "Status", 120)
AddGadgetColumn(10, 6, "Size", 70)
AddGadgetColumn(10, 7, "Free space", 70)
HideGadget(10,1)
TextGadget(20, 1, 280, 603, 15, "It will take a moment to do the analysis, please wait.", #PB_Text_Center)
EndIf
If CreateStatusBar(0, WindowID(0))
StatusBarText(0, 0, "F1 - Help | F10 - Repeat | Esc - Quit", 0)
EndIf
If CreateToolBar(0, WindowID(0))
ToolBarStandardButton(30, #PB_ToolBarIcon_Redo)
ToolBarToolTip(0, 30, "Refresh the Drive List")
ToolBarSeparator()
ToolBarStandardButton(20, #PB_ToolBarIcon_Help)
ToolBarToolTip(0, 20, "Display a Help screen")
ToolBarSeparator()
EndIf
While WindowEvent():Wend ; Give the window a chance to display
UpdateDrives(0)
SetGadgetText(20,"Drive analysis completed.")
HideGadget(10,0)
Repeat
WEvent = WaitWindowEvent()
Select WEvent
Case #PB_Event_CloseWindow
Quit = #True
Case #PB_Event_Menu
EventMenu = EventMenu()
Select EventMenu
Case 20
DisplayHelp()
Case 30
HideGadget(10,1)
ClearGadgetItemList(10) ; Clear the previous list
SetGadgetText(20,"It will take a moment to do the analysis, please wait.")
UpdateDrives(0)
SetGadgetText(20,"Drive analysis completed.")
HideGadget(10,0)
Case 99
Quit = #True
EndSelect
Default
EndSelect
Until Quit
EndIf
End
; ---------------------------- End of Program Code --------------- 