Secure way to store password in Windows

Question

I\'m trying to protect a local database that contains sensitive info (similar to this question, only for delphi 2010)

I\'m using DI

Answer 1

If your issue is simply to save the user from having to type a password every time, you should know that Windows already has a password storage system.

If you go to Control Panel -> Credential Manager. From there you are looking for Windows Credentials -> Generic Credentials.

From there you can see that it is the same place that things like Remote Desktop passwords are stored:

The API that exposes this functionality is CredRead, CredWrite, and CredDelete.

I wrapped these up in three functions:

function CredReadGenericCredentials(const Target: UnicodeString; var Username, Password: UnicodeString): Boolean;
function CredWriteGenericCredentials(const Target, Username, Password: UnicodeString): Boolean;
function CredDeleteGenericCredentials(const Target: UnicodeString): Boolean;

The target is the thing to identify the credentails. I usually use the application name.

String target = ExtractFilename(ParamStr(0)); //e.g. 'Contoso.exe'

So then it's simply:

CredWriteGenericCredentials(ExtractFilename(ParamStr(0)), username, password);

You can then see them in the Credential Manager:

When you want to read them back:

CredReadGenericCredentials(ExtractFilename(ParamStr(0)), {var}username, {var}password);

There is the extra piece of UI work where you have to:

• detect that there were no stored credentials, and prompt the user for credentials
• detect that the saved username/password didn't work and prompt for new/correct credentials, try connecting, and save the new correct credentials

Reading stored credentials:

function CredReadGenericCredentials(const Target: UnicodeString; var Username, Password: UnicodeString): Boolean;
var
    credential: PCREDENTIALW;
    le: DWORD;
    s: string;
begin
    Result := False;

    credential := nil;
    if not CredReadW(Target, CRED_TYPE_GENERIC, 0, {var}credential) then
    begin
        le := GetLastError;
        s := 'Could not get "'+Target+'" generic credentials: '+SysErrorMessage(le)+' '+IntToStr(le);
        OutputDebugString(PChar(s));
        Exit;
    end;

    try
        username := Credential.UserName;
        password := WideCharToWideString(PWideChar(Credential.CredentialBlob), Credential.CredentialBlobSize div 2); //By convention blobs that contain strings do not have a trailing NULL.
    finally
        CredFree(Credential);
    end;

    Result := True;
end;

Writing stored credentials:

function CredWriteGenericCredentials(const Target, Username, Password: UnicodeString): Boolean;
var
    persistType: DWORD;
    Credentials: CREDENTIALW;
    le: DWORD;
    s: string;
begin
    ZeroMemory(@Credentials, SizeOf(Credentials));
    Credentials.TargetName := PWideChar(Target); //cannot be longer than CRED_MAX_GENERIC_TARGET_NAME_LENGTH (32767) characters. Recommended format "Company_Target"
    Credentials.Type_ := CRED_TYPE_GENERIC;
    Credentials.UserName := PWideChar(Username);
    Credentials.Persist := CRED_PERSIST_LOCAL_MACHINE;
    Credentials.CredentialBlob := PByte(Password);
    Credentials.CredentialBlobSize := 2*(Length(Password)); //By convention no trailing null. Cannot be longer than CRED_MAX_CREDENTIAL_BLOB_SIZE (512) bytes
    Credentials.UserName := PWideChar(Username);
    Result := CredWriteW(Credentials, 0);
    end;
end;

And then delete:

function CredDeleteGenericCredentials(const Target: UnicodeString): Boolean;
begin
    Result := CredDelete(Target, CRED_TYPE_GENERIC);
end;

CredRead is a wrapper around CryptProtectData

It should be noted that CredWrite/CredRead internally uses CryptProtectData.

• It just also chooses to store the credentials someplace for you
• It also provides a UI for the user to see, manage, and even manually enter and change the saved credentials

The difference by using CryptProtectData yourself is that you're only given a blob. It's up to you to store it somewhere, and retrieve it later.

Here's nice wrappers around CryptProtectData and CryptUnprotectData when storing passwords:

function EncryptString(const Plaintext: UnicodeString; const AdditionalEntropy: UnicodeString): TBytes;
function DecryptString(const Blob: TBytes; const AdditionalEntropy: UnicodeString): UnicodeString;

which is easy enough to use:

procedure TForm1.TestStringEncryption;
var
    encryptedBlob: TBytes;
    plainText: UnicodeString;
const
    Salt = 'Salt doesn''t have to be secret; just different from the next application';
begin
    encryptedBlob := EncryptString('correct battery horse staple', Salt);

    plainText := DecryptString(encryptedBlob, salt);

    if plainText <> 'correct battery horse staple' then
        raise Exception.Create('String encryption self-test failed');
end;

The actual guts are:

type
    DATA_BLOB = record
            cbData: DWORD;
            pbData: PByte;
    end;
    PDATA_BLOB = ^DATA_BLOB;

const
    CRYPTPROTECT_UI_FORBIDDEN = $1;

function CryptProtectData(const DataIn: DATA_BLOB; szDataDescr: PWideChar; OptionalEntropy: PDATA_BLOB; Reserved: Pointer; PromptStruct: Pointer{PCRYPTPROTECT_PROMPTSTRUCT}; dwFlags: DWORD; var DataOut: DATA_BLOB): BOOL; stdcall; external 'Crypt32.dll' name 'CryptProtectData';
function CryptUnprotectData(const DataIn: DATA_BLOB; szDataDescr: PPWideChar; OptionalEntropy: PDATA_BLOB; Reserved: Pointer; PromptStruct: Pointer{PCRYPTPROTECT_PROMPTSTRUCT}; dwFlags: DWORD; var DataOut: DATA_BLOB): Bool; stdcall; external 'Crypt32.dll' name 'CryptUnprotectData';

function EncryptString(const Plaintext: UnicodeString; const AdditionalEntropy: UnicodeString): TBytes;
var
    blobIn: DATA_BLOB;
    blobOut: DATA_BLOB;
    entropyBlob: DATA_BLOB;
    pEntropy: Pointer;
    bRes: Boolean;
begin
    blobIn.pbData := Pointer(PlainText);
    blobIn.cbData := Length(PlainText)*SizeOf(WideChar);

    if AdditionalEntropy <> '' then
    begin
        entropyBlob.pbData := Pointer(AdditionalEntropy);
        entropyBlob.cbData := Length(AdditionalEntropy)*SizeOf(WideChar);
        pEntropy := @entropyBlob;
    end
    else
        pEntropy := nil;

    bRes := CryptProtectData(
            blobIn,
            nil, //data description (PWideChar)
            pentropy, //optional entropy (PDATA_BLOB)
            nil, //reserved
            nil, //prompt struct
            CRYPTPROTECT_UI_FORBIDDEN, //flags
            {var}blobOut);
    if not bRes then
        RaiseLastOSError;

    //Move output blob into resulting TBytes
    SetLength(Result, blobOut.cbData);
    Move(blobOut.pbData^, Result[0], blobOut.cbData);

    // When you have finished using the DATA_BLOB structure, free its pbData member by calling the LocalFree function
    LocalFree(HLOCAL(blobOut.pbData));
end;

And decrypting:

function DecryptString(const blob: TBytes; const AdditionalEntropy: UnicodeString): UnicodeString;
var
    dataIn: DATA_BLOB;
    entropyBlob: DATA_BLOB;
    pentropy: PDATA_BLOB;
    dataOut: DATA_BLOB;
    bRes: BOOL;
begin
    dataIn.pbData := Pointer(blob);
    dataIn.cbData := Length(blob);

    if AdditionalEntropy <> '' then
    begin
        entropyBlob.pbData := Pointer(AdditionalEntropy);
        entropyBlob.cbData := Length(AdditionalEntropy)*SizeOf(WideChar);
        pentropy := @entropyBlob;
    end
    else
        pentropy := nil;

    bRes := CryptUnprotectData(
            DataIn,
            nil, //data description (PWideChar)
            pentropy, //optional entropy (PDATA_BLOB)
            nil, //reserved
            nil, //prompt struct
            CRYPTPROTECT_UI_FORBIDDEN,
            {var}dataOut);
    if not bRes then
        RaiseLastOSError;

    SetLength(Result, dataOut.cbData div 2);
    Move(dataOut.pbData^, Result[1], dataOut.cbData);
    LocalFree(HLOCAL(DataOut.pbData));
end;