Unik Hardware Kode

er det til en exe-file??

Prøv om du kan bruge dette:

Option Explicit

Private Type SYSTEM_INFO
    dwOemID As Long
    dwPageSize As Long
    lpMinimumApplicationAddress As Long
    lpMaximumApplicationAddress As Long
    dwActiveProcessorMask As Long
    dwNumberOrfProcessors As Long
    dwProcessorType As Long
    dwAllocationGranularity As Long
    dwReserved As Long
End Type

Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)

Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Function GetHarddisk() As Long 'GetHarddisk
Dim Serial, cDrive, i, dTemp As Long
Dim nDrive As String
  For i = 65 To 90
    nDrive = Chr(i) & ":\"
    cDrive = GetDriveType(nDrive)
    If cDrive = 3 Then
      GetVolumeInformation nDrive, 0&, 0&, Serial, 0&, 0&, 0&, 0&
      dTemp = dTemp + Serial
    End If
  Next i
GetHarddisk = Val(Int(dTemp / 1024))
End Function

Function GetProcessor() As Long 'GetProcessor
Dim SInfo As SYSTEM_INFO
Dim dwNumber, dwProcessor, Min, Max, dwActive, dwAllocation, dwOem, dwPage, dwReserved As Long
GetSystemInfo SInfo
  dwNumber = Val(SInfo.dwNumberOrfProcessors)
  dwProcessor = Val(SInfo.dwProcessorType)
  Min = Val(SInfo.lpMinimumApplicationAddress)
  Max = Val(SInfo.lpMaximumApplicationAddress)
  dwActive = Val(SInfo.dwActiveProcessorMask)
  dwAllocation = Val(SInfo.dwAllocationGranularity)
  dwOem = Val(SInfo.dwOemID)
  dwPage = Val(SInfo.dwPageSize)
  dwReserved = Val(SInfo.dwReserved)
GetProcessor = Val((dwNumber / 1024)) + Val((dwProcessor / 1024)) + Val((Min / 1024)) + Val((Max / 1024)) + Val((dwActive / 1024)) + Val((dwAllocation / 1024)) + Val((dwOem / 1024)) + Val((dwPage / 1024)) + Val((dwReserved / 1024))
End Function

Private Sub Form_Load()
  Me.Caption = CStr(GetHarddisk & GetProcessor)
End Sub

Hej sjh

Den dutter ikke... Hvis jeg har to computere med samme hardware opsætning, så virker det du har sendt mig ikke.

Jeg skal bruge en nøgle der gælder for én enkelt maskine. Altså en 100% unik nøgle på hardwaren.

kun hvis du har et image af harddisken er den kode den samme.

du vil aldrig kunne lave en hardware Kode 100%

og skulle det program du har lavet være så godt, så skal de nok lave en crack Tro mig :-)

så er der også et problem når en bruger skifter hardwar ud med andet så skal brugeren jo have en ny Kode/Nøgle og der skal bruger jo have noget login eller sådan noget, som også kan blive misbrugt.

så nu er vi nok nede på 80% unik nøgle.

Hej sjh,

Ved kørsel på endtil flere forskellige computere, har jeg hver gang fået samme harddisk værdi ud - Nemlig 0 - og på ingen af de involverede computere er der involveret et harddisk image.

Hvad angår unik nøgle, så kan denne altid findes hvis der er netkort i maskinen. MAC-adressen er en unik nøgle på tværs af alle producenter. Dét jeg gerne vil finde er en anden unik nøgle end MAC adressen, da jeg ikke kan være sikker på at min applikation bliver afviklet på en maskine med netværkskort.

Altså, en CPU Product key, en key på Motherboard, harddisk eller lignende.

GetHarddisk skulle ikke gerne give 0 så virker det kun på win98, jeg har aldrig fået et 0

Følger lige med...

og hvis du vil lave en key over din cpu så her..
cpu product key er gerne "N/A"

http://hjem.get2net.dk/sjh/eksperten/124355/cpunfo.zip

sjh

Så har jeg løst opgaven... med inspiration fra hvad du har leveret :o)

***********************************************************************

Option Explicit

Private Type SYSTEM_INFO
    dwOemID As Long
    dwPageSize As Long
    lpMinimumApplicationAddress As Long
    lpMaximumApplicationAddress As Long
    dwActiveProcessorMask As Long
    dwNumberOrfProcessors As Long
    dwProcessorType As Long
    dwAllocationGranularity As Long
    dwReserved As Long
End Type

Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)

Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, ByRef lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Function GetHarddisk() As String 'GetHarddisk
Dim volname As String  ' receives volume name of C:
Dim sn As Long          ' receives serial number of C:
Dim snstr As String    ' display form of serial number
Dim maxcomplen As Long  ' receives maximum component length
Dim sysflags As Long    ' receives file system flags
Dim sysname As String  ' receives the file system name
Dim retval As Long      ' return value

' Initialize string buffers.
volname = Space(256)
sysname = Space(256)
' Get information about the C: drive's volume.
retval = GetVolumeInformation("C:\", volname, Len(volname), sn, maxcomplen, _
  sysflags, sysname, Len(sysname))
' Remove the trailing nulls from the two strings.
volname = Left(volname, InStr(volname, vbNullChar) - 1)
sysname = Left(sysname, InStr(sysname, vbNullChar) - 1)
' Format the serial number properly.
snstr = Trim(Hex(sn))
snstr = String(8 - Len(snstr), "0") & snstr
snstr = Left(snstr, 4) & "-" & Right(snstr, 4)
' Display the volume name, serial number, and file system name.

GetHarddisk = snstr & "-" & sysflags
End Function

Function GetProcessor() As Long 'GetProcessor
Dim SInfo As SYSTEM_INFO
Dim dwNumber, dwProcessor, Min, Max, dwActive, dwAllocation, dwOem, dwPage, dwReserved As Long
GetSystemInfo SInfo
  dwNumber = Val(SInfo.dwNumberOrfProcessors)
  dwProcessor = Val(SInfo.dwProcessorType)
  Min = Val(SInfo.lpMinimumApplicationAddress)
  Max = Val(SInfo.lpMaximumApplicationAddress)
  dwActive = Val(SInfo.dwActiveProcessorMask)
  dwAllocation = Val(SInfo.dwAllocationGranularity)
  dwOem = Val(SInfo.dwOemID)
  dwPage = Val(SInfo.dwPageSize)
  dwReserved = Val(SInfo.dwReserved)
GetProcessor = Val((dwNumber / 1024)) + Val((dwProcessor / 1024)) + Val((Min / 1024)) + Val((Max / 1024)) + Val((dwActive / 1024)) + Val((dwAllocation / 1024)) + Val((dwOem / 1024)) + Val((dwPage / 1024)) + Val((dwReserved / 1024))
End Function

Private Sub Main()
  MsgBox CStr(GetHarddisk & "-" & GetProcessor)
  End
End Sub

******************************************************************

Dét her virker :o)

en god ting også at tage med i generering af et unikt nummer, kunne være tiden (eks. antal millisekunder efter 1970). så hvis hardwaren er ens vil det først blive et problem hvis nøglen blev genereret i samme millisekund. sandsynligheden for det sker er ret lav.. :-)

Det var da godt jeg gav dig lidt hjælp :-)
Men jeg ville aldrig købe et program hvor jeg ikke er sikker på om jeg kan få opdateret en nøgle hvis firma går konkurs. ;)

så vil du altså ikke købe microsoft programmer ? :-)

nej

Det problem kan løses.

Det er blot et spørgsmål om at placere key generator programmet hos en advokat, som i tilfælde af at virksomheden lukker, leverer programmet til alle kunder.

ja ja..
lad os nu se om du kommer så langt, hvor kan man få lidt info om dit program??????????????

Der er ingen info at hente endnu.... Programmet er under udvikling

jeg venter..........