انسخ رمز الكود كما يلي:
// إعلان المرجع والنوع المتغير
الاستخدامات
Windows، الرسائل، SysUtils، المتغيرات، الفئات، الرسومات، عناصر التحكم، النماذج،
مربعات الحوار، StdCtrls،nb30 {اقتباس مهم}
يكتب
باستات = ^تاستات؛
تاستات=سجل
المحول: TAdapterStatus؛
name_buf : TNameBuffer;
نهاية؛
TForm1 = الفئة (TForm)
Button1: TButton؛
تحرير 1: تحرير؛
التسمية 1: TLabel؛
التسمية 2: TLabel؛
التسمية 3: TLabel؛
تحرير2: تحرير؛
تحرير3: تحرير؛
Button2: TButton؛
تحرير 4: تحرير؛
Label4: TLabel؛
الإجراء Button1Click(Sender: TObject);
الإجراء Button2Click(Sender: TObject);
خاص
{تصريحات خاصة}
عام
{التصريحات العامة}
نهاية؛
فار
Form1: TForm1؛
تطبيق
{$R *.dfm}
يكتب
TCPUID = الصفيف [1..4] من Longint؛
// احصل على الرقم التسلسلي لمحرك الأقراص الثابتة:
وظيفة GetIdeSerialNumber: pchar;
const IDENTIFY_BUFFER_SIZE = 512؛
يكتب
TIDERegs = سجل معبأ
بميزات التسجيل: BYTE؛
bSectorCountReg: BYTE;
bSectorNumberReg: BYTE;
bCylLowReg: بايت؛
bCylHighReg: بايت؛
bDriveHeadReg: بايت؛
بCommandReg: BYTE؛
ب محجوز: BYTE؛
نهاية؛
TSendCmdInParams = سجل معبأ
cBufferSize: DWORD;
irDriveRegs: TIDERegs;
bDriveNumber: BYTE;
ب محجوز: صفيف [0..2] من البايت؛
dwReserved: صفيف [0..3] من DWORD؛
bBuffer: صفيف [0..0] من البايت؛
نهاية؛
TIdSector = سجل معبأ
wGenConfig: كلمة؛
wNumCyls: كلمة؛
محجوز: كلمة؛
ونومهيدس: كلمة؛
wBytesPerTrack: كلمة؛
wBytesPerSector: كلمة؛
wSectorsPerTrack: كلمة؛
wVendorUnique: صفيف [0..2] من Word؛
sSerialNumber: الصفيف [0..19] من CHAR؛
wBufferType: كلمة؛
wBufferSize: كلمة؛
weECCSize: كلمة؛
sFirmwareRev: صفيف [0..7] من Char؛
sModelNumber: صفيف [0..39] من Char؛
wMoreVendorUnique: Word؛
wDoubleWordIO: كلمة؛
القدرات: كلمة؛
wReserved1: كلمة؛
wPIIOtiming: كلمة؛
wDMATiming: كلمة؛
وب: كلمة؛
wNumCurrentCyls: كلمة؛
wNumCurrentHeads: كلمة؛
wNumCurrentSectorsPerTrack: كلمة؛
سعة القطاع الحالي: DWORD؛
wMultSectorStuff: كلمة؛
ulTotalAddressableSectors: DWORD;
wSingleWordDMA: كلمة؛
wMultiWordDMA: كلمة؛
ب محجوز: صفيف [0..127] من BYTE؛
نهاية؛
PIdSector = ^TIdSector;
TDriverStatus = سجل معبأ
خطأ bDriver: بايت؛
حالة bIDE: بايت؛
ب محجوز: صفيف [0..1] من البايت؛
dwReserved: صفيف [0..1] من DWORD؛
نهاية؛
TSendCmdOutParams = سجل معبأ
cBufferSize: DWORD;
حالة السائق: TDriverStatus؛
bBuffer: صفيف [0..0] من BYTE؛
نهاية؛
فار
ح الجهاز: ثاندل؛
cbBytesReturned: DWORD;
SCIP:TSendCmdInParams;
aIdOutCmd: array[0..(SizeOf(TSendCmdOutParams) + IDENTIFY_BUFFER_SIZE-1)-1] من البايت؛
IdOutCmd: TSendCmdOutParams aIdOutCmd المطلق؛
الإجراء ChangeByteOrder(var Data; الحجم: عدد صحيح);// العملية في الوظيفة
فار
بتر: بشار؛
ط: عدد صحيح؛
ج: شار؛
يبدأ
ptr := @Data;
لأني := 0 إلى (الحجم shr 1) - 1 لا تبدأ
ج := بتر^;
ptr^ := (ptr + 1)^;
(ptr + 1)^ := c;
شركة(ptr, 2);
نهاية؛
نهاية؛
ابدأ // جسم الوظيفة
النتيجة := '';
إذا كان SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT ثم
ابدأ // ويندوز إن تي، ويندوز 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, nil, 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;
bSectorNumberReg := 1;
bDriveHeadReg := $A0;
bCommandReg := $EC;
نهاية؛
نهاية؛
إذا لم يكن DeviceIoControl(hDevice, $0007C088, @SCIP, SizeOf(TSendCmdInParams) - 1,@aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil) ثم اخرج؛
أخيراً
CloseHandle(hDevice);
نهاية؛
باستخدام PIdSector(@IdOutCmd.bBuffer)^ افعل
يبدأ
ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));
(Pchar(@sSerialNumber) + SizeOf(sSerialNumber))^:= #0;
النتيجة := Pchar(@sSerialNumber);
نهاية؛
نهاية؛
//================================================================================================ ================
// الرقم التسلسلي لوحدة المعالجة المركزية:
وظيفة GetCPUID: تسجيل المجمّع؛
asm
PUSH EBX {حفظ السجل المتأثر}
ادفع التبادل الإلكتروني للبيانات
MOV EDI،EAX {@Resukt}
موف إياكس،1
DW $A20F {أمر CPUID}
ستوسد {CPUID[1]}
موف إياكس، إبكس
ستوسد {CPUID[2]}
موف إياكس، إي سي إكس
ستوسد {CPUID[3]}
موف إياكس، إيديكس
ستوسد {CPUID[4]}
POP EDI {استعادة السجلات}
بوببكس
نهاية؛
الدالة GetCPUIDStr:String;
فار
CPUID: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
المحول: TADAPTERSTATUS; // حالة محول Netbios// احصل على حالة بطاقة الشبكة
LANAENUM: TLANAENUM؛ // Netbios lana
intIdx: عدد صحيح؛ // قيمة العمل المؤقتة// المتغير المؤقت
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(ADAPTER);
cRC := NetBios(@NCB);
// تحويله إلى سلسلة
strTemp := '';
بالنسبة لـ intIdx := من 0 إلى 5
strTemp := strTemp + InttoHex(Integer(ADAPTER.adapter_address[intIdx]), 2);
النتيجة := strTemp;
أخيراً
نهاية؛
نهاية؛
//================================================================================================ ===========================================================
// احصل على عنوان MAC (بطاقة الشبكة المدمجة وبطاقة الشبكة غير المدمجة):
وظيفة Getmac: سلسلة؛
فار
نكب: تنكب؛
ق:سلسلة؛
التكيف: تاستات؛
lanaEnum : TLanaEnum;
أنا، ي، م: عدد صحيح؛
strPart، strMac: سلسلة؛
يبدأ
fillChar(ncb, SizeOf(TNCB), 0);
ncb.ncb_command := Char(NCBEnum);
ncb.ncb_buffer := PChar(@lanaEnum);
ncb.ncb_length := SizeOf(TLanaEnum);
s:=Netbios(@ncb);
لأني := 0 إلى عدد صحيح (lanaEnum.length)-1
يبدأ
fillChar(ncb, SizeOf(TNCB), 0);
ncb.ncb_command := Char(NCBReset);
ncb.ncb_lana_num := lanaEnum.lana[i];
NetBIOS(@ncb);
NetBIOS(@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) إذن
strMac := '';
لـ j := 0 إلى 5 افعل
يبدأ
strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), 2);
strMac := strMac + strPart + '-';
نهاية؛
SetLength(strMac, Length(strMac)-1);
نهاية؛
إذا م = 0 ثم
إذا Netbios(@ncb) <> Chr(0) إذن
يبدأ
strMac := '';
لـ j := 0 إلى 5 افعل
يبدأ
strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), 2);
strMac := strMac + strPart + '-';
نهاية؛
SetLength(strMac, Length(strMac)-1);
نهاية؛
نهاية؛
result:=strmac;
نهاية؛
وظيفة PartitionString (StrV، PrtSymbol: string): TStringList؛
فار
iTemp: عدد صحيح؛
يبدأ
النتيجة := TStringList.Create;
iTemp := pos(PrtSymbol,StrV);
بينما يبدأ iTemp>0
إذا كان iTemp>1 ثم result.Append(copy(StrV,1,iTemp-1));
حذف(StrV,1,iTemp+length(PrtSymbol)-1);
iTemp := pos(PrtSymbol,StrV);
نهاية؛
إذا كانت Strv<>''، فستكون النتيجة.Append(StrV);
نهاية؛
وظيفة MacStr():سلسلة؛
فار
سلسلة: TStrings؛
ط: عدد صحيح؛
MacStr:String;
يبدأ
MacStr:='';
Str:=TSTringList.Create;
Str:=PartitionString(Getmac,'-');
لأني:=0 إلى Str.Count-1 افعل
MacStr:=MacStr+Str[i];
النتيجة:=MacStr;
نهاية؛
//===============================================================================================
// مثال الاتصال
الإجراء TForm1.Button1Click(Sender: TObject);
يبدأ
Edit3.Text:=strpas(GetIdeSerialNumber);// احصل على رقم القرص الصلب
Edit2.text:=GetCPUIDStr;//الرقم التسلسلي لوحدة المعالجة المركزية
edit4.Text:=NBGetAdapterAddress(12);//بطاقة الشبكة غير المدمجة
Edit1.text:=MacStr;//بطاقات الشبكة المدمجة وغير المدمجة
نهاية؛