AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Win32/Win64 API (native code) Delphi Seriennummer der Systemplatte...
Thema durchsuchen
Ansicht
Themen-Optionen

Seriennummer der Systemplatte...

Ein Thema von Z4ppy · begonnen am 9. Okt 2010 · letzter Beitrag vom 28. Apr 2012
Antwort Antwort
mkinzler
(Moderator)

Registriert seit: 9. Dez 2005
Ort: Heilbronn
39.851 Beiträge
 
Delphi 11 Alexandria
 
#1

AW: Seriennummer der Systemplatte...

  Alt 27. Apr 2012, 11:32
Zitat:
Ob du das String auch noch in ein AnsiString änderst, ist dir überlassen. (ist vermutlich aber nicht nötig)
Wenn schon, denn schon
Markus Kinzler
  Mit Zitat antworten Zitat
Chriscode

Registriert seit: 18. Aug 2009
32 Beiträge
 
#2

AW: Seriennummer der Systemplatte...

  Alt 27. Apr 2012, 11:42
Ouch, dummer Fehler. Bitte um Verzeihung.

Vielen Dank für die blitzschnelle Hilfe. Man sollte bei c&p halt trotzdem sein Hirn einschalten

Gruß
Chris
Chris
  Mit Zitat antworten Zitat
hathor
(Gast)

n/a Beiträge
 
#3

AW: Seriennummer der Systemplatte...

  Alt 27. Apr 2012, 18:05
...und immer daran denken:
Unter VISTA und WIN 7 laufen manche Programme nur mit Administratorrechten -> Rechtsklick: Als Administrator ausführen.

Geändert von hathor (27. Apr 2012 um 19:06 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#4

AW: Seriennummer der Systemplatte...

  Alt 27. Apr 2012, 20:13
Aber doch nicht, um die Seriennummer auszulesen. Und wenn dem so wäre, hätten die Programme schon unter XP nicht funktioniert, wenn man nur als Benutzer mit eingeschränkten Rechten arbeitet.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.196 Beiträge
 
Delphi 12 Athens
 
#5

AW: Seriennummer der Systemplatte...

  Alt 27. Apr 2012, 21:45
hätten die Programme schon unter XP nicht funktioniert, wenn ...
Wenn nicht sogar früher. (WinNT + neues Rechtesystem, bzw. ab NTFS oder ab einer bestimmten NTFS-Version)
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#6

AW: Seriennummer der Systemplatte...

  Alt 27. Apr 2012, 21:47
WinNT habe ich nicht erwähnt, weil er da wahrscheinlich noch nicht mal in Planung war.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
hathor
(Gast)

n/a Beiträge
 
#7

AW: Seriennummer der Systemplatte...

  Alt 28. Apr 2012, 01:48
Aber doch nicht, um die Seriennummer auszulesen.
GetPhysicalDriveHandle ist das Problem. Es braucht Administrator-Rechte bei WIN 7.

Test-Programm im Anhang.

Delphi-Quellcode:
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Windows,
  Forms,
  StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure FormShow(Sender: TObject);
  private
    { private declarations }
   public
    { public declarations }
  end;

var
  Form1: TForm1;
  OSVersionInfo: TOSVersionInfo;

const IDENTIFY_BUFFER_SIZE = 512;
  // SMART IOCTL commands
     DFP_GET_VERSION = $00074080;
     DFP_SEND_DRIVE_COMMAND = $0007c084;
     DFP_RECEIVE_DRIVE_DATA = $0007c088;
   IDE_ATAPI_ID = $A1; // Returns ID sector for ATAPI.
   IDE_ID_FUNCTION = $EC; // Returns ID sector for ATA.
   IDE_EXECUTE_SMART_FUNCTION = $B0; // Performs SMART cmd. Requires valid bFeaturesReg, bCylLowReg, and bCylHighReg


type
   TIDERegs = packed record
      bFeaturesReg : BYTE; // Used for specifying SMART "commands".
      bSectorCountReg : BYTE; // IDE sector count register
      bSectorNumberReg : BYTE; // IDE sector number register
      bCylLowReg : BYTE; // IDE low order cylinder value
      bCylHighReg : BYTE; // IDE high order cylinder value
      bDriveHeadReg : BYTE; // IDE drive/head register
      bCommandReg : BYTE; // Actual IDE command.
      bReserved : BYTE; // reserved for future use. Must be zero.
   end;
   IDEREGS = TIDERegs;
   PIDERegs = ^TIDERegs;
   LPIDERegs = PIDERegs;
   _IDEREGS = TIDERegs;

type
  TIdSector = packed record
    wGenConfig : Word;
    wNumCyls : Word;
    wReserved : Word;
    wNumHeads : Word;
    wBytesPerTrack : Word;
    wBytesPerSector : Word;
    wSectorsPerTrack : Word;
    wVendorUnique : Array[0..2] of Word;
    sSerialNumber : Array[0..19] of CHAR;
    wBufferType : Word;
    wBufferSize : Word;
    wECCSize : Word;
    sFirmwareRev : Array[0..7] of Char;
    sModelNumber : Array[0..39] of Char;
    wMoreVendorUnique : Word;
    wDoubleWordIO : Word;
    wCapabilities : Word;
    wReserved1 : Word;
    wPIOTiming : Word;
    wDMATiming : Word;
    wBS : Word;
    wNumCurrentCyls : Word;
    wNumCurrentHeads : Word;
    wNumCurrentSectorsPerTrack : Word;
    ulCurrentSectorCapacity : DWORD;
    wMultSectorStuff : Word;
    ulTotalAddressableSectors : DWORD;
    wSingleWordDMA : Word;
    wMultiWordDMA : Word;
    bReserved : Array[0..127] of BYTE;
  end;
  PIdSector = ^TIdSector;

type
   TDriverStatus = packed record
      bDriverError : Byte; // Error code from driver, or 0 if no error.
      bIDEStatus : Byte; // Contents of IDE Error register. Only valid when bDriverError is SMART_IDE_ERROR.
      bReserved : Array[0..1] of Byte; // Reserved for future expansion.
      dwReserved : Array[0..1] of DWORD; // Reserved for future expansion.
   end;
   DRIVERSTATUS = TDriverStatus;
   PDriverStatus = ^TDriverStatus;
   LPDriverStatus = TDriverStatus;
   _DRIVERSTATUS = TDriverStatus;

type
   TSendCmdOutParams = packed record
      cBufferSize : DWORD; // Size of bBuffer in bytes
      DriverStatus : TDriverStatus; // Driver status structure.
      bBuffer : Array[0..0] of BYTE; // Buffer of arbitrary length in which to store the data read from the drive.
   end;
   SENDCMDOUTPARAMS = TSendCmdOutParams;
   PSendCmdOutParams = ^TSendCmdOutParams;
   LPSendCmdOutParams = PSendCmdOutParams;
   _SENDCMDOUTPARAMS = TSendCmdOutParams;

type
   TSendCmdInParams = packed record
      cBufferSize : DWORD; // Buffer size in bytes
      irDriveRegs : TIDERegs; // Structure with drive register values.
      bDriveNumber : BYTE; // Physical drive number to send command to (0,1,2,3).
      bReserved : Array[0..2] of Byte; // Reserved for future expansion.
      dwReserved : Array[0..3] of DWORD; // For future use.
      bBuffer : Array[0..0] of Byte; // Input buffer.
   end;
   SENDCMDINPARAMS = TSendCmdInParams;
   PSendCmdInParams = ^TSendCmdInParams;
   LPSendCmdInParams = PSendCmdInParams;
   _SENDCMDINPARAMS = TSendCmdInParams;





implementation

{$R *.lfm}
//--------------------------------------------------------------------------------------------------------------------------
(*  asm kennt LAZARUS nicht
function StrLCopy(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; assembler;
asm
        PUSH EDI
        PUSH ESI
        PUSH EBX
        MOV ESI,EAX
        MOV EDI,EDX
        MOV EBX,ECX
        XOR AL,AL
        TEST ECX,ECX
        JZ @@1
        REPNE SCASB
        JNE @@1
        INC ECX
@@1: SUB EBX,ECX
        MOV EDI,ESI
        MOV ESI,EDX
        MOV EDX,EDI
        MOV ECX,EBX
        SHR ECX,2
        REP MOVSD
        MOV ECX,EBX
        AND ECX,3
        REP MOVSB
        STOSB
        MOV EAX,EDX
        POP EBX
        POP ESI
        POP EDI
end;
*)



function StrLCopy(Dest, Source: PChar; MaxLen: Cardinal): PChar;
var
  Count: Cardinal;
begin
  // copies a specified maximum number of characters from Source to Dest
  Result := Dest;
  Count := 0;
  While (Count < MaxLen) and (Source^ <> #0) do begin
    Dest^ := Source^;
    Inc(Source);
    Inc(Dest);
    Inc(Count);
  end;
  Dest^ := #0;
end;

/// <description> copies a specified maximum number of characters from Source to Dest </description>
function StrLCopy3(Dest, Source: PChar; MaxLen: UInt64): PChar;
begin
  Dec(MaxLen); // für die abschließende #0
  if Int64(MaxLen) < 0 then
    Exit(nil);
  Result := Dest;
  while (MaxLen > 0) and (Source^ <> #0) do begin
    Dest^ := Source^;
    Inc(Source);
    Inc(Dest);
    Dec(MaxLen);
  end;
  Dest^ := #0;
end;

procedure ChangeByteOrder( var Data; Size : Integer );
var ptr : PChar;
    i : Integer;
    c : Char;
begin
  ptr := @Data;
  for i := 0 to (Size shr 1)-1 do
  begin
    c := ptr^;
    ptr^ := (ptr+1)^;
    (ptr+1)^ := c;
    Inc(ptr,2);
  end;
end;

function GetPhysicalDriveHandle(DriveNum: Byte; DesireAccess: ACCESS_MASK): THandle;
var
  S: string;
begin
  OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
  GetVersionEx(OSVersionInfo);
  if OSVersionInfo.dwPlatformId=VER_PLATFORM_WIN32_NT then // Windows NT, Windows 2000
  begin
    Str(DriveNum,s); // avoid SysUtils
// Result := CreateFile( PChar('\\.\PhysicalDrive'+S), DesireAccess, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );
    Result := CreateFile( PChar('\\.\PhysicalDrive'+S), DesireAccess, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0 );
  end
  else // Windows 95 OSR2, Windows 98
    Result := CreateFile( '\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );
end;

procedure PrintIdSectorInfo( IdSector : TIdSector );
var szOutBuffer : Array [0..40] of Char;
begin
  with IdSector do
  begin
    ChangeByteOrder( sModelNumber, SizeOf(sModelNumber) ); // Change the WORD array to a BYTE array
    szOutBuffer[SizeOf(sModelNumber)] := #0;
    StrLCopy( szOutBuffer, sModelNumber, SizeOf(sModelNumber) );
    Form1.label1.caption :='Model : ' + szOutBuffer ;

    ChangeByteOrder( sFirmwareRev, SizeOf(sFirmwareRev) );
    szOutBuffer[SizeOf(sFirmwareRev)] := #0;
    StrLCopy( szOutBuffer, sFirmwareRev, SizeOf(sFirmwareRev) );
    Form1.label2.caption := 'Firmware Rev : ' + szOutBuffer ;

    ChangeByteOrder( sSerialNumber, SizeOf(sSerialNumber) );
    szOutBuffer[SizeOf(sSerialNumber)] := #0;
    StrLCopy( szOutBuffer, sSerialNumber, SizeOf(sSerialNumber) );
    Form1.label3.caption := 'Serial Number : '+ szOutBuffer ;
  end;
end;

function SmartIdentifyDirect( hDevice : THandle; bDriveNum : Byte; bIDCmd : Byte; var IdSector : TIdSector; var IdSectorSize : LongInt ) : BOOL;
const BufferSize = SizeOf(TSendCmdOutParams)+IDENTIFY_BUFFER_SIZE-1;
var SCIP : TSendCmdInParams;
      Buffer : Array [0..BufferSize-1] of Byte;
      SCOP : TSendCmdOutParams absolute Buffer;
      dwBytesReturned : DWORD;
begin
   FillChar(SCIP,SizeOf(TSendCmdInParams)-1,#0);
   FillChar(Buffer,BufferSize,#0);
   dwBytesReturned := 0;
   IdSectorSize := 0;
   // Set up data structures for IDENTIFY command.
   with SCIP do
   begin
      cBufferSize := IDENTIFY_BUFFER_SIZE;
      bDriveNumber := bDriveNum;
      with irDriveRegs do
      begin
         bFeaturesReg := 0;
         bSectorCountReg := 1;
         bSectorNumberReg := 1;
         bCylLowReg := 0;
         bCylHighReg := 0;
         bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);
         bCommandReg := bIDCmd;   // The command can either be IDE identify or ATAPI identify.
      end;
   end;
   Result := DeviceIoControl( hDevice, DFP_RECEIVE_DRIVE_DATA, @SCIP, SizeOf(TSendCmdInParams)-1, @SCOP, BufferSize, dwBytesReturned, nil );
   if Result then
   begin
      IdSectorSize := dwBytesReturned-SizeOf(TSendCmdOutParams)+1;
      if IdSectorSize<=0 then IdSectorSize := 0 else System.Move(SCOP.bBuffer,IdSector,IdSectorSize);
   end;
end;


procedure DirectIdentify;
var hDevice : THandle;
    //rc : DWORD;
    nIdSectorSize : LongInt;
    aIdBuffer : Array [0..IDENTIFY_BUFFER_SIZE-1] of Byte;
    IdSector : TIdSector absolute aIdBuffer;
begin
  FillChar(aIdBuffer,SizeOf(aIdBuffer),#0);
  hDevice := GetPhysicalDriveHandle( 0, GENERIC_READ or GENERIC_WRITE );
// hDevice := GetPhysicalDriveHandle( 0, GENERIC_READ ); <-- geht NICHT
  if hDevice=INVALID_HANDLE_VALUE then
    begin
      //rc := GetLastError;
    end
  else
    try
      if not SmartIdentifyDirect( hDevice, 0, IDE_ID_FUNCTION, IdSector, nIdSectorSize ) then
        begin
          //rc := GetLastError;
        end
      else
        begin
          //ShowMessage('SMART IDENTIFY command is completed successfully.');
          PrintIdSectorInfo(IdSector);
        end;
    finally
      CloseHandle(hDevice);
    end;
end;


{ TForm1 }

procedure TForm1.FormShow(Sender: TObject);
begin
  DirectIdentify;
end;

end.
Angehängte Grafiken
Dateityp: jpg TEST.jpg (14,5 KB, 32x aufgerufen)
Dateityp: jpg TEST-2.jpg (13,7 KB, 25x aufgerufen)
Angehängte Dateien
Dateityp: zip TEST.zip (635,0 KB, 45x aufgerufen)

Geändert von hathor (28. Apr 2012 um 16:17 Uhr)
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 23:54 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz