Windows Credential Storage

unit uwincred;

// Original Source https://stackoverflow.com/questions/13145112/secure-way-to-store-password-in-windows
// adapted for Free Pascal

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, windows, JwaWinCred;

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

implementation

function WideCharToWideString(s: PWideChar; UnicodeCharCount: SizeInt): UnicodeString;
begin
  SetLength(Result{%H-}, UnicodeCharCount);
  strmove(PWideChar(Result), s, UnicodeCharCount);
end;

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

    credential := nil;
    if not CredReadW(PWideChar(Target), CRED_TYPE_GENERIC, 0, {var}credential) then
    begin
        le := GetLastError;
        s := 'Could not get "'+Target+'" generic credentials: '+SysErrorMessage(le)+' '+IntToStr(le);
        OutputDebugStringW(PWideChar(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;

function CredWriteGenericCredentials(const Target, Username, Password: UnicodeString): Boolean;
var
    Credentials: CREDENTIALW;
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;

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

end.

var
  StoredUserName, StoredPassword: UnicodeString;
begin
  StoredUserName := '';
  StoredPassword := '';
  CredReadGenericCredentials(Application.ExeName, StoredUserName, StoredPassword);
  CredWriteGenericCredentials(Application.ExeName, StoredUserName, StoredPassword);  
  CredDeleteGenericCredentials(Application.ExeName);
end;