VBNet - Форум - Серийник винчестера

Вопрос: Серийник винчестера Добавлено: 31.01.06 15:55

Автор вопроса: Mihalыch | ICQ: 373-509-101

Почему приведенный ниже код не работает на Windows2003-server? Код взял из примера с VBNet, в описании сказано, что работает только на XP и Win2000, но почему, и как это поправить?

Option Explicit
    Private Declare Sub MemCpy Lib "KERNEL32" Alias "RtlMoveMemory" (ByVal hpvDest As Any, ByVal hpvSource As Any, ByVal cbCopy As Long)
    Private 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
    Private Declare Function CloseHandle Lib "KERNEL32" (ByVal hObject As Long) As Long
    Private Declare Function DeviceIoControl Lib "KERNEL32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, ByVal lpInBuffer As Long, ByVal nInBufferSize As Long, ByVal lpOutBuffer As Long, ByVal nOutBufferSize As Long, ByRef lpBytesReturned As Long, ByVal lpOverlapped As Long) As Long
    Private Type SrbIoControl
      HeaderLength  As Long
      Signature(7)  As Byte
      Timeout       As Long
      ControlCode   As Long
      ReturnCode    As Long
      Length        As Long
    End Type
    Private Type IDERegs
      bFeaturesReg      As Byte
      bSectorCountReg   As Byte
      bSectorNumberReg  As Byte
      bCylLowReg        As Byte
      bCylHighReg       As Byte
      bDriveHeadReg     As Byte
      bCommandReg       As Byte
      bReserved         As Byte
    End Type
    Private Type SendCmdInParams
      cBufferSize       As Long
      irDriveRegs       As IDERegs
      bDriveNumber      As Byte
      bReserved(2)      As Byte
      dwReserved(3)     As Long
      bBuffer(0) As Byte
    End Type
    Dim Buffer()     As Byte
    Dim buffin()        As Byte
    Dim buffout()       As Byte

Private Sub Command1_Click()
    Dim DataSize        As Integer
    Dim BufferSize      As Integer
    Dim srbControl      As SrbIoControl
    Dim SendCmdInParams As SendCmdInParams
    Dim hDevice         As Long
    Dim cbBytesReturned As Long
    Dim retval          As Long
    hDevice = CreateFile("\\.\PhysicalDrive0", &H40000000 Or &H80000000, &H1 Or &H2, 0, 3, 0, 0)
    If hDevice = -1 Then End
    DataSize = Len(SendCmdInParams) - 1 + 512
    BufferSize = Len(srbControl) + DataSize
    ReDim Buffer(BufferSize - 1)
    srbControl.HeaderLength = Len(srbControl)
    MemCpy VarPtr(srbControl.Signature(0)), "SCSIDISK", 8
    srbControl.Timeout = 2
    srbControl.ControlCode = &H1B0501
    srbControl.Length = DataSize
    With SendCmdInParams
      .cBufferSize = 512
      .bDriveNumber = 0
      With .irDriveRegs
        .bFeaturesReg = 0
        .bSectorCountReg = 1
        .bSectorNumberReg = 1
        .bCylLowReg = 0
        .bCylHighReg = 0
        .bDriveHeadReg = &HA0 Or ((0 And 1) * 8 ^ 4)
        .bCommandReg = &HEC
       End With
    End With
    MemCpy VarPtr(Buffer(0)), VarPtr(srbControl.HeaderLength), Len(srbControl)
    MemCpy VarPtr(Buffer(Len(srbControl))), VarPtr(SendCmdInParams.cBufferSize), _
    Len(SendCmdInParams)
    retval = DeviceIoControl(hDevice, &H4D008, VarPtr(Buffer(0)), BufferSize, _
    VarPtr(Buffer(0)), BufferSize, cbBytesReturned, 0)
    'вот здесь вызов ф-ии возвращает 0, почему?
    If retval = 0 Then End
    CloseHandle (hDevice)
    MsgBox "S/N - " & GetInfo(64, 20)
End Sub
Private Function GetInfo(offset As Integer, leninfo As Integer) As String
    Dim str As String
    ReDim buffin(leninfo - 1)
    MemCpy VarPtr(buffin(0)), VarPtr(Buffer(offset)), UBound(buffin) + 1
    ReverseOrderByte buffin, buffout
    str = String(UBound(buffin) + 1, " ")
    MemCpy str, VarPtr(buffout(0)), UBound(buffin) + 1
    str = LTrim(str)
    str = RTrim(str)
    GetInfo = str
End Function
Private Function ReverseOrderByte(buffin() As Byte, buffout() As Byte)
    Dim i As Integer
    Dim bufflen As Integer
    bufflen = UBound(buffin) + 1
    ReDim buffout(bufflen - 1)
    For i = 0 To (bufflen) - 1 Step 2
      buffout(i) = buffin(i + 1)
      buffout(i + 1) = buffin(i)
    Next
End Function

Ответить

Ответы Всего ответов: 5

Номер ответа: 1 Автор ответа: GeorgeGA Вопросов: 1 Ответов: 101	Профиль \| \| #1	Добавлено: 31.01.06 17:35
	Можешь попробывать через wmi,но на него нужны права администратора,причём он гораздо проще Ответить

Номер ответа: 2 Автор ответа: Dushes ICQ: 249195431 Вопросов: 8 Ответов: 110	Профиль \| \| #2	Добавлено: 01.02.06 14:01
	Права админа не всегда нужны. Зависит лишь от того, оставил админ доступ к WMI или нет. Я пока еще ни разу нигде не видел запрета на WMI. Ответить

Номер ответа: 3 Автор ответа: GeorgeGA Вопросов: 1 Ответов: 101	Профиль \| \| #3	Добавлено: 01.02.06 16:41
	значит там храбрые админы Ответить

Номер ответа: 4 Автор ответа: Mihalыch ICQ: 373-509-101 Вопросов: 56 Ответов: 330	Профиль \| \| #4	Добавлено: 03.02.06 14:16
	2Dushes, 2GeorgeGA, спасибо! Но у меня вопрос, если речь идет примерно о таком коде: Private Sub Form_Load() Dim obj As SWbemObjectEx MsgBox GetObject("WinMgmts:Win32_LogicalDisk='C:'".VolumeSerialNumber End Sub но ведь это не тот серийный номер, который присваивается на заводе изготовителе, может есть вариант узнать и его? Ответить

Номер ответа: 5 Автор ответа: Fever Вопросов: 60 Ответов: 808	Профиль \| \| #5	Добавлено: 03.02.06 18:01
	Под Win32 вооще мультимедиа не работает. Брось неблагодарное занятие и переходи на Linux Ответить

Страница: 1 |