Solved

App for renaming hardware data

Posted on 2012-03-28
9
276 Views
Last Modified: 2012-11-06
is not working on Lenovo Thinkcentre M71E.
Why?
I have attached code which works fine on another (older ) PC.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Button1: TButton;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    Memo1: TMemo;
    Button3: TButton;
    Button4: TButton;
    Memo2: TMemo;
    Edit1: TEdit;
    Button2: TButton;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
   THWRec = record
     Name: string[112];
     value: string[112];
   end;

var HWRec: array of THWRec;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
const
  Subkey: string = 'Hardware\description\system';
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[i] <> #0 do
    begin
      S := StrPas(@ValueBuf[i]);
      Inc(Line);
      Memo1.Lines.Append(Format('%s Line %d = %s',[VersionType, Line, S]));
      setlength(HWRec,length(HWRec)+1);
      HWRec[length(HWRec)-1].Name := Format('%s Line %d',[VersionType, Line]);
      HWRec[length(HWRec)-1].value := String(S);
      inc(i, Length(S) + 1);
    end
  end;

begin
  setlength(HWRec,length(HWRec)+1);
  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
      begin
        Memo1.Lines.Append('System BIOS Date = ' + ValueBuf);
        setlength(HWRec,length(HWRec)+1);
        HWRec[length(HWRec)-1].Name := 'System BIOS Date';
        HWRec[length(HWRec)-1].value := String(ValueBuf);
      end;

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

    ValueSize := OrigSize;
    rType := REG_SZ;
    if RegQueryValueEx(hkSB, 'VideoBIOSDate', nil, @rType,@ValueBuf, @ValueSize) = ERROR_SUCCESS then
      begin
        Memo1.Lines.Append('Video BIOS Date = ' + ValueBuf);
        setlength(HWRec,length(HWRec)+1);
        HWRec[length(HWRec)-1].Name := 'Video BIOS Date';
        HWRec[length(HWRec)-1].value := String(ValueBuf);
      end;
  finally
    RegCloseKey(hkSB);
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  F : file of THWRec;
  i : integer;
begin
  AssignFile(F,'HWRec.txt') ;
  try
    Rewrite(F) ;
    try
      for i:= 1 to  length(HWRec)-1 do
        Write (F, HWRec[i]) ;
    finally
      CloseFile(F) ;
    end;
  except
    showmessage('Error creating the file!');
  end;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
   HWRec: THWRec;
   F : file of THWRec;
begin
  AssignFile(F,'HWRec.txt') ;
  try
    Reset(F) ;
    try
      while not Eof(F) do
        begin
          Read (F, HWRec) ;
          memo2.Lines.Add(HWRec.name +' = '+ HWRec.value);
          if not Eof(F) then
            Edit1.Text := Edit1.Text + StringReplace(HWRec.name +' = '+ HWRec.value,' ','',[rfReplaceAll]) + ', '
          else
            Edit1.Text := Edit1.Text + StringReplace(HWRec.name +' = '+ HWRec.value,' ','',[rfReplaceAll]);
        end;
    finally
      CloseFile(F) ;
    end;
  except
    Showmessage('File not found!');
  end;
 end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Edit1.SelectAll;
  Edit1.CopyToClipboard;
  Edit1.SelStart := 0;
end;







// This section will be in the main application which does the checking for HW

procedure TForm1.Button1Click(Sender: TObject);
const
  Subkey: string = 'Hardware\description\system';
var
  hkSB: HKEY;
  rType: LongInt;
  ValueSize, OrigSize: Longint;
  ValueBuf: array[0..1000] of char;
  HWRec3  : TStringList;
  match:integer;

procedure ParseValueBuf(const VersionType: string);
var
  I, Line: Cardinal;
  S: string;
begin
  i := 0;
  Line := 0;
  while ValueBuf[i] <> #0 do
    begin
      S := StrPas(@ValueBuf[i]);
      Inc(Line);
      if HWRec3.Values[Format('%sLine%d',[VersionType, Line])] = StringReplace(S,' ','',[rfReplaceAll]) then
        inc(match);
      inc(i, Length(S) + 1);
    end
end;

begin
  HWRec3  := TStringList.Create;
  // copy and past the line you generated after loading from the file which can be found in the EditBox
  //e
  //HWRec3.CommaText := 'SystemBIOSVersionLine1=PTLTD-60400d0, SystemBIOSVersionLine2=PhoenixBIOS4.0Release6.0forIBMNetVista., SystemBIOSVersionLine3=IBMBIOSVer24KT33.0, SystemBIOSVersionLine4=Ver1.00PARTTBLh,'+
  // 'SystemBIOSDate=12/02/02, VideoBIOSVersionLine1=HardwareVersion0.0, VideoBIOSDate=10/24/20';
  // boj
  //HWRec3.CommaText :='SystemBIOSVersionLine1=LENOVO-60400d0, SystemBIOSVersionLine2=LenovoThinkCentreBIOSVer2RKT37.0, SystemBIOSVersionLine3=Ver1.00PARTTBLX,'+
 // 'SystemBIOSDate=01/25/08, VideoBIOSVersionLine1=HardwareVersion0.0, VideoBIOSDate=06/08/20';
       // iv    
 //HWRec3.CommaText :=' SystemBIOSVersionLine1=LENOVO-2230, SystemBIOSVersionLine2=PhoenixFirstBIOS(tm)NotebookProVersion2.0forThinkPad,'+
   //  ' SystemBIOSVersionLine3=Ver1.00PARTTBL, SystemBIOSDate=09/12/08, VideoBIOSDate=05/02/07 ';
       // bo
   (*   HWRec3.CommaText :=' SystemBIOSVersionLine1=PTLTD-60400d0, SystemBIOSVersionLine2=PhoenixFirstBios(tm)DesktopProVersion2.0forThinkCentre.,'+
      ' SystemBIOSVersionLine3=IBMBIOSVer2EKT41.0, SystemBIOSVersionLine4=Ver1.00PARTTBL, SystemBIOSDate=09/15/06, VideoBIOSVersionLine1=HardwareVersion0.0, VideoBIOSDate=02/17/20';  *)
        //pren
   HWRec3.CommaText :='     SystemBIOSVersionLine1=LENOVO-2230, SystemBIOSVersionLine2=PhoenixFirstBIOS(tm)NotebookProVersion2.0forThinkPad, '+
   'SystemBIOSVersionLine3=Ver1.00PARTTBL, SystemBIOSDate=09/12/08, VideoBIOSDate=05/02/07 '; 
      //new iv
    (* HWRec3.CommaText :=' SystemBIOSVersionLine1=PTLTD-60000, SystemBIOSVersionLine2=Version6.00R1.11.2598.A1, SystemBIOSVersionLine3=Version6.00R1.11.2598.A1, '+
     'SystemBIOSVersionLine4=Version6.00R1.11.2598.A1, SystemBIOSDate=04/18/08, VideoBIOSVersionLine1=HardwareVersion0.0, VideoBIOSDate=06/08/20  ';
   *)
   match := 0;


  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('SystemBIOSVersion');

    ValueSize := OrigSize;
    rType := REG_SZ;
    if RegQueryValueEx(hkSB, 'SystemBIOSDate', nil, @rType,@ValueBuf, @ValueSize) = ERROR_SUCCESS then
      begin
        if HWRec3.Values['SystemBIOSDate'] = StringReplace(ValueBuf,' ','',[rfReplaceAll]) then
          inc(match);
      end;

    ValueSize := OrigSize;
    rType := REG_MULTI_SZ;
    if RegQueryValueEx(hkSB, 'VideoBiosVersion', nil, @rType,@ValueBuf, @ValueSize) = ERROR_SUCCESS then
      begin
        ParseValueBuf('VideoBIOSVersion');
      end;

    ValueSize := OrigSize;
    rType := REG_SZ;
    if RegQueryValueEx(hkSB, 'VideoBIOSDate', nil, @rType,@ValueBuf, @ValueSize) = ERROR_SUCCESS then
      begin
        if HWRec3.Values['VideoBIOSDate'] = StringReplace(ValueBuf,' ','',[rfReplaceAll]) then
          inc(match);
      end;
  finally
    RegCloseKey(hkSB);
  end;

  if match = HWRec3.Count then
    begin
      showmessage('complete match');
      HWRec3.Free;
    end
  else
    begin
      HWRec3.Free;
      showmessage('This is not the intended PC to run this application! Application will quit.');
      Close;  // Application.Terminate
    end;
end;



end.

Open in new window

0
Comment
Question by:pr2501
  • 4
  • 2
9 Comments
 
LVL 19

Expert Comment

by:Thommy
ID: 37789235
Do you get any error message???
0
 

Author Comment

by:pr2501
ID: 37794664
I have attached all project. No errors.

When i start app i get all hardware data on all other PC.  But on this new PC version it is blank.
reg.zip
0
 
LVL 1

Expert Comment

by:vviioo
ID: 37925747
Different OS ?
Or maybe 32 - 64 bit ?
Open Regedit and check if the registry paths are correct.
0
Zoho SalesIQ

Hassle-free live chat software re-imagined for business growth. 2 users, always free.

 

Author Comment

by:pr2501
ID: 37935755
vviioo, thank you for you ansver.
The OS is windovs XP profesiobnal x64 edition.

So. Can you pleas give me more detail informations. I am notable to work at this livel.
0
 
LVL 1

Accepted Solution

by:
vviioo earned 500 total points
ID: 37935867
Hi pr2501.

try debugging your code and see what goes wrong when trying to read the registry keys.
Also open regedit.exe to check if the registry keys( like HKLM\Hardware\description\system) exist in the registry. Otherwise use search and search for terms like "SystemBiosVersion" and see where your keys are.
I do not have win xp 64 to look it up myself.

Good luck!
0
 

Author Comment

by:pr2501
ID: 37955769
I can not debuge the code because  i do not have Delphi IDE on that PC.

I was looking in the App code to see where keys are used. But realy what should i look for?

Maybe i should use some other code which works on windows x64 edition?
bios.jpg
0
 

Author Comment

by:pr2501
ID: 38574907
Thank you for you answers.  But unfortunately i can not resolve this problem.
I have no resorts to continue. I can just look for to new code for x64 edition and then
move with app to another PC.

Or maybe find code which can read bios from any PC with windows OS.
And also check system clock.

For that i will have to close this question and open another.
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Is anyone willing to have a look through this code and help debug? 25 57
FMX and jaudiotracker playing memory stream 29 66
CheckListBox usage 3 50
Message not shown 5 30
Great sound, comfort and fit, excellent build quality, versatility, compatibility. These are just some of the many reasons for choosing a headset from Sennheiser.
In the modern office, employees tend to move around the workplace a lot more freely. Conferences, collaborative groups, flexible seating and working from home require a new level of mobility. Technology has not only changed the behavior and the expe…
The goal of the video will be to teach the user the concept of local variables and scope. An example of a locally defined variable will be given as well as an explanation of what scope is in C++. The local variable and concept of scope will be relat…
The viewer will learn how to clear a vector as well as how to detect empty vectors in C++.

911 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now