Code:

unit BiosDate;

 

interface

 

function GetBiosDate: String;

 

implementation

 

function SegOfsToLinear(Segment, Offset: Word): Integer;

begin

result := (Segment SHL 4) OR Offset;

end;

 

function GetBiosDate: String;

begin

result := String(PChar(Ptr(SegOfsToLinear($F000, $FFF5))));

end;

 

end.

 

В windows не получится прочитать значения прямо из BIOS, однако, ничего не мешает нам считать нужные значения из реестра.

 

 

Code:

{$APPTYPE CONSOLE}

 

uses

SysUtils,

Classes,

IdBaseComponent,

IdComponent,

IdUDPBase,

IdUDPClient;

 

function HexStringToBinString(const HexStr: string): string;

var

i, l: integer;

begin

Result := '';

l := length(HexStr);

l := l div 2;

SetLength(Result, l);

for i := 1 to l do

   if HexToBin(PChar(Copy(HexStr, (i - 1) * 2 + 1, 2)),

     PChar(@Result[i]), 1) = 0 then

     raise Exception.Create('Invalid hex value');

end;

 

procedure SendMagicPacket(MACAddress: string);

var

s, packet: string;

i: integer;

begin

if Length(MACAddress) <> 12 then

   raise Exception.CreateFmt('Invalid MAC Address: %s', [MACAddress]);

packet := HexStringToBinString('FFFFFFFFFFFF');

s := HexStringToBinString(MACAddress);

for i := 1 to 16 do

   packet := packet + s;

with TIdUDPClient.Create(nil) do

try

   Active := true;

   BroadcastEnabled := true;

   Broadcast(packet, 9);

finally

   Free;

end;

end;

 

begin

if ParamCount <> 1 then

   WriteLn('usage: WakeOnLan MACAddress' + #10 + #13 + 'exmple: WakeOnLan 000102030405')

else

   SendMagicPacket(ParamStr(1));

end.

 

 

 

Code:

with Memo1.Lines do

begin

Add('MainBoardBiosName:'+^I+string(Pchar(Ptr($FE061))));

Add('MainBoardBiosCopyRight:'+^I+string(Pchar(Ptr($FE091))));

Add('MainBoardBiosDate:'+^I+string(Pchar(Ptr($FFFF5))));

Add('MainBoardBiosSerialNo:'+^I+string(Pchar(Ptr($FEC71))));

end;

 

AWARD BIOS v2.50

   AWARD_SW

   j262

   TTPTHA

   01322222

   KDD

   ZBAAACA

   aPAf

   lkwpeter

   t0ch88

   t0ch20x

   h6BB

   j09F

   TzqF

 

An Example of this unit is availabe as Demo Download.

 

Как-то раз в один прекрасный день решил я у друга взять на денек очередной диск поиграть - и в итоге забыл его в дисководе у другого друга  Вот и решил я написать программу-напоминалку: при завершении работы она выскакивает и спрашивает юзера, а не хотел бы он вынуть диск (если диска нет - она даже не пикнет )?

 

 

Windows 9X

Code:

{©Drkb v.3}

with Memo1.Lines do

begin

   Add('MainBoardBiosName:'+^I+string(Pchar(Ptr($FE061))));

   Add('MainBoardBiosCopyRight:'+^I+string(Pchar(Ptr($FE091))));

   Add('MainBoardBiosDate:'+^I+string(Pchar(Ptr($FFFF5))));

   Add('MainBoardBiosSerialNo:'+^I+string(Pchar(Ptr($FEC71))));

end;

 

 

Code:

{....}

 

uses Registry;

 

{....}

 

function HasCDRecorder: Boolean;

var

reg: TRegistry;

begin

reg := TRegistry.Create;

try

   // set the the Mainkey,

   reg.RootKey := HKEY_CURRENT_USER;

   // Open a key

   reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\CD Burning', False);

   // Check if the Key exists

   Result := reg.ValueExists('CD Recorder Drive');

   // Close the key

   reg.CloseKey;

finally

   // and free the TRegistry Object

   reg.Free;

end;

end;

 

// Example:

procedure TForm1.Button1Click(Sender: TObject);

begin

if HasCDRecorder then

   ShowMessage('CD-Recorder available.')

else

   ShowMessage('CD-Recorder NOT available.');

end;

 

 

 

Вот пример как можно даты БИОС материнской платы и видеокарты выдрать. То же самое можно с названием производителя и версией.

В WinNT приходится читать не из ПЗУ а из реестра но это достаточно надежно - соотв ключи WinNT закрывает на запись и обновляет при каждом старте (?).

Для Win9x можешь хоть весь БИОС напрямую читать.

 

Получить заводской номер винчестера (не тот что getvolumeinfo дает) ИМХО невозможно - порты IDE даже Win9x блокирует.

 

Code:

uses

  Registry;

 

procedure CDSetAutoPlay(SioNo: Boolean);

var

  Reg: TRegistry;

begin

  try

    Reg := TRegistry.Create;

    Reg.RootKey := HKEY_LOCAL_MACHINE;

    if Reg.KeyExists('Software\Classes\AudioCD\') then

      if Reg.OpenKey('Software\Classes\AudioCD\Shell\', False) then

        if SioNo then Reg.WriteString('', 'play')

        else

           Reg.WriteString('', '');

  finally

    Reg.Free;

  end;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

  {Activate  AutoPlay}

  CDSetAutoPlay(True);

end;

 

procedure TForm1.Button2Click(Sender: TObject);

begin

  {Deactivate Autoplay}

  CDSetAutoPlay(False);

end;