form1.frm

用于读取硬盘序列号的程序

Function GetDiskVolume(Optional ByVal strDiskName = "C") As String
    Dim TempStr1 As String * 256, TempStr2 As String * 256
    Dim TempLon1 As Long, TempLon2 As Long, GetVal As Long
    
    Dim tmpVol As String
    
    Call GetVolumeInformation(strDiskName & ":\", TempStr1, 256, GetVal, TempLon1, TempLon2, TempStr2, 256)
    If GetVal = 0 Then
        tmpVol = ""
    Else
        tmpVol = Hex(GetVal)
        tmpVol = String(8 - Len(tmpVol), "0") & tmpVol
        tmpVol = Left(tmpVol, 4) & "-" & Right(tmpVol, 4)
    End If
    GetDiskVolume = tmpVol
End Function

'取得硬盘信息：型号/物理系列号（唯一）
Function GetHardDiskInfo(Optional ByVal numDisk As eumDiskNo = hdPrimaryMaster, Optional ByVal numType As eumInfoType = hdOnlySN) As String

    If GetDiskInfo(numDisk) = 1 Then
        Dim pSerialNumber As String, pModelNumber As String
        pSerialNumber = StrConv(m_DiskInfo.sSerialNumber, vbUnicode)
        pModelNumber = StrConv(m_DiskInfo.sModelNumber, vbUnicode)
        
        Select Case numType
            Case hdOnlyModel  '仅型号
                GetHardDiskInfo = Trim(pModelNumber)
            Case hdOnlySN  '仅系列号
                GetHardDiskInfo = Trim(pSerialNumber)
            Case Else   '型号,系列号
                GetHardDiskInfo = Trim(pModelNumber) & "," & Trim(pSerialNumber)
        End Select
     End If

End Function

Private Function OpenSMART(ByVal nDrive As Byte) As Long
  Dim hSMARTIOCTL As Long
  Dim hd As String
  Dim VersionInfo As OSVERSIONINFO

    hSMARTIOCTL = INVALID_HANDLE_VALUE
    VersionInfo.dwOSVersionInfoSize = Len(VersionInfo)
    GetVersionEx VersionInfo
    Select Case VersionInfo.dwPlatformId
      Case VER_PLATFORM_WIN32s
        OpenSMART = hSMARTIOCTL
      Case VER_PLATFORM_WIN32_WINDOWS
        hSMARTIOCTL = CreateFile("\\.\SMARTVSD", 0, 0, 0, CREATE_NEW, 0, 0)
      Case VER_PLATFORM_WIN32_NT
        If nDrive < MAX_IDE_DRIVES Then
            hd = "\\.\PhysicalDrive" & nDrive
            hSMARTIOCTL = CreateFile(hd, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
        End If
    End Select
    OpenSMART = hSMARTIOCTL

End Function

Private Function DoIDENTIFY(ByVal hSMARTIOCTL As Long, pSCIP As SENDCMDINPARAMS, pSCOP() As Byte, ByVal bIDCmd As Byte, ByVal bDriveNum As Byte, lpcbBytesReturned As Long) As Boolean
    pSCIP.cBufferSize = IDENTIFY_BUFFER_SIZE

    pSCIP.irDriveRegs.bFeaturesReg = 0
    pSCIP.irDriveRegs.bSectorCountReg = 1
    pSCIP.irDriveRegs.bSectorNumberReg = 1
    pSCIP.irDriveRegs.bCylLowReg = 0
    pSCIP.irDriveRegs.bCylHighReg = 0

    pSCIP.irDriveRegs.bDriveHeadReg = &HA0 Or ((bDriveNum And 1) * 2 ^ 4)
    '
    pSCIP.irDriveRegs.bCommandReg = bIDCmd
    pSCIP.bDriveNumber = bDriveNum
    pSCIP.cBufferSize = IDENTIFY_BUFFER_SIZE
   DoIDENTIFY = CBool(DeviceIoControl(hSMARTIOCTL, DFP_RECEIVE_DRIVE_DATA, _
                 pSCIP, 32, _
                 pSCOP(0), 528, _
                 lpcbBytesReturned, 0))

End Function

Private Function DoEnableSMART(ByVal hSMARTIOCTL As Long, pSCIP As SENDCMDINPARAMS, pSCOP As SENDCMDOUTPARAMS, ByVal bDriveNum As Byte, lpcbBytesReturned As Long) As Boolean
    pSCIP.cBufferSize = 0

    pSCIP.irDriveRegs.bFeaturesReg = SMART_ENABLE_SMART_OPERATIONS
    pSCIP.irDriveRegs.bSectorCountReg = 1
    pSCIP.irDriveRegs.bSectorNumberReg = 1
    pSCIP.irDriveRegs.bCylLowReg = SMART_CYL_LOW
    pSCIP.irDriveRegs.bCylHighReg = SMART_CYL_HI
    pSCIP.irDriveRegs.bDriveHeadReg = &HA0 Or ((bDriveNum And 1) * 2 ^ 4)
    pSCIP.irDriveRegs.bCommandReg = IDE_EXECUTE_SMART_FUNCTION
    pSCIP.bDriveNumber = bDriveNum

    DoEnableSMART = CBool(DeviceIoControl(hSMARTIOCTL, DFP_SEND_DRIVE_COMMAND, _
                    pSCIP, LenB(pSCIP) - 1, _
                    pSCOP, LenB(pSCOP) - 1, _
                    lpcbBytesReturned, 0))

End Function

'---------------------------------------------------------------------
'---------------------------------------------------------------------
Private Sub ChangeByteOrder(szString() As Byte, ByVal uscStrSize As Integer)

  Dim I As Integer
  Dim bTemp As Byte

    For I = 0 To uscStrSize - 1 Step 2
        bTemp = szString(I)
        szString(I) = szString(I + 1)
        szString(I + 1) = bTemp
    Next I

End Sub

Private Sub DisplayIdInfo(pids As IDSECTOR, pSCIP As SENDCMDINPARAMS, ByVal bIDCmd As Byte, ByVal bDfpDriveMap As Byte, ByVal bDriveNum As Byte)

    ChangeByteOrder pids.sModelNumber, UBound(pids.sModelNumber) + 1

    ChangeByteOrder pids.sFirmwareRev, UBound(pids.sFirmwareRev) + 1

    ChangeByteOrder pids.sSerialNumber, UBound(pids.sSerialNumber) + 1

End Sub

Public Function GetDiskInfo(ByVal nDrive As Byte) As Long

  Dim hSMARTIOCTL As Long
  Dim cbBytesReturned As Long
  Dim VersionParams As GETVERSIONOUTPARAMS
  Dim scip As SENDCMDINPARAMS
  Dim scop() As Byte
  Dim OutCmd As SENDCMDOUTPARAMS
  Dim bDfpDriveMap As Byte
  Dim bIDCmd As Byte                    ' IDE or ATAPI IDENTIFY cmd
  Dim uDisk As IDSECTOR

    m_DiskInfo = uDisk
    '
    '
    hSMARTIOCTL = OpenSMART(nDrive)
    If hSMARTIOCTL <> INVALID_HANDLE_VALUE Then

        Call DeviceIoControl(hSMARTIOCTL, DFP_GET_VERSION, ByVal 0, 0, VersionParams, Len(VersionParams), cbBytesReturned, 0)

        If Not (VersionParams.bIDEDeviceMap \ 2 ^ nDrive And &H10) Then
            If DoEnableSMART(hSMARTIOCTL, scip, OutCmd, nDrive, cbBytesReturned) Then
                bDfpDriveMap = bDfpDriveMap Or 2 ^ nDrive
            End If
        End If
        bIDCmd = IIf((VersionParams.bIDEDeviceMap \ 2 ^ nDrive And &H10), IDE_ATAPI_ID, IDE_ID_FUNCTION)

        ReDim scop(LenB(OutCmd) + IDENTIFY_BUFFER_SIZE - 1) As Byte
        If DoIDENTIFY(hSMARTIOCTL, scip, scop, bIDCmd, nDrive, cbBytesReturned) Then
            CopyMemory m_DiskInfo, scop(LenB(OutCmd) - 4), LenB(m_DiskInfo)
            Call DisplayIdInfo(m_DiskInfo, scip, bIDCmd, bDfpDriveMap, nDrive)
            CloseHandle hSMARTIOCTL
            GetDiskInfo = 1
            Exit Function '>---> Bottom
        End If
        CloseHandle hSMARTIOCTL
        GetDiskInfo = 0
      Else 'NOT HSMARTIOCTL...
        GetDiskInfo = -1
    End If

End Function


Private Sub Command1_Click()
    Text1.Text = UCase(GetHardDiskInfo(hdPrimaryMaster, hdOnlySN))
End Sub

Private Sub Command2_Click()
    ''对文本内容反置
    Text2.Text = ChangeStringValue(Text1.Text)
End Sub

Private Function ChangeStringValue(ByVal in_Str As String) As String
    ChangeStringValue = ""
    
    Dim I, L As Integer
    Dim tmpStr As String
    tmpStr = ""
    
    L = Len(in_Str)
    
    For I = L To 1 Step -1
        tmpStr = tmpStr & Mid(in_Str, I, 1)
    Next
    ''取翻转后各字符的ASCII
    Dim SerialNum() As Byte
    ReDim SerialNum(0 To L - 1)
    For I = 1 To L
        SerialNum(I - 1) = Asc(Mid(tmpStr, I, 1))
    Next
    
    ''取大写字母作为密码钥匙，从A开始
    Dim Keys() As Byte
    ReDim Keys(0 To L - 1)
    If L > 26 Then
        For I = 0 To 25
            Keys(I) = Asc("A") + I
        Next
        For I = 26 To L - 1
            Keys(I) = Asc("A")
        Next
    Else
        For I = 0 To L - 1
            Keys(I) = Asc("A") + I
        Next
    End If
    
    tmpStr = ""
    ''原始数据与当前密码钥匙进行按字符异或
    For I = 0 To L - 1
        If Len(CStr(Hex(SerialNum(I) Xor Keys(I)))) = 1 Then
            tmpStr = tmpStr & "0" & CStr(Hex(SerialNum(I) Xor Keys(I)))
        Else
            tmpStr = tmpStr & CStr(Hex(SerialNum(I) Xor Keys(I)))
        End If
    Next
    
    ChangeStringValue = tmpStr
End Function

Private Sub Command4_Click()
    Text3.Text = RestoreOldDatas(Text2.Text)
End Sub

Private Function RestoreOldDatas(ByVal in_Str As String) As String
    RestoreOldDatas = ""
    
    Dim I, L As Integer
    Dim tmpStr As String
    tmpStr = ""
    
    L = Len(in_Str) / 2
    
    ''将数据拆分到字节数组中
    Dim SerialNum() As Byte
    ReDim SerialNum(0 To L - 1)
    For I = 1 To L
        SerialNum(I - 1) = CByte("&h" & Mid(in_Str, I * 2 - 1, 2))
    Next
    ''取大写字母作为密码钥匙，从A开始
    Dim Keys() As Byte
    ReDim Keys(0 To L - 1)
    If L > 26 Then
        For I = 0 To 25
            Keys(I) = Asc("A") + I
        Next
        For I = 26 To L - 1
            Keys(I) = Asc("A")
        Next
    Else
        For I = 0 To L - 1
            Keys(I) = Asc("A") + I
        Next
    End If
    
    tmpStr = ""
    ''原始数据与当前密码钥匙进行按字符异或
    For I = 0 To L - 1
        tmpStr = tmpStr & Chr(SerialNum(I) Xor Keys(I))
    Next
    
    ''将字符进行翻转
    For I = L To 1 Step -1
        RestoreOldDatas = RestoreOldDatas & Mid(tmpStr, I, 1)
    Next
End Function

Private Sub Form_Load()

End Sub