Ответы на все вопросы

FAQ / Программирование / Delphi

Как узнать серийный номер винчестера или материнской платы?

Вопрос:

    Как узнать серийный номер винчестера или материнской платы?
    

Ответ:

    На счёт жёсткого диска - надо использовать процедуру GetVolumeInformation. Можете посмотреть в помощи, но приведу отрывок из компонента, сделанного специально для этого (к сожалению, автор компонента не обозначил себя в архиве с файлами компонента, а то бы я обязательно написал о нём):
    procedure TAboutDisk.SetDisk(Value: Char); //здесь
    параметр - буква диска
    var
    VolumeLabel, FileSystem: Array[0..$FF] of Char;
    SerialNumber, DW, SysFlags: DWord;
    function DecToHex(aValue: LongInt): String;
    var
    w: Array[1..2] of Word absolute aValue;
    function HexByte(b: Byte): String;
    const
    Hex: Array[$0..$F] of Char = '0123456789ABCDEF';
    begin
    HexByte := Hex[b shr 4] + Hex[b and $F];
    end;
    function HexWord(w: Word): String;
    begin
    HexWord := HexByte(Hi(w)) + HexByte(Lo(w));
    end;
    begin
    Result := HexWord(w[2]) + HexWord(w[1]);
    end;
    begin
    Value := UpCase(Value);
    if (Value >= 'A') and (Value <= 'Z') then
    begin
    FDisk := Value;
    GetVolumeInformation(PChar(Value + ':\'),
    VolumeLabel, SizeOf(VolumeLabel),
    @SerialNumber, DW, SysFlags,
    FileSystem, SizeOf(FileSystem));
    FSerialNumber := SerialNumber;
    FSerialNumberStr := DecToHex(SerialNumber);
    //вот он, серийничек
    Insert('-', FSerialNumberStr, 5);
    FVolumeLabel := VolumeLabel;
    FFileSystem := FileSystem;
    FDriveType := TDriveType(GetDriveType(PChar(Value
    + ':\')));
    FDiskSize := SysUtils.DiskSize(Byte(Value) - $40);
    FDiskFree := SysUtils.DiskFree(Byte(Value) - $40);
    end
    end;
    Что касается материнской платы, то могу дать только код, как узнать серийник БИОСа (это пример для NT, но, я думаю, в ваших виндах он также заработает):
    procedure TMachine.GetInfo;
    var
    bdata :pchar;
    KeyState : TKeyBoardState;
    sl: TStrings;
    const
    cBIOSName = $FE061;
    cBIOSDate = $FFFF5;
    cBIOSExtInfo = $FEC71;
    cBIOSCopyright = $FE091;
    rkBIOS =
    {HKEY_LOCAL_MACHINE\}'HARDWARE\DESCRIPTION\System'
    ;
    rvBiosDate = 'SystemBiosDate';
    rvBiosID = 'Identifier';
    rvBiosVersion = 'SystemBiosVersion';
    rvComputerClass = 'Computer';
    begin
    sl:=TStringList.Create;
    try
    FLastBoot:=Now-(GetTickCount/1000)/(24*3600);
    except
    FLastBoot:=0;
    end;
    FSystemUpTime:=GetSystemUpTime;
    FName:=GetMachine;
    FUser:=GetUser;
    if isNT then begin
    with TRegistry.Create do begin
    rootkey:=HKEY_LOCAL_MACHINE;
    if OpenKey(rkBIOS,false) then begin
    if ValueExists(rvBIOSID) then
    FBiosName:=ReadString(rvBIOSID);
    if ValueExists(rvBIOSVersion) then begin
    bdata:=AllocMem(255);
    try
    readbinarydata(rvBIOSVersion,bdata^,255);
    FBIOSCopyright:=strpas(pchar(bdata));
    except
    end;
    FreeMem(bdata);
    end;
    if ValueExists(rvBIOSDate) then
    FBIOSDate:=ReadString(rvBIOSDate);
    closekey;
    end;
    free;
    end;
    end else begin
    FBIOSName:=string(pchar(ptr(cBIOSName)));
    FBIOSDate:=string(pchar(ptr(cBIOSDate)));
    FBIOSCopyright:=string(pchar(ptr(cBIOSCopyright)))
    ;
    FBIOSExtendedInfo:=string(pchar(ptr(cBIOSExtInfo))
    );
    end;
    GetKeyboardState(KeyState);
    FCapsLock:=KeyState[VK_CAPITAL]=1;
    FNumLock:=KeyState[VK_NUMLOCK]=1;
    FScrollLock:=KeyState[VK_SCROLL]=1;
    GetClassDevices(ClassKey,rvComputerClass,DescValue
    ,sl);
    if sl.Count>0 then
    FComp:=sl[0]
    else
    FComp:='';
    sl.Free;
    end;
    procedure GetVideoBIOSInfo(var Version, Date:
    string);
    var
    StrData :PChar;
    const
    rk =
    {HKEY_LOCAL_MACHINE\}'HARDWARE\DESCRIPTION\System'
    ;
    rvVideoBiosDate = 'VideoBiosDate';
    rvVideoBiosVersion = 'VideoBiosVersion';
    begin
    with TRegistry.Create do begin
    RootKey:=HKEY_LOCAL_MACHINE;
    if OpenKey(rk,false) then begin
    if ValueExists(rvVideoBIOSVersion) then begin
    try
    StrData:=StrAlloc(255);
    ReadBinaryData(rvVideoBIOSVersion,StrData^,151);
    Version:=StrPas(PChar(StrData));
    StrDispose(StrData);
    except
    end;
    end;
    if ValueExists(rvVideoBIOSDate) then
    Date:=ReadString(rvVideoBIOSDate);
    CloseKey;
    end;
    Free;
    end;
    end;
    По-видимому, это тоже отрывок из какого-то компонента, но весь код был взят из форума на сайте Мастера Delphi (delphi.mastak.ru). Адрес форума:
    http://delphi.mastak.ru/cgi-bin/forum.pl?look=1&id=1024205169&n=2
    

Версия для печати Найти похожие статьи
Поиск по сайту

Архив

ВсПнВтСрЧтПтСб
1234567
891011121314
15161718192021
22232425262728
293012345
6789101112
13141516171819
20212223242526
272829303112



Мы рекомендуем