[elcolo83]

Mira, aca te paso una de la unidades que uso para capturar los datos de la PC y cifrarlos... Fijate en la funcion Generar.

Código Delphi [-]

unit InfoPc;  interface  uses   Windows, SysUtils, NB30;   const   METHOD_BUFFERED = 0;   FILE_ANY_ACCESS = 0;   FILE_DEVICE_MASS_STORAGE = $2D;   IOCTL_STORAGE_BASE = FILE_DEVICE_MASS_STORAGE;    IOCTL_STORAGE_QUERY_PROPERTY =     (IOCTL_STORAGE_BASE shl 16) or (FILE_ANY_ACCESS shl 14) or     ($500 shl 2) or  METHOD_BUFFERED;  type   PSTORAGE_DESCRIPTOR_HEADER = ^TSTORAGE_DESCRIPTOR_HEADER;   TSTORAGE_DESCRIPTOR_HEADER = packed record     Version: ULONG;     Size: ULONG;   end;    PSTORAGE_DEVICE_DESCRIPTOR = ^STORAGE_DEVICE_DESCRIPTOR;   STORAGE_DEVICE_DESCRIPTOR = packed record     Version: ULONG;     Size: ULONG;     DeviceType: UCHAR;     DeviceTypeModifier: UCHAR;     RemovableMedia: Boolean;     CommandQueueing: Boolean;     VendorIdOffset: ULONG;     ProductIdOffset: ULONG;     ProductRevisionOffset: ULONG;     SerialNumberOffset: ULONG;     BusType: ULONG;     RawPropertiesLength: ULONG;     RawDeviceProperties: array[0..0] of UCHAR;   end;   /////////////////////////////////////////////////////////////////////////////////////////////  type   HCRYPTPROV  = ULONG;   PHCRYPTPROV = ^HCRYPTPROV;   HCRYPTKEY   = ULONG;   PHCRYPTKEY  = ^HCRYPTKEY;   HCRYPTHASH  = ULONG;   PHCRYPTHASH = ^HCRYPTHASH;   LPAWSTR     = PAnsiChar;   ALG_ID      = ULONG;  const   CRYPT_NEWKEYSET = $00000008;   PROV_RSA_FULL   = 1;   ALG_TYPE_ANY    = 0;   ALG_CLASS_HASH  = (4 shl 13);   ALG_SID_MD5     = 3;   CALG_MD5        = (ALG_CLASS_HASH or ALG_TYPE_ANY or ALG_SID_MD5);   HP_HASHVAL      = $0002;   ALG_CLASS_DATA_ENCRYPT = (3 shl 13);   ALG_TYPE_STREAM = (4 shl 9);   ALG_SID_RC4     = 1;   CALG_RC4        = (ALG_CLASS_DATA_ENCRYPT or ALG_TYPE_STREAM or ALG_SID_RC4);     function CryptAcquireContext(phProv       :PHCRYPTPROV;                                pszContainer :LPAWSTR;                                pszProvider  :LPAWSTR;                                dwProvType   WORD;                                dwFlags      WORD) :BOOL; stdcall;     external ADVAPI32 name 'CryptAcquireContextA';   function CryptCreateHash    (hProv   :HCRYPTPROV;                                Algid   :ALG_ID;                                hKey    :HCRYPTKEY;                                dwFlags WORD;                                phHash  :PHCRYPTHASH) :BOOL;stdcall;     external ADVAPI32 name 'CryptCreateHash';   function CryptHashData      (hHash             :HCRYPTHASH;                                const pbData      :PBYTE;                                dwDataLen         WORD;                                dwFlags           WORD) :BOOL;stdcall;     external ADVAPI32 name 'CryptHashData';   function CryptEncrypt       (hKey       :HCRYPTKEY;                                hHash      :HCRYPTHASH;                                Final      :BOOL;                                dwFlags    WORD;                                pbData     :PBYTE;                                pdwDataLen :PDWORD;                                dwBufLen   WORD) :BOOL;stdcall;     external ADVAPI32 name 'CryptEncrypt';   function CryptDecrypt       (hKey       :HCRYPTKEY;                                hHash      :HCRYPTHASH;                                Final      :BOOL;                                dwFlags    WORD;                                pbData     :PBYTE;                                pdwDataLen :PDWORD) :BOOL;stdcall;     external ADVAPI32 name 'CryptDecrypt';   function CryptDeriveKey     (hProv     :HCRYPTPROV;                                Algid     :ALG_ID;                                hBaseData :HCRYPTHASH;                                dwFlags   WORD;                                phKey     :PHCRYPTKEY) :BOOL;stdcall;     external ADVAPI32 name 'CryptDeriveKey';   function CryptDestroyHash   (hHash:HCRYPTHASH) :BOOL;stdcall;     external ADVAPI32 name 'CryptDestroyHash';   function CryptReleaseContext(hProv:HCRYPTPROV; dwFlagsWORD):BOOL;stdcall;     external ADVAPI32 name 'CryptReleaseContext';   /////////////////////////////////////////////////////////////////////////////////////////////  function GetMACAdress: string; function GetVolumeSerialNumber(const drive: TFilename): DWord; function GetSerialNumber(Letra: Char; var VendorId: string; var ProductId: string;   var SerialNumber: string; var Extraible: Boolean): string; function encripxor(aStr: String; aKey: Integer): String; function desencripxor(aStr: String; aKey: Integer): String;  function Generar(Clave): String; Procedure CapturaDatos;   implementation  ////////////////////////////////////////////////////////////////////////////////////////////   function encripxor(aStr: String; aKey: Integer): String; begin    Result:='';    RandSeed:=aKey;    for aKey:=1 to Length(aStr) do        Result:=Result+Chr(Byte(aStr[aKey]) xor random(256)); end;   function desencripxor(aStr: String; aKey: Integer): String; begin    Result:='';    RandSeed:=aKey;    for aKey:=1 to Length(aStr) do        Result:=Result+Chr(Byte(aStr[aKey]) xor random(256)); end;   ////////////////////////////////////////////////////////////////////////////////////////////     function Cifrar(Texto, Password: string): string; var   hProv: HCRYPTPROV;   hHash: HCRYPTHASH;   hKey:  HCRYPTKEY;   Success: BOOL;   Buffer: array[0..1024] of Char;   DataLen: DWORD;   i: Integer; begin   Result:= '';   Success:= CryptAcquireContext(@hProv, nil, nil, PROV_RSA_FULL, 0);   if (not Success) then     if GetLastError() = DWORD(NTE_BAD_KEYSET) then       Success:= CryptAcquireContext(@hProv, nil, nil, PROV_RSA_FULL, CRYPT_NEWKEYSET);   if Success then     begin       if CryptCreateHash(hProv, CALG_MD5, 0, 0, @hHash) then         begin           if CryptHashData(hHash, PByte(PChar(Password)), Length(Password), 0) then             if CryptDeriveKey(hProv, CALG_RC4, hHash, $00800000, @hKey) then             begin               FillChar(Buffer,Sizeof(Buffer),0);               StrLCopy(@Buffer,PChar(Texto),Sizeof(Buffer) - 1);               DataLen:= StrLen(@Buffer);               if CryptEncrypt(hKey, 0, TRUE, 0, PByte(@Buffer), @DataLen, Sizeof(Buffer)) then               begin                 for i:= 0 to DataLen - 1 do                   Result:= Result + IntToHex(Byte(Buffer[i]),2);               end;             end;           CryptDestroyHash(hHash);         end;       CryptReleaseContext(hProv,0);     end; end;  function Descifrar(Texto, Password: string): string; var   hProv: HCRYPTPROV;   hHash: HCRYPTHASH;   hKey:  HCRYPTKEY;   Success: BOOL;   Buffer: array[0..1024] of Char;   DataLen: DWORD;   i,j: Integer; begin   Result:= '';   if Length(Texto) = 0 then     Exit;   if Odd(Length(Texto)) then     Exit;   if (Length(Texto) shr 2) > (Sizeof(Buffer) - 1) then     Exit;   i:= 0;   FillChar(Buffer,Sizeof(Buffer),0);   while Length(Texto) > 0 do   begin     if TryStrToInt('$'+copy(Texto,1,2),j) then     begin       Buffer[i]:= Char(j);       Delete(Texto,1,2);       inc(i);     end else Exit;   end;   Success:= CryptAcquireContext(@hProv, nil, nil, PROV_RSA_FULL, 0);   if (not Success) then     if GetLastError() = DWORD(NTE_BAD_KEYSET) then       Success:= CryptAcquireContext(@hProv, nil, nil, PROV_RSA_FULL, CRYPT_NEWKEYSET);   if Success then     begin       if CryptCreateHash(hProv, CALG_MD5, 0, 0, @hHash) then         begin           if CryptHashData(hHash, PByte(PChar(Password)), Length(Password), 0) then             if CryptDeriveKey(hProv, CALG_RC4, hHash, $00800000, @hKey) then             begin               DataLen:= i;               if CryptDecrypt(hKey, 0, TRUE, 0, PByte(@Buffer), @DataLen) then               begin                 Result:= Copy(String(PChar(@Buffer)),1,DataLen);               end;             end;           CryptDestroyHash(hHash);         end;       CryptReleaseContext(hProv,0);     end; end;      ////////////////////////////////////////////////////////////////////////////////////////////   // Descodifica el numero de serie function DecodeSerialNumber(SerialNumber: string): string; var   i: Integer; begin   Result:= EmptyStr;   while Length(SerialNumber) > 0 do   begin     if TryStrToInt('$'+Copy(SerialNumber,1,4),i) then     begin       Result:= Result + Char(Lo(i)) + Char(Hi(i));       Delete(SerialNumber,1,4);     end else     begin       Result:= EmptyStr;       Exit;     end;   end;   Result:= Trim(Result); end;  // Obtiene la informacion sobre el dispositivo // Parametros: //   Letra: Letra de la unidad (A,B,C,D...) //   VendorId: Identificacion del vendedor //   ProductId: Identificacion del producto //   SerialNumber: Numero de serie //   Extraible: Indica si el dispositivo es extraible (disquete, memoria usb) // function GetSerialNumber(Letra: Char; var VendorId: string; var ProductId: string;   var SerialNumber: string; var Extraible: Boolean): string; var   Disk: THandle;   Size: Cardinal;   Buffer: Pointer;   DeviceDescriptor: PSTORAGE_DEVICE_DESCRIPTOR; begin   Result:= EmptyStr;   Disk:= CreateFile(PChar('\\.\' + Letra + ':'),GENERIC_READ,FILE_SHARE_READ     or FILE_SHARE_WRITE,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);   if Disk <> INVALID_HANDLE_VALUE then   begin     GetMem(Buffer,12);     try       FillChar(Buffer^,12,0);       if DeviceIOControl(Disk, IOCTL_STORAGE_QUERY_PROPERTY,         Buffer,12,Buffer,12,Size, nil) then       begin         FreeMem(Buffer);         Size:= PSTORAGE_DESCRIPTOR_HEADER(Buffer).Size;         GetMem(Buffer, Size);         FillChar(Buffer^,Size,0);         if DeviceIOControl(Disk, IOCTL_STORAGE_QUERY_PROPERTY,           Buffer,12,Buffer,Size,Size, nil) then           begin             DeviceDescriptor:= Buffer;             Extraible:= DeviceDescriptor.RemovableMedia;             if DeviceDescriptor.VendorIdOffset > 0 then               VendorId:= String(PChar(Buffer) + DeviceDescriptor.VendorIdOffset)             else               VendorId:= EmptyStr;             if DeviceDescriptor.ProductIdOffset > 0 then               ProductId:= String(PChar(Buffer) + DeviceDescriptor.ProductIdOffset)             else               ProductId:= EmptyStr;             if (DeviceDescriptor.SerialNumberOffset > 0) and                (DeviceDescriptor.SerialNumberOffset < Size) then               SerialNumber:= String(PChar(Buffer) + DeviceDescriptor.SerialNumberOffset)             else               SerialNumber:= EmptyStr;           end else Result:= SysErrormessage(GetLastError);       end else Result:= SysErrormessage(GetLastError);     finally       FreeMem(Buffer);     end;     CloseHandle(Disk);   end else Result:= SysErrormessage(GetLastError); end;    ////////////////////////////////////////////////////////////////////////////////////////////     function GetVolumeSerialNumber(const drive: TFilename): DWord; var VolumeName, FileSystemName: array[0..MAX_PATH-1] of char; VolumeSerialNumber, MaxFilenameLength, FileSystemFlags: DWord; begin GetVolumeInformation(PChar(drive), VolumeName, MAX_PATH, @VolumeSerialNumber, MaxFilenameLength, FileSystemFlags, FileSystemName, MAX_PATH); Result := VolumeSerialNumber; end;   ////////////////////////////////////////////////////////////////////////////////////////////   function GetMACAdress: string; var   NCB: PNCB;   Adapter: PAdapterStatus;    URetCode: PChar;   RetCode: char;   I: integer;   Lenum: PlanaEnum;   _SystemID: string;   TMPSTR: string; begin    Result    := '';    _SystemID := '';    Getmem(NCB, SizeOf(TNCB));   Fillchar(NCB^, SizeOf(TNCB), 0);    Getmem(Lenum, SizeOf(TLanaEnum));   Fillchar(Lenum^, SizeOf(TLanaEnum), 0);    Getmem(Adapter, SizeOf(TAdapterStatus));    Fillchar(Adapter^, SizeOf(TAdapterStatus), 0);     Lenum.Length    := chr(0);    NCB.ncb_command := chr(NCBENUM);    NCB.ncb_buffer  := Pointer(Lenum);    NCB.ncb_length  := SizeOf(Lenum);    RetCode         := Netbios(NCB);     i := 0;    repeat      Fillchar(NCB^, SizeOf(TNCB), 0);     Ncb.ncb_command  := chr(NCBRESET);      Ncb.ncb_lana_num := lenum.lana[i];     RetCode          := Netbios(Ncb);      Fillchar(NCB^, SizeOf(TNCB), 0);     Ncb.ncb_command  := chr(NCBASTAT);     Ncb.ncb_lana_num := lenum.lana[i];     // Must be 16     Ncb.ncb_callname := '*               ';      Ncb.ncb_buffer := Pointer(Adapter);      Ncb.ncb_length := SizeOf(TAdapterStatus);     RetCode        := Netbios(Ncb);     //---- calc _systemId from mac-address[2-5] XOR mac-address[1]...     if (RetCode = chr(0)) or (RetCode = chr(6)) then     begin       _SystemId := IntToHex(Ord(Adapter.adapter_address[0]), 2) + '-' +         IntToHex(Ord(Adapter.adapter_address[1]), 2) + '-' +         IntToHex(Ord(Adapter.adapter_address[2]), 2) + '-' +         IntToHex(Ord(Adapter.adapter_address[3]), 2) + '-' +         IntToHex(Ord(Adapter.adapter_address[4]), 2) + '-' +         IntToHex(Ord(Adapter.adapter_address[5]), 2);     end;     Inc(i);   until (I >= Ord(Lenum.Length)) or (_SystemID <> '00-00-00-00-00-00');   FreeMem(NCB);   FreeMem(Adapter);   FreeMem(Lenum);   GetMacAdress := _SystemID; end;   ////////////////////////////////////////////////////////////////////////////////////////////   function Generar(Clave): String; var usmaq, maq, z, cod, K: string; begin     CapturaDatos;     K:= '?y&1m,£wq@7';  //K es un valor contante para la aplicación     Z:= Clave; //La Clave puede ser una fecha o lo que quieras     Z:= cifrar(Z, K+ SerialNumber.Caption + VendorID.Caption+ProductID.Caption+Extraible.Caption+VolumeSerialNumber.Caption+'V1.1'); //En ocaciones cambio el orden de los elementos de la suma o le agrego  //otros strings result:= Z; end;   Procedure CapturaDatos; var   VendorIdx: string;   ProductIdx: string;   SerialNumberx: string;   Extraiblex: Boolean;   Mensajex: string; begin  with Form1 do begin   MacAdress.Caption := GetMACAdress;   Mensajex:= GetSerialNumber('C', VendorIdx, ProductIdx, SerialNumberx, Extraiblex);   VolumeSerialNumber.Caption:= inttostr(GetVolumeSerialNumber('C:\'));   if Mensajex = EmptyStr then   begin     VendorID.Caption:= VendorIDx;     ProductID.Caption:= ProductIDx;     SerialNumber.Caption:= DecodeSerialNumber(SerialNumberx);     Extraible.Caption:= BoolToStr(Extraiblex,TRUE);   end else     ShowMessage(Mensajex);   if Trim(VendorID.Caption)= '' then VendorID.Caption:= '(No se encontró)';   if Trim(ProductID.Caption)= '' then ProductID.Caption:= '(No se encontró)';   if Trim(SerialNumber.Caption)= '' then SerialNumber.Caption:= '(No se encontró)'; end;   end;   end.

Fijate si te sirve algo de todo esto... =)