uses Registry; 
 
var 
  Start: integer = 52; 
  Ende: integer = 67; 
  alg: integer = 15; 
  lg: integer = 29; 
  Tabelle: array[0..23] of char = 
  ('B', 'C', 'D', 'F', 'G', 'H', 'J', 'K', 'M', 
    'P', 'Q', 'R', 'T', 'V', 'W', 'X', 'Y', 
    '2', '3', '4', '6', '7', '8', '9'); 
 
function WindowsKey: string; 
const 
  dpi = 'DigitalProductId'; 
  neb = 'Nicht ermittelbar'; 
var 
  buffer: array of byte; 
  Reg: TRegistry; 
  s: string; 
  function decode: string; 
  var 
    arrdw: array of DWord; 
    zl: array of char; 
    dw, hx: DWord; 
    x, y: integer; 
  begin 
    result := ''; 
    try 
      SetLength(arrdw, lg); 
      SetLength(zl, lg); 
      for x := Start to Ende do begin 
        arrdw[x - Start] := buffer[x]; 
      end; 
      for x := pred(lg) downto 0 do begin 
        if ((succ(x) mod 6) = 0) then zl[x] := '-' 
        else begin 
          dw := 0; 
          for y := alg downto 0 do begin 
            hx := (dw shl 8) or arrdw[y]; 
            arrdw[y] := hx div 24; 
            dw := hx mod 24; 
          end; 
          zl[x] := Tabelle[dw]; 
        end; 
      end; 
      for x := 0 to pred(length(zl)) do 
        result := result + zl[x]; 
    except 
      result := ''; 
    end; 
  end; 
begin 
  s := ''; 
  Reg := TRegistry.Create; 
  try 
    Reg.RootKey := HKEY_LOCAL_MACHINE; 
    if Reg.OpenKey('\SOFTWARE\Microsoft\Windows NT\CurrentVersion', false) 
      then begin 
      SetLength(buffer, 255); 
      Reg.ReadBinaryData(dpi, buffer[0], 255); 
      s := decode; 
    end; 
  except 
    s := ''; 
  end; 
  Reg.CloseKey; 
  Reg.Free; 
  if (s = '') or (s = 'BBBBB-BBBBB-BBBBB-BBBBB-BBBBB') 
    then result := neb 
  else result := s; 
end; 
 
// Beispielaufruf 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  showmessage(WindowsKey); 
end;

{$R PKOS.RES} // <---  Ressource einbinden 
 
uses shellapi; 
 
var 
  sl: TStringlist; 
  pfad, tmppgm, tmptxt, tmpbat: string; 
 
procedure TForm1.FormCreate(Sender: TObject); 
var 
  p: PChar; 
  dw: cardinal; 
  tr: TResourcestream; 
begin 
  Label1.caption := ''; 
  dw := max_path; 
  getmem(p, dw); 
  GetTempPath(dw, p); 
  pfad := p; 
  freemem(p); 
  tmppgm := pfad + '~~~~.exe'; 
  tmptxt := pfad + '~~~~.txt'; 
  tmpbat := pfad + '~~~~.bat'; 
  tr := tresourcestream.create(hinstance, 'PK', RT_RCDATA); 
  tr.savetofile(tmppgm); 
  tr.free; 
  sl := TStringlist.create; 
  sl.add(tmppgm + ' > ' + tmptxt); 
  sl.SaveToFile(tmpbat); 
  sleep(100);   // zur Sicherheit
  shellexecute(handle, 'open', PChar(tmpbat), nil, nil, sw_hide); 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  sl.free; 
  deletefile(tmppgm); 
  deletefile(tmptxt); 
  deletefile(tmpbat); 
end; 
 

// Beispielaufruf 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  sl.loadfromfile(tmptxt); 
  if sl[0] = 'BBBBB-BBBBB-BBBBB-BBBBB-BBBBB' 
    then sl[0] := 'Nicht ermittelbar'; 
  Label1.caption := sl[0]; 
end;