取硬碟物理序號的完整代碼

讀硬碟的物理序號，有些情況下讀不出，比如SCSI硬碟，或是使用者用了虛擬機器，都讀不出的，據說現在很流行的SATA硬碟也讀不出。
我的方法是：如果能取到物理序號，就用物理序號，如果取不到就用卷序號。

虛擬碼：

-------------------------------
取一下物理序號
if 成功 then
   用物理序號
else
   用卷序號
end if
--------------------------------

要想判斷取物理序號是否成功，要經過三重判斷。
第一道：如果取到的8個位元組都是0，那麼說明失敗了。
第二道：取完第一次後再取一次，如果兩次的結果不同，說明你取到的物理序號是個隨機值，也不能用，也算失敗。
第三道：出現API異常，也說明失敗了。需要用API做異常替換，攔截API的異常，以保證在VB中處理。

至於說怎麼取到卷序號，就比較簡單了，可以用API函數GetVolumeInformation,可以參考msdn，無須贅述。

我有一個取硬碟物理序號的完整代碼，做了上述的所有處理，比較穩固，可以拿來用。Dll檔案是從  appleVB 下載的：(感謝www.applevb.com)。

源碼及DLL檔案的是:http://lqweb.crcoo.com/mycode/Hard_Disk_Physical_ID.zip

---------------------------------------------------------------------------------------------------------------------------

再來詳細的解說一下上述代碼中用到的截獲DLL異常的方法：要想截獲DLL異常，需要用到一個API函數SetUnhandledExceptionFilter。

SetUnhandledExceptionFilter的功能是替換系統預設的異常處理函數。 程式運行中所有得不到處理的異常都要經過全域異常處理函數來處理。用這個函數可以把系統預設的全域異常處理函數替換成一個普通的VB函數，替換之後，程式運行中發生的所有得不到處理的異常都要由這個VB中的函數來處理。更詳細的資訊請參考msdn.

參數 ByVal lpTopLevelExceptionFilter As Long 就是你要替換的函數的地址。如果把該參數設定為0，則表示還原系統預設的全域異常處理函數。
你可以試一下，在一個標準模組中定義一個替代全域異常處理函數的普通VB函數,定義如下：

'新的異常處理函數
Public Function NewExceptionHandler( _
    ByRef lpExceptionPointers As EXCEPTION_POINTERS) As Long
   
    msgbox "截獲了系統異常"
End Function

然後在form_load事件中，寫如下代碼：

SetUnhandledExceptionFilter addressof NewExceptionHandler

form_unload中寫如下代碼：
SetUnhandledExceptionFilter 0&

接下來運行程式，就可以截獲異常了，包括外部DLL所引發的異常也能截獲，大大增強了VB程式的除錯機制。
我把全部代碼發上來，可以參考一下。

module1.bas----------------------------------------------------------------
Option Explicit

'替換系統的預設錯誤處理程式的函數。
Public Declare Function SetUnhandledExceptionFilter _
Lib "kernel32" (ByVal lpTopLevelExceptionFilter As Long) _
As Long

Private Type EXCEPTION_POINTERS
    pExceptionRecord As Long
    ContextRecord As Long
End Type

'新的異常處理函數
Public Function NewExceptionHandler( _
    ByRef lpExceptionPointers As EXCEPTION_POINTERS) As Long
   
    MsgBox "截獲了系統異常！"
End Function

--------------------------------------------------------------------------
form1.frm-----------------------------------------------------------------
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Sub Command1_Click()
CopyMemory ByVal 0&, 8&, 4
End Sub

Private Sub Form_Load()
SetUnhandledExceptionFilter AddressOf NewExceptionHandler

End Sub

Private Sub Form_Unload(Cancel As Integer)
SetUnhandledExceptionFilter 0&
End Sub

--------------------------------------------------------------------------