الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

معلومات ال Bios من الويندوز

مغلق
بدأه إبراهيم_دياب5 في 1 مايو 2003 · 11 رد · 1,223 مشاهدة · في لغة Delphi
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع

السلام عليكم ورحمة الله وبركاته

هذا الكود يقوم بعرض معلومات الـ Bios لعله يكون مفيد

ضع المكونات التاليه فى برنامجك الجديد

tmemo

tbutton

عقبال السريال بتاع الـ motherboard

procedure TForm1.BiosInfo;
const
 Subkey: string = 'Hardwaredescriptionsystem';
var
 hkSB: HKEY;
 rType: LongInt;
 ValueSize, OrigSize: Longint;
 ValueBuf: array[0..1000] of char;
 procedure ParseValueBuf(const VersionType: string);
 var
   I, Line: Cardinal;
   S: string;
 begin
   i := 0;
   Line := 0;
   while ValueBuf <> #0 do
   begin
     S := StrPas(@ValueBuf); // move the Pchar into a string
     Inc(Line);
     Memo1.Lines.Append(Format('%s Line %d = %s',
       [VersionType, Line, S])); // add it to a Memo
     inc(i, Length(S) + 1);
     // to point to next sz, or to #0 if at
   end
 end;


begin
 if RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar(Subkey), 0,
                 KEY_READ, hkSB) = ERROR_SUCCESS then
 try
   OrigSize := sizeof(ValueBuf);
   ValueSize := OrigSize;
   rType := REG_MULTI_SZ;
   if RegQueryValueEx(hkSB, 'SystemBiosVersion', nil, @rType,
     @ValueBuf, @ValueSize) = ERROR_SUCCESS then
     ParseValueBuf('System BIOS Version');

   ValueSize := OrigSize;
   rType := REG_SZ;
   if RegQueryValueEx(hkSB, 'SystemBIOSDate', nil, @rType,
     @ValueBuf, @ValueSize) = ERROR_SUCCESS then
     Memo1.Lines.Append('System BIOS Date ' + ValueBuf);

   ValueSize := OrigSize;
   rType := REG_MULTI_SZ;
   if RegQueryValueEx(hkSB, 'VideoBiosVersion', nil, @rType,
     @ValueBuf, @ValueSize) = ERROR_SUCCESS then
     ParseValueBuf('Video BIOS Version');

   ValueSize := OrigSize;
   rType := REG_SZ;
   if RegQueryValueEx(hkSB, 'VideoBIOSDate', nil, @rType,
     @ValueBuf, @ValueSize) = ERROR_SUCCESS then
     Memo1.Lines.Append('Video BIOS Date ' + ValueBuf);
 finally
   RegCloseKey(hkSB);
 end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
 BiosInfo;
end;

(gift)

#2

وهذه محاولة وجدتها لمعرفة السريال الخاص بالـ motherboard ولكنها فشلت وساقدمها لكم لنتعاون على محاولة عملها، ستجدونها فى المرفقات...

الهمه يا شباب قليل من الجهد المشترك ونقوم بها بإذن الله

bios2.rar

#3

السلام عليكم ....

شكرا أخي أبراهيم .....ولكن هذا الكود ...للسيريال لايعمل معي على الXP

وهـــــو

function GetBiosCheckSum: string;
var
  s: int64;
  i: longword;
  p: PChar;
begin
  i := 0;
  s := 0;
  p := PChar($F0000);
  repeat
    inc(s, Int64(Ord(p^)) shl i);
    if i < 64 then inc(i) else i := 0;
    inc(p);
  until p > PChar($FFFFF);
  Result := IntToHex(s,16);
end;

function GetBiosInfoAsText: string;
var
  p, q: pchar;
begin
  q := nil;
  p := PChar(Ptr($FE000));
  repeat
    if q <> nil then begin
      if not (p^ in [#10, #13, #32..#126, #169, #184]) then begin
        if (p^ = #0) and (p - q >= 8) then begin
          Result := Result + TrimRight(String(q)) + #13#10;
        end;
        q := nil;
      end;
    end else
      if p^ in [#33..#126, #169, #184] then
        q := p;
    inc(p);
  until p > PChar(Ptr($FFFFF));
  Result := TrimRight(Result);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
memo1.Clear;
memo1.Lines.Add('=====FOX_DELPHI=====');
memo1.Lines.Add('');
memo1.Lines.Add(GetBiosCheckSum);

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
memo1.Clear;
memo1.Lines.Add(GetBiosInfoAsText);
memo1.Lines.Add('=====FOX_DELPHI=====');
memo1.Lines.Add('');

end;

والنصرللمسلمين

أرجو دعوة صالحة ..

اخـــوكم

#4

أخي العزيز

جرب هذا الكود ، ويستخدم لمعرف سريال نمبر المعالج (cpu)

unit Main;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  ExtCtrls,
  StdCtrls,
  Buttons;

type
  TDemoForm = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    GetButton: TBitBtn;
    CloseButton: TBitBtn;
    Bevel1: TBevel;
    Label5: TLabel;
    FLabel: TLabel;
    MLabel: TLabel;
    PLabel: TLabel;
    SLabel: TLabel;
    PValue: TLabel;
    FValue: TLabel;
    MValue: TLabel;
    SValue: TLabel;
    procedure GetButtonClick(Sender: TObject);
  end;

var
  DemoForm: TDemoForm;

implementation

{$R *.DFM}

const
 ID_BIT = $200000;   // EFLAGS ID bit
type
 TCPUID = array[1..4] of Longint;
 TVendor = array [0..11] of char;

function IsCPUID_Available : Boolean; register;
asm
 PUSHFD       {direct access to flags no possible, only via stack}
  POP     EAX     {flags to EAX}
  MOV     EDX,EAX   {save current flags}
  XOR     EAX,ID_BIT {not ID bit}
  PUSH    EAX     {onto stack}
  POPFD        {from stack to flags, with not ID bit}
  PUSHFD       {back to stack}
  POP     EAX     {get back to EAX}
  XOR     EAX,EDX   {check if ID bit affected}
  JZ      @exit    {no, CPUID not availavle}
  MOV     AL,True   {Result=True}
@exit:
end;

function GetCPUID : TCPUID; assembler; register;
asm
  PUSH    EBX         {Save affected register}
  PUSH    EDI
  MOV     EDI,EAX     {@Resukt}
  MOV     EAX,1
  DW      $A20F       {CPUID Command}
  STOSD             {CPUID[1]}
  MOV     EAX,EBX
  STOSD               {CPUID[2]}
  MOV     EAX,ECX
  STOSD               {CPUID[3]}
  MOV     EAX,EDX
  STOSD               {CPUID[4]}
  POP     EDI     {Restore registers}
  POP     EBX
end;

function GetCPUVendor : TVendor; assembler; register;
asm
  PUSH    EBX     {Save affected register}
  PUSH    EDI
  MOV     EDI,EAX   {@Result (TVendor)}
  MOV     EAX,0
  DW      $A20F    {CPUID Command}
  MOV     EAX,EBX
  XCHG  EBX,ECX     {save ECX result}
  MOV   ECX,4
@1:
  STOSB
  SHR     EAX,8
  LOOP    @1
  MOV     EAX,EDX
  MOV   ECX,4
@2:
  STOSB
  SHR     EAX,8
  LOOP    @2
  MOV     EAX,EBX
  MOV   ECX,4
@3:
  STOSB
  SHR     EAX,8
  LOOP    @3
  POP     EDI     {Restore registers}
  POP     EBX
end;

procedure TDemoForm.GetButtonClick(Sender: TObject);
var
  CPUID : TCPUID;
  I     : Integer;
  S   : TVendor;
begin
 for I := Low(CPUID) to High(CPUID)  do CPUID := -1;
  if IsCPUID_Available then begin
   CPUID := GetCPUID;
   Label1.Caption := 'CPUID[1] = ' + IntToHex(CPUID[1],8);
   Label2.Caption := 'CPUID[2] = ' + IntToHex(CPUID[2],8);
   Label3.Caption := 'CPUID[3] = ' + IntToHex(CPUID[3],8);
   Label4.Caption := 'CPUID[4] = ' + IntToHex(CPUID[4],8);
   PValue.Caption := IntToStr(CPUID[1] shr 12 and 3);
   FValue.Caption := IntToStr(CPUID[1] shr 8 and $f);
   MValue.Caption := IntToStr(CPUID[1] shr 4 and $f);
   SValue.Caption := IntToStr(CPUID[1] and $f);
   S := GetCPUVendor;
   Label5.Caption := 'Vendor: ' + S; end
  else begin
   Label5.Caption := 'CPUID not available';
  end;
end;

end.

وتقبل تحياتي

#5

أخوانى admin ، Fox Delphi (f)(f)(f)

أشكر لكم سرعة ردكم

الأخ admin الكود يعمل بشكل جيد، ولكن كنت احب ان أتأكد من معلومه هل السريال الخاص بالـ CPU هو ما يظهر فى الـ Label4، مع الشكر

الأخ Fox Delphi اشكرك على اهتمامك ولكن للأسف الكود الذى تفضلتم بوضعه موجود عندى ولا يعمل على الـ XP ويعطى رسالة خطأ عند

 if p^ in [#33..#126, #169, #184] then

:(

أخوكم:

إبراهيم دياب

مصر

#6

شكرا جزيلا أخي إبراهيم_دياب5

لقد جربت الكود قبل فترة طويلة - لا أتذكر النتيجة -

سأعيد تجربته اليوم وأعطيك النتيجة .

#7

نرجوا ملاحظة أن الكود يعمل على الـ Xp ، ويحتاج لبعض التعديل ليعمل على الـ 98

#8

السلام عليكم

اخي ابراهيم انا في مشكلة ...انت قلت أن الكود المرفق ..يعمل على Xp

وهو عندي لم يعمل ...........

أرجو النصيحة ............

الأخ admin.....شكرا عزيزي ..................ممتاز جداً

اخوكم:cool:

#9

أخى fox delphi الكود يعمل على الـ xp جيداً وليس به خطأ عموماً سأرسل لك نسخة جاهزة عندما اكون فى المنزل لأنى الآن عند صديق

#10

ها هو الكود اخى العزيز Fox Delphi مرفقا معه صورة تبين عمله

(f)

fox.rar

#11

ياريت تضعوها مع موضوع الapi

وساحل الجيد منها

واشرح الية عمله

أخوكم رضا

#12

بسم الله الرحمن الرحيم

نظراً لإختلاف طريقة التعرف على السريال للهارد ديسك واللوحة الأم فى win98 عن الـ xp فمرفق برنامج يحتوى على الطريقتين ، ويعمل بلا اى مشاكل فى الـ98 و الـ NT

(f) (gift) (f)

hd_serial.rar

هذا الموضوع مغلق.

مواضيع مشابهة