{ ShowBiosData.dpr
Mostra os dados da BIOS do micro. Roda em Windows 9x/ME ou NT/2000/XP/2003. por Rubem Nascimento da Rocha - djpardalro...@hotmail.com Pode ser usado livremente, desde que seja dado o devido crédito ao autor. } program ShowBiosData; {$APPTYPE CONSOLE} {$WARNINGS OFF} uses Windows, SysUtils, Classes, Types, Registry; const // Para uso somente em plataformas Windows 9x/ME cBIOSName = $FE061; cBIOSDate = $FFFF5; cBIOSExtInfo = $FEC71; cBIOSCopyright = $FE091; // Para uso somente em plataformas NT (NT/2000/XP/2003/etc.) rkBIOS = '\HARDWARE\DESCRIPTION\System'; rvBiosDate = 'SystemBiosDate'; rvBiosID = 'Identifier'; rvBiosVersion = 'SystemBiosVersion'; function MultiSzToArray(const MultiSz: PChar): TStringDynArray; var P: PChar; // aponta para as strings no buffer begin SetLength(Result, 0); // Não faz nada se MultiSz é nil if not Assigned(MultiSz) then Exit; // Busca por strings delimitadas por #0 até encontrar #0#0 P := MultiSz; while P^ <> #0 do begin // adiciona strings ao vetor resultado (retorno da função) SetLength(Result, Length(Result) + 1); Result[Length(Result) - 1] := StrPas(P); // move ponteiro para o início da próximo string (se houver) Inc(P, StrLen(P) + 1); end; end; procedure MultiStrFromBuf(Buffer: array of Byte; var List: TStringList); var p: PChar; lStrings: TStringDynArray; i: Integer; begin p := PChar(@Buffer); lStrings := MultiSzToArray(p); for i := Low(lStrings) to High(lStrings) do List.Add(lStrings[i]); end; function ReadRegistryValueAsString(Root: HKEY; Key, Value: string; BinaryAsHex: Boolean = True): string; var sl: TStringList; i, DataSize, DataType: Integer; Data: array[0..1024] of Byte; begin Result := EmptyStr; with TRegistry.Create do try RootKey := Root; Access := KEY_READ; if OpenKey(Key, False) and ValueExists(Value) then begin RegQueryValueEx(CurrentKey, PChar(Value), nil, PDWORD(@DataType), nil, PDWORD(@DataSize)); case DataType of REG_SZ: Result := ReadString(Value); REG_EXPAND_SZ: begin Result := ReadString(Value); DataSize := ExpandEnvironmentStrings(PChar(Result), nil, DataSize); if DataSize > 0 then begin DataSize := ExpandEnvironmentStrings(PChar(Result), PChar(@Data), DataSize); Result := string(PChar(@Data)); end; end; REG_DWORD, REG_DWORD_BIG_ENDIAN: Result := IntToStr(ReadInteger(Value)); REG_MULTI_SZ: begin Result := EmptyStr; if DataSize > -1 then begin ReadBinaryData(Value, Data, DataSize); sl := TStringList.Create; try MultiStrFromBuf(Data, sl); Result := sl.Text; finally sl.Free; end; end; end; else begin Result := EmptyStr; if DataSize >- 1 then begin ReadBinaryData(Value, Data, DataSize); if BinaryAsHex then begin i := 0; if Data[i] <> 0 then Result := Result + Format('%2.2x', [Data[i]]) else if Copy(Result, Length(Result), 1) <> #10 then Result := Result + sLineBreak; SetLength(Result, Length(Result) - 2); end else begin for i := 0 to DataSize - 1 do Result := Result + Format('%2.2x ',[Ord(Data[i])]); SetLength(Result, Length(Result) - 1); end; end; end; end; CloseKey; end; finally Free; end; end; function BIOSName: String; begin Result := ReadRegistryValueAsString(HKEY_LOCAL_MACHINE, rkBIOS, rvBiosID, False); end; function BIOSDate: String; begin Result := ReadRegistryValueAsString(HKEY_LOCAL_MACHINE, rkBIOS, rvBiosDate, False); end; function BIOSCopyright: AnsiString; begin Result := ReadRegistryValueAsString(HKEY_LOCAL_MACHINE, rkBIOS, rvBiosVersion, False); end; begin if Win32Platform < VER_PLATFORM_WIN32_NT then begin WriteLn('BIOS Name: ', StrPas(PChar(Ptr(cBIOSName)))); WriteLn('BIOS Data: ', StrPas(PChar(Ptr(cBIOSDate)))); WriteLn('BIOS Copyright: ', StrPas(PChar(Ptr(cBIOSCopyright)))); WriteLn('BIOS Extended Info: ', StrPas(PChar(Ptr(cBIOSExtInfo)))); end else begin WriteLn('BIOS Name: ', BIOSName); WriteLn('BIOS Date: ', BIOSDate); WriteLn('BIOS Copyright: ', BIOSCopyright); end; WriteLn(Eoln); end. Rubem Nascimento da Rocha 92 8429 2865 rubem.ro...@digitalti.com.br assinatura email Digital TI - Coordenação de Automação Av. Carvalho Leal, 1330 - 1º Andar Cachoeirinha - 69065-001 Manaus/AM Call Center: 92 2101-0100 <http://www.dtmanaus.com.br> www.dtmanaus.com.br [As partes desta mensagem que não continham texto foram removidas]