unit CryptRandom;
interface
uses
Windows;
type
HCryptProv = DWord;
PCryptProv = ^HCryptProv;
TCryptRandom =
class
private
FProvider : HCryptProv;
function GetContext: Boolean;
procedure ReleaseContext;
public
constructor Create();
procedure GetBytes(Bytes : PByte; Size : Integer);
function GetByte: Byte;
function GetInteger: Integer;
function GetCardinal: Cardinal;
function GetInt64: Int64;
function GetASCIIString(Size : Integer): AnsiString;
function GetDouble: Double;
function Random : Double;
overload;
function Random(Range : Integer): Integer;
overload;
end;
{ BOOL WINAPI CryptAcquireContext( __out HCRYPTPROV *phProv,
__in LPCTSTR pszContainer,
__in LPCTSTR pszProvider,
__in DWORD dwProvType,
__in DWORD dwFlags );
}
function CryptAcquireContext(phProv : PProvider;
pszContainer :PAnsiChar;
pszProvider : PAnsiChar;
dwProvType : DWord;
dwFlags : DWord) : BOOL;
stdcall;
{ BOOL WINAPI CryptReleaseContext( __in HCRYPTPROV hProv,
__in DWORD dwFlags );
}
function CryptReleaseContext(hProv : HCryptProv; dwFlags : DWord) :BOOL;
stdcall;
{ BOOL WINAPI CryptGenRandom( __in HCRYPTPROV hProv,
__in DWORD dwLen,
__inout BYTE *pbBuffer );
}
function CryptGenRandom(hProv : HCryptProv;
dwLen : DWord;
pbBuffer : PByte) : BOOL;
stdcall;
const
CRYPT_VERIFYCONTEXT = $F0000000;
// using ephemeral keys [default]
CRYPT_NEWKEYSET = $8;
// Creates a new key container "pszContainer"
CRYPT_DELETEKEYSET = $10;
// Delete the key container "pszContainer"
PROV_RSA_FULL = 1;
{ PROV_RSA_AES
PROV_RSA_SIG
PROV_RSA_SCHANNEL
PROV_DSS
PROV_DSS_DH
PROV_DH_SCHANNEL
PROV_FORTEZZA
PROV_MS_EXCHANGE
PROV_SSL
}
AdvApiDll = '
AdvAPI32.DLL';
implementation
function CryptAcquireContext;
external AdvApiDll
Name '
CryptAcquireContextA';
function CryptReleaseContext;
external AdvApiDll
Name '
CryptReleaseContext';
function CryptGenRandom;
external AdvApiDll
Name '
CryptGenRandom';
{ TCryptRandom }
constructor TCryptRandom.Create();
begin
FProvider := 0;
end;
function TCryptRandom.GetContext: Boolean;
begin
CryptAcquireContext(@FProvider,
NIL,
NIL, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
Result := GetLastError = 0;
end;
procedure TCryptRandom.ReleaseContext;
begin
if FProvider <> 0
then
begin
CryptReleaseContext(FProvider, 0);
FProvider := 0;
end;
end;
procedure TCryptRandom.GetBytes(Bytes : PByte; Size : Integer);
begin
if GetContext
then
begin
try
CryptGenRandom(FProvider, size, Bytes);
finally
ReleaseContext;
end;
end;
end;
function TCryptRandom.GetByte: Byte;
begin
GetBytes(@Result, SizeOf(Result));
end;
function TCryptRandom.GetInteger: Integer;
begin
GetBytes(@Result, SizeOf(Result));
end;
function TCryptRandom.GetCardinal: Cardinal;
begin
GetBytes(@Result, SizeOf(Result));
end;
function TCryptRandom.GetInt64: Int64;
begin
GetBytes(@Result, SizeOf(Result));
end;
function TCryptRandom.GetASCIIString(Size : Integer): AnsiString;
var
i : Integer;
b : Byte;
begin
SetLength(Result, Size);
GetBytes(@Result[1], Size);
for i := 1
to Size
do
begin
b := Ord(Result[i]);
Result[i] := Chr((b
div 4) + 33);
end;
end;
function TCryptRandom.GetDouble: Double;
var
c : Currency;
begin
GetBytes(@c, SizeOf(c));
Result := c;
end;
function TCryptRandom.Random : Double;
begin
// 0 <= Result < 1, max 18 decimal digits
Result := Frac(Abs(GetInt64 / 1000000000000000000));
end;
function TCryptRandom.Random(Range : Integer): Integer;
begin
Result := Trunc(Random * Range);
end;
end.