Creating a Remote Desktop Plugin Using Delphi - Part 3
In parts 1 and 2 of this series I created a shell for a remote desktop client plugin. The plugin as it stands so far initializes itself with the remote desktop client, responds to a few simple events and displays an “always on top” status window. Still not very useful. Next we need to actually open the virtual channel(s) that we will be using and respond to a few more events so that we can read data from that channel.
To open our virtual channel(s) we need to enhance our VirtualChannelInitEvent handler to open the channel(s) when we receive a connected event. We also need to implement a VirtualChannelOpenEvent handler to respond to channel read and write events.
Since we could, conceivably have multiple virtual channels open simultaneously we need to define a structure to hold pertinent information about each channel and an array of these structures, one for each virtual channel.
TChannelRec = packed record Handle: THandle; InputBuffer: PByte; InputBufferSize: Integer; InputBufferOffset: Integer; end; gChannels: array [0..0] of TChannelRec;
Our modified VirtualChannelInitEvent handler now looks like this:
procedure VirtualChannelInitEvent(pInitHandle: THandle;
event: UINT;
pData: Pointer;
dataLength: UINT); stdcall;
var
e: TChannelEvents;
i: Integer;
procedure OpenChannels;
var
i: Integer;
stat: UINT;
begin
for i := Low(myChannels) to High(myChannels) do
begin
StatusForm.SetStatus(Format('Opening channel %s',
[myChannels[i].name]));
gChannels[i].InputBuffer := nil;
stat := gEntryPoints.pVirtualChannelOpen(pInitHandle,
gchannels[i].Handle,
myChannels[i].name,
VirtualChannelOpenEvent);
if (TChannelReturnCodes(stat) <> crOk) then
StatusForm.SetStatus(Format('Open failed. Status = %d',
[stat]));
end;
end;
begin
e := TChannelEvents(event);
if ((e >= Low(events)) and
(e <= High(events))) then
StatusForm.SetStatus(events[e])
else
StatusForm.SetStatus(Format('Unknown event id = %d',
[event]));
case e of
ceConnected:
begin
StatusForm.SetStatus(Format('Server name = %s length = %d',
[String(PChar(pData)),
dataLength]));
OpenChannels;
end;
ceTerminated:
begin
FreeAndNil(StatusForm);
for i := Low(gChannels) to High(gChannels) do
begin
if (Assigned(gChannels[i].InputBuffer)) then
FreeMem(gChannels[i].InputBuffer);
end;
end;
end;
end;
And our VirtualChannelOpenEvent handler looks like this:
procedure VirtualChannelOpenEvent(openHandle: THandle;
event: UINT;
pData: PByte;
dataLength: UINT32;
totalLength: UINT32;
dataFlags: UINT32); stdcall;
var
e: TChannelEvents;
i: Integer;
begin
e := TChannelEvents(event);
if ((e >= Low(events)) and
(e <= High(events))) then
StatusForm.SetStatus(events[e])
else
StatusForm.SetStatus(Format('Unknown event id = %d',
[event]));
case e of
ceDataReceived:
begin
StatusForm.SetStatus(Format('DataLength = %d TotalLength = %d Flags = %d',
[dataLength, totalLength, dataFlags]));
i := FindChannel(openChannel);
if (i = -1) then
begin
StatusForm.SetStatus('Internal error. Could not find channel record.');
Exit;
end;
if ((dataFlags and CHANNEL_FLAG_FIRST) <> 0) then
begin
if (Assigned(gChannels[i].InputBuffer)) then
FreeMem(gChannels[i].InputBuffer);
GetMem(gChannels[i].InputBuffer, totalLength);
gChannels[i].InputBufferOffset := 0;
gChannels[i].InputBufferSize := totalLength;
StatusForm.SetStatus('Buffer allocated');
end;
if (not Assigned(gChannels[i].InputBuffer)) then
begin
StatusForm.SetStatus('Internal error. No buffer allocated.');
Exit;
end;
if ((gChannels[i].InputBufferOffset + dataLength) <= gChannels[i].InputBufferSize) then
begin
Move(pData^, (gChannels[i].InputBuffer + gChannels[i].InputBufferOffset)^, dataLength);
Inc(gChannels[i].InputBufferOffset, dataLength);
end else
begin
StatusForm.SetStatus('Data received exceeds buffer size');
end;
if ((dataFlags and CHANNEL_FLAG_LAST) <> 0) then
begin
StatusForm.SetStatus('Buffer complete');
ProcessRequest(gChannels[i]);
end;
end;
end;
end;
The source code for the plugin as it stands so far is available here.
December 22nd, 2012 at 8:02 am
This is a very helpful example for writing a Virtual Channel Plug-In in Delphi.
In the begining of 2012 i faced the same problem of finding examples doing this in Delphi. The only example i found was a russian one.
See: http://www.sql.ru/forum/actualthread.aspx?tid=702704.
This example transfers files from the server to the client over Virtual Channel and opens the file with the according application.
I modified this example for our needs but couldn’t get it to work
for 64bit clients.
So i am very glad to find your example.
Greets
Markus
December 26th, 2012 at 3:34 pm
Glad it helped. The link that you provided seems to be dead.
February 9th, 2016 at 8:36 am
I was having problems during receiving messages. I change your code to send some real message:
Server:
- pValue is a string
WTSVirtualChannelWrite(FChannelHandle, PByte(AnsiString(pValue)),
Length(AnsiString(pValue)), vBytesWritten);
Client:
- s: string
s := String(PAnsiChar(gChannels[i].InputBuffer));
StatusForm.SetStatus(s);
But when i send message diferents i see dirty strings then i change processrequest method
procedure ProcessRequest(var channel: TChannelRec);
begin
ZeroMemory(channel.InputBuffer, channel.InputBufferSize);