Ask user and send the Response back in a Message-Receiver

Question

I want to ask the user to input a password. As the password is sometimes needed in a different thread than the main thread where VCL runs, I tried to send a Message to the main window and ask for the password. Then the main window asks the user.

How I ask the user:

procedure TMainForm.WMGetPassword(var Msg: TMessage);
var
  Password: String;
begin
  if QueryPassword(Password) then // function QueryPassword(out Password: String): boolean;
  begin
    Password := Password + #0; // Add #0-Terminator
    Move(Password[1], Msg.wParam, Length(Password) * sizeOf(Char)); // Copy the String in my buffer
    Msg.Result := 1;
  end
  else
  begin
    Msg.Result := 0;
  end;
end;

How I ask the main window:

var
  PasswordBuffer: PChar;
  Password: String;
begin
  PasswordBuffer := AllocMem(100 * sizeof(Char));
  PasswordResult := SendMessage(MainFormHWND, WM_GetPassword, Integer(PasswordBuffer), 0);
  Result := (PasswordResult <> -1);
  if not Result then
    Exit;

  SetString(Password, PasswordBuffer, 100);
  ShowMessage(Password);
end;

But Password and PasswordBuffer are empty afterwards. What am I doing wrong?

Answer 1

As long as the thread is in the same process (so it shares the same address space) your code should work. It is however needlessly complicated and has a memory leak (PasswordBuffer is never freed).

You can use a string variable in the thread and pass an address to its internal preallocated buffer to the main thread:

type
  TTestThread = class(TThread)
  private
    fHwnd: HWND;
  protected
    procedure Execute; override;
  public
    constructor Create(AWnd: HWND);
  end;

constructor TTestThread.Create(AWnd: HWND);
begin
  fHwnd := AWnd;
  inherited Create(False);
end;

procedure TTestThread.Execute;
const
  MAXLEN = 1024;
var
  s: string;
begin
  SetLength(s, MAXLEN);
  if SendMessage(fHwnd, WM_GETPASSWORD, MAXLEN, LPARAM(@s[1])) > 0 then begin
    s := PChar(s);
    // don't use VCL here
    Windows.MessageBox(0, PChar('password is "' + s + '"'), 'password',
      MB_ICONINFORMATION or MB_OK);
  end;
end;

In the main thread the password is put into the buffer, length-limited to the buffer size:

procedure TForm1.WMGetPassword(var AMsg: TMessage);
var
  Pwd: string;
begin
  if InputQuery('Password Entry', 'Please enter the password:', Pwd)
    and (Pwd <> '')
  then begin
    StrPLCopy(PChar(AMsg.LParam), Pwd, AMsg.WParam);
    AMsg.Result := 1;
  end else
    AMsg.Result := -1;
end;

Answer 2

Since you are passing Msg.wParam in as the second parameter, it is writing your string to that location, and not the location you are trying to point to. It will be overwriting the values stored in Msg.wParam, Msg.lParam, Msg.Result + probably some other information on the stack too.

Instead of:

Move(Password[1], Msg.wParam, Length(Password) * sizeOf(Char));

You should be using:

Move(Password[1], PChar(Msg.wParam)^, Length(Password) * sizeOf(Char));

or use MoveMemory if you want to use pointers.

Answer 3

@Dan got it right, plus @mghie spotted the leak.

Here is an alternative way which does not involve pointers:

type
  TMyMessage = class
    msg: string;
  end;

procedure TMainForm.WMGetPassword(var Msg: TMessage);
var
  SMessage: TMyMessage;
  Password: string;
begin
  if QueryPassword(Password) then 
  begin
    SMessage := TMyMessage(msg.WParam);
    SMessage.msg := Password;
    msg.Result := 1;
  end
  else
  begin
    Msg.Result := 0;
  end;
end;


var
  MyMsg: TMyMessage;
begin
  MyMsg := TMyMessage.Create('');
  try
    PasswordResult := SendMessage(FormHandleHWND,WM_GetPassword,WPARAM(MyMsg),0);
    Result := (PasswordResult <> -1);
    if Result
      then Password := MyMsg.msg;
  finally
    MyMsg.Free;
  end;
end;