Fórum Como pegar o Serial da BIOS ??? Urgente #173225

unit GetBiosInformation;

interface

uses windows, Sysutils;


type
   PRomBiosDump = ^TRomBiosDump;
   TRomBiosDump = array [$000F0000..$000FFFFF] of Byte;

type
   TReadRomBiosMethod = (
     rrbmAutomatic, { Autodetect OS type and use proper method }
     rrbmGeneric, { Use 16-bit COM program to dump the BIOS }
     rrbmMemory, { Read from memory (Win9x) }
     rrbmPhysical { Read from physical memory object (WinNT) }
   );

type
   NTSTATUS = Integer;

type
   PUnicodeString = ^TUnicodeString;
   TUnicodeString = packed record
     Length: Word;
     MaximumLength: Word;
     Buffer: PWideChar;
   end;


type
   PObjectAttributes = ^TObjectAttributes;
   TObjectAttributes = record
     Length: ULONG;
     RootDirectory: THandle;
     ObjectName: PUnicodeString;
     Attributes: ULONG;
     SecurityDescriptor: PSecurityDescriptor;
     SecurityQualityOfService: PSecurityQualityOfService;
   end;


type
   TFNZwOpenSection = function(out SectionHandle: THandle;
     DesiredAccess: ACCESS_MASK; ObjectAttributes: PObjectAttributes): 
NTSTATUS;
     stdcall;
   TFNRtlNtStatusToDosError = function(Status: NTSTATUS): DWORD; stdcall;

type
   PRomDumpCodeInfo = ^TRomDumpCodeInfo;
   TRomDumpCodeInfo = (rdciStart, rdciEnd, rdciSize);

const
   STATUS_SUCCESS = NTSTATUS(0);
   STATUS_INVALID_HANDLE = NTSTATUS($C0000008);
   STATUS_ACCESS_DENIED = NTSTATUS($C0000022);

   // Well known offsets... (only date seems to be always available)
   RomBiosDateOffset = Pointer($000FFFF5);
   RomBiosNameOffset = Pointer($000FE061);
   RomBiosCopyrightOffset = Pointer($000FE091);
   RomBiosIdOffset = Pointer($000FEC71);

   OBJ_INHERIT = $00000002;
   OBJ_PERMANENT = $00000010;
   OBJ_EXCLUSIVE = $00000020;
   OBJ_CASE_INSENSITIVE = $00000040;
   OBJ_OPENIF = $00000080;
   OBJ_OPENLINK = $00000100;
   OBJ_KERNEL_HANDLE = $00000200;
   OBJ_VALID_ATTRIBUTES = $000003F2;

   ObjectPhysicalMemoryDeviceName = ´\Device\PhysicalMemory´;
   ObjectPhysicalMemoryName: TUnicodeString = (
     Length: Length(ObjectPhysicalMemoryDeviceName) * 2;
     MaximumLength: Length(ObjectPhysicalMemoryDeviceName) * 2 + 2;
     Buffer: ObjectPhysicalMemoryDeviceName;
   );
   ObjectPhysicalMemoryAccessMask: ACCESS_MASK = SECTION_MAP_READ;
   ObjectPhysicalMemoryAttributes: TObjectAttributes =(
     Length: SizeOf(TObjectAttributes);
     RootDirectory: 0;
     ObjectName: @ObjectPhysicalMemoryName;
     Attributes: OBJ_CASE_INSENSITIVE;
     SecurityDescriptor: nil;
     SecurityQualityOfService: nil;
   );

   ntdll = ´ntdll.dll´;

var
   ZwOpenSection: TFNZwOpenSection;
   RtlNtStatusToDosError: TFNRtlNtStatusToDosError;

function ReadRomBios(var Dump: TRomBiosDump; Method: TReadRomBiosMethod;
   Timeout: DWORD = INFINITE): Boolean;
function ReadRomBios9x(var Buffer: TRomBiosDump): Boolean;
function ReadRomBios16(var Buffer: TRomBiosDump; Timeout: DWORD): Boolean;
function ReadRomBiosNt(var Buffer: TRomBiosDump; Timeout: DWORD): Boolean;
function DirectoryExists(const Dir: string): Boolean;
function _RomDumpCodeToFile(const Filename: string): Boolean;
function _RomDumpCodeExecute(const Com, Dmp: string; Timeout: DWORD): 
Boolean;
function _RomDumpCode(Info: TRomDumpCodeInfo): Pointer;
function GetRomBiosString(const Dump: TRomBiosDump; Address: Pointer): 
string;


implementation

function ReadRomBios(var Dump: TRomBiosDump; Method: TReadRomBiosMethod;
   Timeout: DWORD = INFINITE): Boolean;
begin
   Result := False;
   case Method of
     rrbmAutomatic:
       if (Integer(GetVersion) < 0) then
       try
         Result := ReadRomBios9x(Dump);
       except
         Result := ReadRomBios16(Dump, Timeout);
       end
       else
         Result := ReadRomBiosNt(Dump, Timeout);
     rrbmGeneric:
       Result := ReadRomBios16(Dump, Timeout);
     rrbmMemory:
       Result := ReadRomBios9x(Dump);
     rrbmPhysical:
       Result := ReadRomBiosNt(Dump, Timeout);
   else
     SetLastError(ERROR_INVALID_PARAMETER);
   end;
end;

{#
 
        
 DIRECT METHOD (Win9x) 
        
 
        
 Due to the fact that Windows 95/98/ME maps the BIOS into every Win32 
process 
 for read access it is very simple to fill the buffer from memory. 
        
 
        
}

function ReadRomBios9x(var Buffer: TRomBiosDump): Boolean;
begin
   Result := False;
   try
     FillChar(Buffer, SizeOf(TRomBiosDump), 0);
     Move(Pointer(Low(TRomBiosDump))^, Buffer, SizeOf(TRomBiosDump));
     Result := True;
   except
   end
end;


{ Get BIOS dump the generic way }
function ReadRomBios16(var Buffer: TRomBiosDump; Timeout: DWORD): Boolean;
const
   TempSub = ´~RomDmp´;
   ComName = ´RomDump.com´;
   DmpName = ´Rom.dmp´;
var
   TempPath: string;
   TempDir: string;
   TempIdx: Integer;
   TempIdxStr: string;
   ComFile: string;
   DmpFile: string;
   DmpHandle: THandle;
   Written: DWORD;
begin
   Result := False;
   SetLength(TempPath, MAX_PATH);
   SetLength(TempPath, GetTempPath(MAX_PATH, PChar(@TempPath[1])));
   if Length(TempPath) > 0 then
   begin
     if (TempPath[Length(TempPath)] <> ´\´) then
       TempPath := TempPath + ´\´;
     TempIdx := 0;
     repeat
       Inc(TempIdx);
       Str(TempIdx, TempIdxStr);
       TempDir := TempPath + TempSub + TempIdxStr;
     until not DirectoryExists(TempDir);
     if CreateDirectory(PChar(TempDir), nil) then
     try
       TempDir := TempDir + ´\´;
       ComFile := TempDir + ComName;
       DmpFile := TempDir + DmpName;
       if _RomDumpCodeToFile(ComFile) then
       try
         if _RomDumpCodeExecute(ComFile, DmpFile, Timeout) then
         begin
           DmpHandle := CreateFile(PChar(DmpFile), GENERIC_READ,
             FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
           if DmpHandle <> INVALID_HANDLE_VALUE then
           try
             FillChar(Buffer, SizeOf(TRomBiosDump), 0);
             Result := ReadFile(DmpHandle, Buffer, SizeOf(TRomBiosDump),
               Written, nil) and (Written = SizeOf(TRomBiosDump));
           finally
             CloseHandle(DmpHandle);
           end;
         end;
       finally
         DeleteFile(PChar(DmpFile));
         DeleteFile(PChar(ComFile));
       end;
     finally
       RemoveDirectory(PChar(TempDir));
     end;
   end;
end;

function ReadRomBiosNt(var Buffer: TRomBiosDump; Timeout: DWORD): Boolean;
var
   NtLayer: HMODULE;
   Status: NTSTATUS;
   Section: THandle;
   View: Pointer;
begin
   Result := False;
   NtLayer := GetModuleHandle(ntdll);
   if NtLayer = 0 then
     SetLastError(ERROR_CALL_NOT_IMPLEMENTED)
   else
   begin
     if not Assigned(ZwOpenSection) then
       ZwOpenSection := GetProcAddress(NtLayer, ´ZwOpenSection´);
     if not Assigned(RtlNtStatusToDosError) then
       RtlNtStatusToDosError := GetProcAddress(NtLayer, 
´RtlNtStatusToDosError´);
     if not (Assigned(ZwOpenSection) and 
Assigned(RtlNtStatusToDosError)) then
       SetLastError(ERROR_CALL_NOT_IMPLEMENTED)
     else
     begin
       Status := ZwOpenSection(Section, ObjectPhysicalMemoryAccessMask,
         @ObjectPhysicalMemoryAttributes);
       case Status of
         STATUS_SUCCESS:
           try
             View := MapViewOfFile(Section, 
ObjectPhysicalMemoryAccessMask, 0,
               Low(TRomBiosDump), SizeOf(TRomBiosDump));
             if Assigned(View) then
             try
               FillChar(Buffer, SizeOf(TRomBiosDump), 0);
               Move(View^, Buffer, SizeOf(TRomBiosDump));
               Result := True;
             finally
               UnmapViewOfFile(View);
             end;
           finally
             CloseHandle(Section);
           end;
         STATUS_ACCESS_DENIED:
           Result := ReadRomBios16(Buffer, Timeout);
       else
         SetLastError(RtlNtStatusToDosError(Status))
       end;
     end;
   end;
end;

function DirectoryExists(const Dir: string): Boolean;
var
   Attr: DWORD;
begin
   Attr := GetFileAttributes(PChar(Dir));
   Result := (Attr <> $FFFFFFFF) and
     (Attr and FILE_ATTRIBUTE_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY);
end;

function _RomDumpCodeToFile(const Filename: string): Boolean;
var
   ComFile: THandle;
   Size: Cardinal;
begin
   Result := False;
   ComFile := CreateFile(PChar(Filename), GENERIC_WRITE, 
FILE_SHARE_READ, nil,
     CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
   if ComFile <> INVALID_HANDLE_VALUE then
   try
     Result := WriteFile(ComFile, _RomDumpCode(rdciStart)^,
       Cardinal(_RomDumpCode(rdciSize)), Size, nil) and
       (Size = Cardinal(_RomDumpCode(rdciSize)));
     if not Result then
       DeleteFile(PChar(Filename));
   finally
     CloseHandle(ComFile);
   end;
end;

function _RomDumpCodeExecute(const Com, Dmp: string; Timeout: DWORD): 
Boolean;
var
   ComSpec: string;
   si: TStartupInfo;
   pi: TProcessInformation;
begin
   Result := False;
   SetLength(ComSpec, MAX_PATH);
   SetLength(ComSpec,
     GetEnvironmentVariable(´ComSpec´, PChar(@ComSpec[1]), MAX_PATH));
   if Length(ComSpec) > 0 then
   begin
     FillChar(si, SizeOf(TStartupInfo), 0);
     si.cb := SizeOf(TStartupInfo);
     si.dwFlags := STARTF_USESHOWWINDOW;
     si.wShowWindow := SW_HIDE;
     if CreateProcess(nil, PChar(ComSpec + ´ /C ´ + Com + ´ > ´ + Dmp),
       nil, nil, False, CREATE_NEW_CONSOLE or CREATE_NEW_PROCESS_GROUP, nil,
       nil, si, pi) then
     try
       Result := WaitForSingleObject(pi.hProcess, Timeout) <> WAIT_TIMEOUT;
     finally
       CloseHandle(pi.hProcess);
       CloseHandle(pi.hThread);
     end;
   end;
end;

function _RomDumpCode(Info: TRomDumpCodeInfo): Pointer;
var
   CodeStart: Pointer;
   CodeEnd: Pointer;
begin
   asm
           JMP @@End

           { *BEGIN* 16-bit code }
           { -- never use it in your program! -- }
           { COM which writes ROM-BIOS to StdOut }
   @@Start:
           { Dump F000:0000-F000:FFFE }
           XOR eDX, eDX // DS = 0xF000 ; Data segment
           MOV DH, 0F0h
           MOV DS, eDX
           XOR eDX, eDX // DX = 0x0000 ; Data offset
           XOR eCX, eCX // CX = 0xFFFF ; Data length
           DEC eCX
           XOR eBX, eBX // BX = 0x0001 ; STDOUT (file handle)
           INC eBX
           MOV AH, 40h // DosCall(0x40) ; INT21, DOS_WRITE_TO_HANDLE
           INT 21h
           JC @@Exit // On error exit ; AL = Error code
           { Dump F000:FFFF }
           XOR eDX, eDX // DS = 0xF000 ; Data segment
           MOV DH, 0F0h
           MOV DS, eDX
           XOR eDX, eDX // DX = 0xFFFF ; Data offset
           DEC eDX
           XOR eCX, eCX // CX = 0x0001 ; Data length
           INC eCX
           MOV eBX, eCX // BX = 0x0001 ; STDOUT (file handle)
           MOV AH, 40h // DosCall(0x40) ; INT21, DOS_WRITE_TO_HANDLE
           INT 21h
           JC @@Exit // On error exit ; AL = Error code
           MOV AL, 0 // no error ; AL = 0
   @@Exit:
           MOV AH, 4Ch // DosCall(0x4C) ; INT21, DOS_TERMINATE_EXE
           INT 21h
   @@End:
           { *END* 16-bit code }

           MOV CodeStart, OFFSET @@Start
           MOV CodeEnd, OFFSET @@End
   end;
   case Info of
     rdciStart:
       Result := CodeStart;
     rdciEnd:
       Result := CodeEnd;
     rdciSize:
       Result := Pointer(Cardinal(CodeEnd) - Cardinal(CodeStart));
   else
     Result := nil;
   end;
end;

function GetRomBiosString(const Dump: TRomBiosDump; Address: Pointer): 
string;
begin
   Result := ´´;
   if (Cardinal(Address) >= Low(TRomBiosDump)) and
     (Cardinal(Address) <= High(TRomBiosDump)) then
     Result := string(PChar(@Dump[Cardinal(Address)]));
end;

end.

-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-

procedure TForm1.Button1Click(Sender: TObject);
var Dump: TRomBiosDump;
begin
   if ReadRomBios(Dump, rrbmAutomatic) then
   begin
     ShowMessage(GetRomBiosString(Dump, RomBiosDateOffset));

     //use these offsets to gather requested information
     //but only the date seems to be available from every bios
     {
       RomBiosDateOffset = Pointer($000FFFF5);
       RomBiosNameOffset = Pointer($000FE061);
       RomBiosCopyrightOffset = Pointer($000FE091);
       RomBiosIdOffset = Pointer($000FEC71);
     }
   end;
end;

[i]uses SHA1, Base64;

function GetHashedBiosInfo: string;
var
  SHA1Context: TSHA1Context;
  SHA1Digest: TSHA1Digest;
begin
  // Get the BIOS data
  SetString(Result, PChar(Ptr($F0000)), $10000);
  // Hash the string
  SHA1Init(SHA1Context);
  SHA1Update(SHA1Context, PChar(Result), Length(Result));
  SHA1Final(SHA1Context, SHA1Digest);
  SetString(Result, PChar(@SHA1Digest), sizeof(SHA1Digest));
  // Return the hash string encoded in printable characters
  Result := B64Encode(Result);
end;[/u]

[b]ou [/b]

[i]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;[/i]

este é uma espécie de string pequena, que pode ser salva no registro do windows. (olhe os links)


[i]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)) + 1310;
        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;[/i]