AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

HWID berechen crasht pc.

Ein Thema von k4ni · begonnen am 18. Jan 2008 · letzter Beitrag vom 19. Jan 2008
 
k4ni

Registriert seit: 17. Jul 2007
Ort: Ulm
258 Beiträge
 
Delphi 7 Enterprise
 
#1

HWID berechen crasht pc.

  Alt 18. Jan 2008, 17:14
hey leute,

ich hab irgendwo mal diese hwid.pas gefunden mit der man die eigene hardware-id berechnen kann:
Delphi-Quellcode:
unit hwid;

interface

uses
  Windows, Messages, Classes, Controls, Forms, sysutils,Registry,
  dialogs, tlhelp32, ExtCtrls, math, md5;

  function gethardwareid: string;

implementation
type
  THardwareget = record
    FGet:string;
  end;

var
  FileSystemFlags,MaximumComponentLength,VolumeSerialNumber : DWORD;
  CPUID:string;
  CPUType:string;
  CPUModel:string;
  CPUSpeed:string;
  Biosdate:string;
  VideoBiosdate:string;
  HDDManufactur:String;
  HDDSerialno:String;
  HDDVSerialno:String;
  Windir:String;
  Tempdir:String;
  Programfilesdir:String;
  ScreenResolution:String;
  MemTotalPhisical:String;
  Wintype:string;
  Winproductid:string;
  Winusername:string;

{                Kill Debugger }
function KillTask(ExeFileName: string): integer;
const
  PROCESS_TERMINATE=$0001;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  result := 0;

  FSnapshotHandle := CreateToolhelp32Snapshot
                     (TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle,
                                 FProcessEntry32);

  while integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
         UpperCase(ExeFileName))
     or (UpperCase(FProcessEntry32.szExeFile) =
         UpperCase(ExeFileName))) then
      Result := Integer(TerminateProcess(OpenProcess(
                        PROCESS_TERMINATE, BOOL(0),
                        FProcessEntry32.th32ProcessID), 0));
    ContinueLoop := Process32Next(FSnapshotHandle,
                                  FProcessEntry32);
  end;

  CloseHandle(FSnapshotHandle);
end;




procedure AntiProcDump;assembler;
asm
        MOV EAX, fs:[30h]
        TEST EAX, EAX
        JS @is9x

  @isNT:
        MOV EAX, [EAX+0Ch]
        MOV EAX, [EAX+0Ch]
        ADD DWORD PTR [EAX+20h], 2000h {increase size variable}
        JMP @finished

  @is9x:
        PUSH 0
        CALL GetModuleHandleA
        TEST EDX, EDX
        JNS @finished {Most probably incompatible!!!}
        CMP DWORD PTR [EDX+8], -1
        JNE @finished {Most probably incompatible!!!}
        MOV EDX, [EDX+4] {get address of internaly used}
                                           {PE header}
        ADD DWORD PTR [EDX+50h], 2000h {increase size variable}

  @finished:
end;

procedure antidebug;assembler;
asm
   jmp @jump;
   db $b8;// fake mov-instruction
    @fake1: jmp @ende;
  @endlos:
   int 3
   xor ax,ax
   jmp @endlos;

  @jump:
    jmp @fake1
  @ende:
end;


//
function GetHDSerialNumber: LongInt;
{$IFDEF WIN32}
var
  pdw : pDWord;
  mc, fl : dword;
{$ENDIF}
begin
  {$IfDef WIN32}
  New(pdw);
  GetVolumeInformation('C:\',nil,0,pdw,mc,fl,nil,0);
  Result := pdw^;
  dispose(pdw);
  {$ELSE}
  Result := GetWinFlags;
  {$ENDIF}
end;


//
function GetProgramFilesDir: string;
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion', False);
    Result := reg.ReadString('ProgramFilesDir');
  finally
    reg.Free;
  end;
end;


//
Function GetUser : string;
 Var
     buffer : String;
     buffsize : DWORD;
  Begin
       buffsize := 128;
       Setlength(buffer,buffsize);
       Getusername(Pchar(buffer),buffsize);
       result :=trim(buffer);
  end;


//
function GetCPUSpeed: Double;
const
  DelayTime = 500; // measure time in ms
var
  TimerHi, TimerLo: DWORD;
  PriorityClass, Priority: Integer;
begin
  PriorityClass := GetPriorityClass(GetCurrentProcess);
  Priority := GetThreadPriority(GetCurrentThread);
  SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
  Sleep(10);
  asm
    dw 310Fh // rdtsc
    mov TimerLo, eax
    mov TimerHi, edx
  end;
  Sleep(DelayTime);
  asm
    dw 310Fh // rdtsc
    sub eax, TimerLo
    sbb edx, TimerHi
    mov TimerLo, eax
    mov TimerHi, edx
  end;
  SetThreadPriority(GetCurrentThread, Priority);
  SetPriorityClass(GetCurrentProcess, PriorityClass);
  Result := TimerLo / (1000.0 * DelayTime);
  result :=floor(result);
end;


//
function GetIdeSerialNumber ():string;
const IDENTIFY_BUFFER_SIZE = 512;
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;
  TSendCmdInParams = packed record
    // Buffer size in bytes
    cBufferSize : DWORD;
    // Structure with drive register values.
    irDriveRegs : TIDERegs;
    // Physical drive number to send command to (0,1,2,3).
    bDriveNumber : BYTE;
    bReserved : Array[0..2] of Byte;
    dwReserved : Array[0..3] of DWORD;
    bBuffer : Array[0..0] of Byte; // Input buffer.
  end;
  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;
  TDriverStatus = packed record
    // Error code from driver, or 0 if no error.
    bDriverError : Byte;
    // Contents of IDE Error register. Only valid when bDriverError is SMART_IDE_ERROR.
    bIDEStatus : Byte;
    bReserved : Array[0..1] of Byte;
    dwReserved : Array[0..1] of DWORD;
  end;
  TSendCmdOutParams = packed record
    // Size of bBuffer in bytes
    cBufferSize : DWORD;
    // Driver status structure.
    DriverStatus : TDriverStatus;
    // Buffer of arbitrary length in which to store the data read from the drive.
    bBuffer : Array[0..0] of BYTE;
  end;

  var
    hDevice : THandle;
    cbBytesReturned : DWORD;
    SCIP : TSendCmdInParams;
    aIdOutCmd : Array [0..(SizeOf(TSendCmdOutParams)+IDENTIFY_BUFFER_SIZE-1)-1] of Byte;
    IdOutCmd : TSendCmdOutParams absolute aIdOutCmd;

  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;

begin
  Result := ''; // return empty string on error
  if SysUtils.Win32Platform=VER_PLATFORM_WIN32_NT then // Windows NT, Windows 2000
    begin
      // warning! change name for other drives: ex.: second drive '\\.\PhysicalDrive1\'
      hDevice := CreateFile( '\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
        FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );
    end
  else // Version Windows 95 OSR2, Windows 98
    hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );
  if hDevice=INVALID_HANDLE_VALUE then Exit;
  try
    FillChar(SCIP,SizeOf(TSendCmdInParams)-1,#0);
    FillChar(aIdOutCmd,SizeOf(aIdOutCmd),#0);
    cbBytesReturned := 0;
    // Set up data structures for IDENTIFY command.
    with SCIP do
    begin
      cBufferSize := IDENTIFY_BUFFER_SIZE;
// bDriveNumber := 0;
      with irDriveRegs do
      begin
        bSectorCountReg := 1;
        bSectorNumberReg := 1;
// if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0
// else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);
        bDriveHeadReg := $A0;
        bCommandReg := $EC;
      end;
    end;
    if not DeviceIoControl( hDevice, $0007c088, @SCIP, SizeOf(TSendCmdInParams)-1,
      @aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil ) then Exit;
  finally
    CloseHandle(hDevice);
  end;
  with PIdSector(@IdOutCmd.bBuffer)^ do
  begin
    ChangeByteOrder( sSerialNumber, SizeOf(sSerialNumber) );
    (PChar(@sSerialNumber)+SizeOf(sSerialNumber))^ := #0;
    Result := PChar(@sSerialNumber);
  end;
end;


function gethardwareid: string;
Var
a,b,c,d : Longword;
uretici: array [0..3] of Dword;
x:Pchar;
sysdir : Array[0..144] of char;
temp_klasor: array[0..MAX_PATH] of char;
MS: TMemoryStatus;
Reg: TRegistry;
yyil:string;
begin

// Application.MessageBox('Lisanssýz HardawareId. Lisans Ýçin Bizimle' + #13+#10 +'Ýrtibat Kurunuz [email]info@ertemsoft.net[/email]','Dikkat',0+48);
// Showmessage('Demo Version HardwareID');
  // CPU Serial No
  try
      asm
        mov eax,1 // eax registeri cpuid komutunun parametresidir
        db $0F, $A2 // cpuid komutu
        mov a,EAX
        mov b,EBX
        mov c,ECX
        mov d,EDX
      end;
      CPUID:=inttohex(a,8) + '-' + inttohex(b,8) + '-' + inttohex(c,8) + '-' + inttohex(d,8);
   except
      CPUID:='0000-D342-F921-M068';
   end;
  //

  // CPU Type
  try
    asm
        push ebx
        mov eax, 0
        dw $A20F // CPUID
        mov DWord ptr uretici, ebx //
        mov DWord ptr uretici[+4], edx // üretici dizisinin ikinci elemanýný al
        mov Dword ptr uretici[+8], ecx
        pop ebx
    end;
    uretici[3]:=0;
    x:=@uretici;
    CPUType:=x;
  except
    CPUType:='GenuineIntel';
  end;
  //

  // CPU Model
   try
      Reg := TRegistry.Create;
      Reg.RootKey := HKEY_LOCAL_MACHINE;
      Reg.OpenKey('\Hardware\Description\System\CentralProcessor\0', True);
      CPUModel := Reg.ReadString('Identifier');
   except
      CPUModel := 'Unknown';
   end;

  // CPU Speed
   try
      CPUSpeed := FloatToStr(GetCPUSpeed) + ' MHz';
   except
      CPUSpeed := 'Unknown';
   end;

   // Biosdate
   try
      Reg := TRegistry.Create;
      Reg.RootKey := HKEY_LOCAL_MACHINE;
      Reg.OpenKey('\Hardware\Description\System\', True);
      if StrToInt(Copy(Reg.ReadString('SystemBiosdate'),7,2)) < 90 then
        yyil:='20else yyil:='19';
      Biosdate:=Copy(Reg.ReadString('SystemBiosdate'),1,6)+ yyil + Copy(Reg.ReadString('SystemBiosdate'),7,2) ;
   except
      Biosdate:='Unknown';
   end;

   // Vide0Biosdate
   try
      Reg := TRegistry.Create;
      Reg.RootKey := HKEY_LOCAL_MACHINE;
      Reg.OpenKey('\Hardware\Description\System\', True);
      VideoBiosdate:=Reg.ReadString('VideoBiosDate');
   except
      VideoBiosdate:='Unknown';
   end;


  // HDD Manufactur No
   try
      HDDManufactur:=Trim(GetIdeSerialNumber);
   except
      HDDManufactur:='ZXOLM9';
   end;


  // HDD Serial No
   try
      HDDSerialno:=IntToStr(gethdserialnumber);
   except
      HDDSerialno:='87142390';
   end;
  //

  // HDD Volume Serial No
   try
      GetVolumeInformation('C:\',nil,0,@VolumeSerialNumber,MaximumComponentLength,FileSystemFlags,nil,0);
      HDDVSerialno := IntToHex(HiWord(VolumeSerialNumber), 4) + '-' +IntToHex(LoWord(VolumeSerialNumber), 4);
   except
      HDDVSerialno:='3247B-FC87';
   end;
  //

  // Windows Directory
   try
      GetWindowsDirectory(sysdir, sizeof(sysdir));
      GetTempPath(SizeOf(temp_klasor), @temp_klasor);
      Windir:=sysdir;
      Tempdir:=Trim(temp_klasor);
      Programfilesdir:=GetProgramFilesDir;
   except
      windir:='Unknown';
   end;


   // ScreenResolution
   try
      ScreenResolution:=IntToStr(screen.Width) + 'x' + IntToStr(screen.Height);
   except
      ScreenResolution:='Unknown';
   end;

   // MemTotalPhisical
   try
      MemTotalPhisical:=IntToStr(MS.dwTotalPhys);
   except
      MemTotalPhisical:='0';
   end;



  // Windows Type
   try
      if (Win32MinorVersion=0) then wintype:='Windows 95'
      else
      if (Win32MinorVersion=10) then wintype:='Windows 98'
      else
      if (Win32MinorVersion=90) then wintype:='Windows Me'
      else
      if (Win32MinorVersion=0) then wintype:='Windows 2000'
      else
      if (Win32MinorVersion=3) then wintype:='Windows NT 3.51'
      else
      if (Win32MinorVersion=4) then wintype:='Windows NT 4'
      else
      if (Win32MinorVersion=1) then wintype:='Windows XP';
   except
      Wintype:='Unknown';
   end;

   // Winproductid
   try
      Reg := TRegistry.Create;
      Reg.RootKey := HKEY_LOCAL_MACHINE;
      Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion', True);
      Winproductid := Reg.ReadString('ProductID');
   except
      Winproductid := 'Unknown';
   end;
   //

   // WinUserName
   try
       Winusername:=Trim(Getuser);
   except
       Winusername:='Unknown';
   end;
   //
   result:=md5.MD5Print(md5.MD5String(CPUID+HDDManufactur+HDDSerialno+Winproductid));
end;


end.
Hier die compilte version von mir:
http://download.lima-city.de/crackcheck/hwid.exe

Doch wenn mein freund es nur ausführhrt started es seinen pc einfach neu. Woran kann das liegen?
  Mit Zitat antworten Zitat
 


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 13:33 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz