Скопируйте код кода следующим образом:
//Объявление ссылки и переменной TYPE
использует
Windows, сообщения, SysUtils, варианты, классы, графика, элементы управления, формы,
Диалоги, StdCtrls,nb30 {Важная цитата};
тип
ПАСТАТ = ^ТАСТАТ;
ТАСТАТ=запись
адаптер: TAdapterStatus;
name_buf: TNameBuffer;
конец;
ТФорм1 = класс (ТФорма)
Кнопка1: Кнопка T;
Edit1: TEdit;
Метка1: TLabel;
Метка2: TLabel;
Метка3: TLabel;
Edit2: TEdit;
Edit3: TEdit;
Кнопка2: TКнопка;
Edit4: TEdit;
Метка4: TLabel;
процедура Button1Click (Отправитель: TObject);
процедура Button2Click (Отправитель: TObject);
частный
{Частные заявления}
общественный
{Публичные заявления}
конец;
вар
Форма1: ТФорм1;
выполнение
{$R *.dfm}
тип
TCPUID = массив[1..4] Longint;
//Получаем серийный номер жесткого диска:
function GetIdeSerialNumber: pchar //Получить заводской серийный номер жесткого диска;
константный IDENTIFY_BUFFER_SIZE = 512;
тип
TIDERegs = упакованная запись
bFeaturesReg: BYTE;
bSectorCountReg: БАЙТ;
bSectorNumberReg: БАЙТ;
bCylLowReg: БАЙТ;
bCylHighReg: БАЙТ;
бдравехеадрег: БАЙТ;
бCommandReg: БАЙТ;
bЗарезервировано: БАЙТ;
конец;
TSendCmdInParams = упакованная запись
cBufferSize: DWORD;
irDriveRegs: TIDERegs;
bDriveNumber: БАЙТ;
bReserved: массив [0..2] байтов;
dwReserved: массив [0..3] из DWORD;
bBuffer: массив [0..0] байтов;
конец;
TIdSector = упакованная запись
wGenConfig: Слово;
wNumCyls: Слово;
wЗарезервировано: Слово;
wNumHeads: Слово;
wBytesPerTrack: Слово;
вбайтесперсектор: слово;
wSectorsPerTrack: Слово;
wVendorUnique: массив [0..2] Word;
sSerialNumber: массив [0..19] символов CHAR;
вБуферТип: Слово;
wBufferSize: Слово;
wECCSize: Слово;
sFirmwareRev: массив [0..7] символов;
sModelNumber: массив [0..39] символов;
wMoreVendorUnique: Word;
wDoubleWordIO: Слово;
wВозможности: Word;
wReserved1: Слово;
wPIOTiming: Word;
wDMATiming: Word;
WBS: Слово;
wNumCurrentCyls: Слово;
wNumCurrentHeads: Слово;
wNumCurrentSectorsPerTrack: Word;
ulCurrentSectorCapacity: DWORD;
wMultSectorStuff: Слово;
ulTotalAddressableSectors: DWORD;
wSingleWordDMA: Слово;
wMultiWordDMA: Слово;
bЗарезервировано: массив [0..127] из BYTE;
конец;
PIdSector = ^TIdSector;
TDriverStatus = упакованная запись
bDriverError: Байт;
bIDEStatus: Байт;
bReserved: массив [0..1] байта;
dwReserved: массив [0..1] из DWORD;
конец;
TSendCmdOutParams = упакованная запись
cBufferSize: DWORD;
Статус драйвера: TDriverStatus;
bBuffer: массив [0..0] из BYTE;
конец;
вар
hУстройство: Ручка;
cbBytesReturned: DWORD;
SCIP: TSendCmdInParams;
aIdOutCmd: массив [0..(SizeOf(TSendCmdOutParams) + IDENTIFY_BUFFER_SIZE-1)-1] байта;
IdOutCmd: TSendCmdOutParams абсолютный aIdOutCmd;
процедура ChangeByteOrder(var Data; Size: Integer);//Процесс в функции
вар
ПТР: Пчар;
я: целое число;
в: Чар;
начинать
ПТР := @Данные;
для I := 0 до (Размер shr 1) - 1 начать
с := ПТР^;
ptr^ := (ptr + 1)^;
(ptr + 1)^ := с;
Инк(птр, 2);
конец;
конец;
начало // тело функции
Результат := '';
если SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT, то
начало // Windows NT, Windows 2000
hDevice := CreateFile('//./PhysicalDrive0', GENERIC_READ или GENERIC_WRITE,
FILE_SHARE_READ или FILE_SHARE_WRITE, ноль, OPEN_EXISTING, 0, 0);
конец
еще // Версия Windows 95 OSR2, Windows 98
hDevice:= CreateFile('//./SMARTVSD', 0, 0, ноль, Create_NEW, 0, 0);
если hDevice = INVALID_HANDLE_VALUE, то выйти;
пытаться
FillChar(SCIP, SizeOf(TSendCmdInParams) - 1, #0);
FillChar(aIdOutCmd, SizeOf(aIdOutCmd), #0);
cbBytesReturned: = 0;
с помощью SCIP сделать
начинать
cBufferSize: = IDENTIFY_BUFFER_SIZE;
с irDriveRegs делаю
начинать
bSectorCountReg := 1;
бСекторНумберрег: = 1;
bDriveHeadReg: = $A0;
бCommandReg := $EC;
конец;
конец;
если не DeviceIoControl(hDevice, $0007C088, @SCIP, SizeOf(TSendCmdInParams) - 1,@aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, ноль), то Exit;
окончательно
CloseHandle(hDevice);
конец;
с PIdSector(@IdOutCmd.bBuffer)^ сделать
начинать
ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));
(Pchar(@sSerialNumber) + SizeOf(sSerialNumber))^:= #0;
Результат: = Pchar(@sSerialNumber);
конец;
конец;
//============================================== =================
//Серийный номер процессора:
ФУНКЦИЯ GetCPUID: регистр ассемблера;
асм
PUSH EBX {Сохранить затронутый регистр}
НАЖМИТЕ ЭОД
MOV EDI,EAX {@Resukt}
ДВИЖЕНИЕ EAX, 1
DW $A20F {Команда CPU}
STOSD {ЦП[1]}
ДВИЖЕНИЕ EAX, EBX
STOSD {CPUID[2]}
ДВИЖЕНИЕ EAX,ECX
STOSD {CPUID[3]}
ДВИЖЕНИЕ EAX,EDX
STOSD {ЦП[4]}
POP EDI {Восстановить регистры}
ПОПЕБКС
КОНЕЦ;
функция GetCPUIDStr:String;
вар
Идентификатор ЦП:TCPUID;
начинать
CPUID:=GetCPUID;
Результат:=IntToHex(CPUID[1],8)+IntToHex(CPUID[2],8)+IntToHex(CPUID[3],8)+IntToHex(CPUID[4],8);
конец;
///============================================= = ==================================
///Получить MAC (неинтегрированная сетевая карта):
функция NBGetAdapterAddress(a: Integer): строка;
вар
NCB: TNCB // Блок управления NetBIOS //Блок управления NetBios;
ADAPTER: TADAPTERSTATUS // Статус адаптера Netbios // Получить статус сетевой карты
ЛАНЕНУМ: ТЛАНАЕНУМ // Нетбиос лана;
intIdx: Integer // Временное рабочее значение // Временная переменная;
cRC: Char; // код возврата Netbios // возвращаемое значение NetBios;
strTemp: string // Временная строка // Временная переменная;
начинать
//Инициализируем
Результат := '';
пытаться
// Блок управления нулем
ZeroMemory(@NCB, SizeOf(NCB));
// Выдаем команду перечисления
NCB.ncb_command := Chr(NCBENUM);
cRC := NetBios (@NCB);
// Повторно вводим команду перечисления
NCB.ncb_buffer := @LANAENUM;
NCB.ncb_length := SizeOf(LANAENUM);
cRC := NetBios (@NCB);
если ord(cRC) <> 0, то
Выход;
//Сброс адаптера
ZeroMemory(@NCB, SizeOf(NCB));
NCB.ncb_command := Chr(NCBRESET);
NCB.ncb_lana_num := LANAENUM.lana[a];
cRC := NetBios (@NCB);
если ord(cRC) <> 0, то
Выход;
// Получаем адрес адаптера
ZeroMemory(@NCB, SizeOf(NCB));
NCB.ncb_command := Chr(NCBASTAT);
NCB.ncb_lana_num := LANAENUM.lana[a];
StrPCopy(NCB.ncb_callname, '*');
NCB.ncb_buffer := @ADAPTER;
NCB.ncb_length := SizeOf(АДАПТЕР);
cRC := NetBios (@NCB);
// Преобразуем его в строку
стрТемп := '';
для intIdx:= от 0 до 5 сделать
strTemp := strTemp + InttoHex(Integer(ADAPTER.adapter_address[intIdx]), 2);
Результат: = стрТемп;
окончательно
конец;
конец;
//============================================== =========================
//Получаем MAC-адрес (встроенная сетевая карта и неинтегрированная сетевая карта):
функция Getmac: строка;
вар
нкб: ТНКБ;
с: строка;
адаптировать: ТАСТАТ;
ланаенум: Тланаенум;
я, j, м: целое число;
стрПарт, стрМак: строка;
начинать
FillChar(ncb, SizeOf(TNCB), 0);
ncb.ncb_command:= Char(NCBEnum);
ncb.ncb_buffer := PChar(@lanaEnum);
ncb.ncb_length:= SizeOf(TLanaEnum);
s:=Netbios(@ncb);
for i:= от 0 до целого числа(lanaEnum.length)-1 do
начинать
FillChar(ncb, SizeOf(TNCB), 0);
ncb.ncb_command:= Char(NCBReset);
ncb.ncb_lana_num := lanaEnum.lana[i];
Нетбиос (@ncb);
Нетбиос (@ncb);
FillChar(ncb, SizeOf(TNCB), 0);
ncb.ncb_command:= Chr(NCBAstat);
ncb.ncb_lana_num := lanaEnum.lana[i];
ncb.ncb_callname := '* ';
ncb.ncb_buffer := PChar(@adapt);
ncb.ncb_length:= SizeOf(TASTAT);
м:=0;
если (Win32Platform = VER_PLATFORM_WIN32_NT), то
м:=1;
если м=1 тогда
начинать
если Netbios(@ncb) = Chr(0), то
стрМак := '';
для j := от 0 до 5 делать
начинать
strPart: = IntToHex(integer(adapt.adapter.adapter_address[j]), 2);
strMac := strMac + strPart + '-';
конец;
SetLength(strMac, Длина(strMac)-1);
конец;
если м=0, то
если Netbios(@ncb) <> Chr(0), то
начинать
стрМак := '';
для j := от 0 до 5 делать
начинать
strPart: = IntToHex(integer(adapt.adapter.adapter_address[j]), 2);
strMac := strMac + strPart + '-';
конец;
SetLength(strMac, Длина(strMac)-1);
конец;
конец;
результат: = стрмак;
конец;
функция PartitionString(StrV,PrtSymbol: строка): TStringList;
вар
iTemp: целое число;
начинать
результат: = TStringList.Create;
iTemp := pos(PrtSymbol,StrV);
пока iTemp>0 начинается
если iTemp>1, то result.Append(copy(StrV,1,iTemp-1));
delete(StrV,1,iTemp+length(PrtSymbol)-1);
iTemp := pos(PrtSymbol,StrV);
конец;
если Strv<>'', то result.Append(StrV);
конец;
функция MacStr():String;
вар
Стр: TStrings;
я: целое число;
МакСтр:Строка;
начинать
МакСтр:='';
Стр:=TStringList.Create;
Str:=PartitionString(Getmac,'-');
для i:=0 до Str.Count-1 сделать
MacStr:=MacStr+Str[i];
Результат:=MacStr;
конец;
//============================================
//Пример вызова
процедура TForm1.Button1Click(Отправитель: TObject);
начинать
Edit3.Text:=strpas(GetIdeSerialNumber);//Получить номер жесткого диска
Edit2.text:=GetCPUIDStr;//серийный номер процессора
edit4.Text:=NBGetAdapterAddress(12);//Неинтегрированная сетевая карта
Edit1.text:=MacStr;//Встроенные и неинтегрированные сетевые карты
конец;