Solved

App for renaming hardware data

Posted on 2012-03-28
9
309 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Migrating Your Company's PCs

To keep pace with competitors, businesses must keep employees productive, and that means providing them with the latest technology. This document provides the tips and tricks you need to help you migrate an outdated PC fleet to new desktops, laptops, and tablets.

 

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

Windows Server 2016: All you need to know

Learn about Hyper-V features that increase functionality and usability of Microsoft Windows Server 2016. Also, throughout this eBook, you’ll find some basic PowerShell examples that will help you leverage the scripts in your environments!

Question has a verified solution.

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

I use more than 1 computer in my office for various reasons. Multiple keyboards and mice take up more than just extra space, they make working a little more complicated. Using one mouse and keyboard for all of my computers makes life easier. This co…
A clone is a duplicate copy. Sheep have been cloned and maybe someday even people will be cloned, but disk cloning (performed by the hard drive cloning software) is a vital tool used to manage and protect data. Let’s look at what hard drive cloning …
The goal of the tutorial is to teach the user how to use functions in C++. The video will cover how to define functions, how to call functions and how to create functions prototypes. Microsoft Visual C++ 2010 Express will be used as a text editor an…
The viewer will learn how to clear a vector as well as how to detect empty vectors in C++.

626 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