#1  
Old 18th February 2019, 10:13 AM
Sue King
 
Posts: n/a
Default Client to Client Remoting with gnugettext (again)

I think this is what is happening.

Normally when the Client to Client messaging demo is run, the connect
button makes the client to client component active. The disconnect
button closes the Winsock transport, which automatically closes the
client to client messaging component.

When gnugettext.pas is included in the dpr file, the demo goes into an
infinite loop trying to close the call back threads. There seems to be
an exception raised in the thread that results in the thread never
terminating.

In an attempt to narrow the problem down, I've taken a very small
amount of code from gnugettext.pas that is responsible for hooking into
LoadResStringW and added it to the demo. This is enough to cause the
call back threads to fail to terminate.

The cut down custom version of custom version of LoadResStringW is

function LoadResStringW(ResStringRec: PResStringRec): UnicodeString;
var
lUTF8String;: RawUTF8String;
szMsgId: UnicodeString;
begin
szMsgId := GetResString(ResStringRec);
lUTF8String := utf8Encode(szMsgId);
lResult := szMsgId;
// this line triggers the error
lResult := UTF8Decode(lUTF8String);
Result := lResult;
end;

If anyone has any ideas, or would be interested to have a look at the
project, the test .pas file is below.

There are no change to the .dfm. It is based on
examples\delphi\remoting\client to client messaging\Project1.dpr.

As it stands, I cannot use the client to client messaging in any
project that uses gnugettext.pas with hooking. I'll use the unit
without hooking if a solution isn't found.

I'm interested in any comments - as much to learn about what is going
on as to fix it.

TIA

Sue


unit Unit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, nxdb, nxllTransport,
nxptBasePooledTransport, nxtwWinsockTransport, nxllComponent,
nxsdServerEngine, nxreRemoteServerEngine, nxpvPlatformImplementation,
nxmrClient, nxmrTypes,
Vcl.StdCtrls, {$IFDEF CPUX86}Vcl.OleAuto, {$ELSE}System.Win.ComObj,
{$ENDIF}nxrmAllDefaults;

type
{.$IFDEF CPUX86}
TTestAutoObject = class(TAutoObject)
automated
procedure SetCaption(aCaption: OleVariant);
end;
{.$ENDIF}

TForm1 = class(TForm)
nxRemoteServerEngine1: TnxRemoteServerEngine;
nxWinsockTransport1: TnxWinsockTransport;
nxSession1: TnxSession;
chxProm: TCheckBox;
edClientDescription: TEdit;
btnConnect: TButton;
edMessage: TEdit;
btnSend: TButton;
Memo1: TMemo;
btnBroadcast: TButton;
btnGetClients: TButton;
cbClients: TComboBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
btnDisconnect: TButton;
btnSendIntf: TButton;
btnBytes: TButton;
procedure FormCreate(Sender: TObject);
procedure btnConnectClick(Sender: TObject);
procedure btnSendClick(Sender: TObject);
procedure btnBroadcastClick(Sender: TObject);
procedure btnGetClientsClick(Sender: TObject);
procedure btnDisconnectClick(Sender: TObject);
procedure btnSendIntfClick(Sender: TObject);
procedure btnBytesClick(Sender: TObject);
private
MessageRelayClient: TnxMessageRelayClient;
AutoObject: Variant;
public
procedure MessageReceived(aSender: TnxMessageRelayClient;
aMessage: TnxReceivedMessage);
end;

TCharArray5 = array[0..4] of ansichar;
THook = // Replaces a runtime library procedure with a custom
procedure
class
public
constructor Create(OldProcedure, NewProcedure: pointer; FollowJump:
boolean
= false);
destructor Destroy; override; // Restores unhooked state
procedure Reset(FollowJump: boolean = false);
// Disables and picks up patch points again
procedure Disable;
procedure Enable;
private
oldproc, newproc: Pointer;
Patch: TCharArray5;
Original: TCharArray5;
PatchPosition: PAnsiChar;
procedure Shutdown; // Same as destroy, except that object is not
destroyed
end;

var
Form1: TForm1;
HookLoadResString: THook;

implementation

{$R *.dfm}

uses
nxllTypes;

type
RawUtf8String = RawByteString;
MsgIdString = UnicodeString;

function GetResString(ResStringRec: PResStringRec): UnicodeString;

var
Len: Integer;
Buffer: array[0..1023] of char;
begin
if ResStringRec = nil then
exit;
if ResStringRec.Identifier >= 64 * 1024 then
begin
{$IFDEF DXGETTEXTDEBUG}
DebugWriteln('LoadResString was given an invalid
ResStringRec.Identifier');
{$ENDIF}
Result := 'ERROR';
exit;
end;
// if not Win32PlatformIsUnicode then
// begin
// SetString(Result, Buffer,
// LoadString(FindResourceHInstance(ResStringRec.Modu le^),
// ResStringRec.Identifier, Buffer, Length(Buffer)))
// end
// else
begin
Result := '';
Len := 0;
while Length(Result) <= Len + 1 do
begin
if Length(Result) = 0 then
SetLength(Result, 1024)
else
SetLength(Result, Length(Result) * 2);
Len := LoadStringW(FindResourceHInstance(ResStringRec.Mod ule^),
ResStringRec.Identifier, PWideChar(Result), Length(Result));
end;
SetLength(Result, Len);
end;
{$IFDEF DXGETTEXTDEBUG}
DebugWriteln('Loaded resourcestring: ' + string(utf8encode(Result)));
{$ENDIF}
end;

function Utf8Decode2(const S: RawByteString): WideString;
var
L: Integer;
Temp: WideString;
begin
Result := '';
if S = '' then Exit;
L := Length(S);
SetLength(Temp, L);

L := Utf8ToUnicode(PWideChar(Temp), L + 1, PAnsiChar(S), L);
if L > 0 then
SetLength(Temp, L - 1)
else
Temp := '';
Result := Temp;
end;


function LoadResStringW(ResStringRec: PResStringRec): UnicodeString;
var
lResult: UnicodeString;
lUTF8String: RawUtf8String;
szMsgId: Unicodestring;
begin
szMsgId := GetResString(ResStringRec);
lUTF8String := utf8encode(szMsgId);
lResult := szMsgId;
// OutputDebugStringA(PAnsiChar(lUTF8String));

// commenting out this line stops the error occuring
lResult := UTF8Decode2(lUTF8String);

// OutputDebugStringW(PWideChar(Result));
Result := lResult;

end;

procedure TForm1.btnBroadcastClick(Sender: TObject);
begin
MessageRelayClient.BroadcastMessage(nxMsgIDNone, edMessage.Text, nil,
nil);
end;

procedure TForm1.btnBytesClick(Sender: TObject);
var
TheBytes: TnxBytes;
b: Byte;
s: string;
ID: TGuid;
begin
s := cbClients.Text;
s := Copy(s, Length(s) - 37, 38);
ID := StringToGUID(s);

SetLength(TheBytes, 100);
for b := Low(TheBytes) to High(TheBytes) do
TheBytes[b] := b;

MessageRelayClient.SendMessage(ID, nxMsgIDNone, '', TheBytes, nil);
end;

procedure TForm1.btnConnectClick(Sender: TObject);
begin
Memo1.Clear;
MessageRelayClient.Active := False;
MessageRelayClient.Description := edClientDescription.Text;
MessageRelayClient.Promiscuous := chxProm.Checked;
MessageRelayClient.OnMessageReceived := MessageReceived;
MessageRelayClient.Active := True;
OutputDebugStringW(PWideChar('active ' +
BoolToStr(MessageRelayClient.Active,
True)));
end;

procedure TForm1.btnGetClientsClick(Sender: TObject);
var
Clients: InxMessageRelayClientList;
i: Integer;
begin
Clients := MessageRelayClient.Clients;
with cbClients.Items, Clients do
begin
BeginUpdate;
try
Clear;
for i := 0 to Pred(ClientCount) do
Add(ClientDescription[i] + ' ' + GUIDToString(ClientID[i]));
finally
EndUpdate;
end;
end;
end;

procedure TForm1.btnSendClick(Sender: TObject);
var
s: string;
ID: TGuid;
begin
s := cbClients.Text;
s := Copy(s, Length(s) - 37, 38);
ID := StringToGUID(s);
MessageRelayClient.SendMessage(ID, nxMsgIDNone, edMessage.Text, nil,
nil);
end;

procedure TForm1.btnDisconnectClick(Sender: TObject);
begin
nxWinsockTransport1.Active := False;
// MessageRelayClient.Active := False;
OutputDebugStringW(PWideChar('winsock active ' +
BoolToStr(nxWinsockTransport1.Active, True)));
end;

procedure TForm1.btnSendIntfClick(Sender: TObject);
var
s: string;
ID: TGuid;
Dispatch: IDispatch;
begin
s := cbClients.Text;
s := Copy(s, Length(s) - 37, 38);
ID := StringToGUID(s);
Dispatch := AutoObject;
MessageRelayClient.SendMessage(ID, nxMsgIDNone, edMessage.Text, nil,
Dispatch);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
MessageRelayClient := TnxMessageRelayClient.Create(Self);
MessageRelayClient.Session := nxSession1;
{.$IFDEF CPUX86}
// AutoObject := TTestAutoObject.Create;//..OleObject;
{.$ENDIF}
end;

procedure TForm1.MessageReceived(aSender: TnxMessageRelayClient;
aMessage: TnxReceivedMessage);
var
Dispatch: IDispatch;
v: OleVariant;
b: Byte;
s: string;
begin
if aMessage.rmMsg <> '' then
Memo1.Lines.Add(aMessage.rmMsg)
else
begin
Memo1.Lines.Add('Bytes received, length: ' +
IntToStr(Length(aMessage.rmData)));
s := '';
for b := Low(aMessage.rmData) to High(aMessage.rmData) do
s := s + IntToStr(aMessage.rmData[b]) + ', ';
Memo1.Lines.Add(s);
end;

if Supports(aMessage.rmIntf, IDispatch, Dispatch) then
begin
v := Dispatch;
v.SetCaption(edClientDescription.Text);
end;
end;

{.$IFDEF CPUX86}
{ TTestAutoObject }

{ Messaging methods run in whatever thread the transport returns them
on,
do not update the GUI directly from these methods!
}

procedure TTestAutoObject.SetCaption(aCaption: OleVariant);
begin
TThread.Synchronize(nil,
procedure
var
TempCaption: string;
begin
TempCaption := aCaption;
Form1.Caption := TempCaption;
end);
end;
{.$ENDIF}

{ THook }

constructor THook.Create(OldProcedure, NewProcedure: pointer;
FollowJump: boolean);
begin
{$IFNDEF CPU386}
{$IFNDEF CPUx64}
raise
Exception.Create('This procedure only works on Intel i386 or x64
compatible processors.');
{$ENDIF}
{$ENDIF}

oldproc := OldProcedure;
newproc := NewProcedure;

Reset(FollowJump);

end;

destructor THook.Destroy;
begin
Shutdown;

inherited;
end;

procedure THook.Disable;
begin
Assert(PatchPosition <> nil,
'Patch position in THook was nil when Disable was called');
PatchPosition[0] := Original[0];
PatchPosition[1] := Original[1];
PatchPosition[2] := Original[2];
PatchPosition[3] := Original[3];
PatchPosition[4] := Original[4];

end;

procedure THook.Enable;
begin
Assert(PatchPosition <> nil,
'Patch position in THook was nil when Enable was called');
PatchPosition[0] := Patch[0];
PatchPosition[1] := Patch[1];
PatchPosition[2] := Patch[2];
PatchPosition[3] := Patch[3];
PatchPosition[4] := Patch[4];

end;

procedure THook.Reset(FollowJump: boolean);
var
offset: integer;
ov: cardinal;
begin
if PatchPosition <> nil then
Shutdown;

patchPosition := OldProc;
if FollowJump and (Word(OldProc^) = $25FF) then
begin
// This finds the correct procedure if a virtual jump has been
inserted
// at the procedure address
Inc(patchPosition, 2); // skip the jump
{$IFDEF CPUX64}
patchPosition := pansiChar(Pointer(patchPosition + 4 +
PInteger(patchPosition)^)^);
{$ELSE}
patchPosition := pansiChar(Pointer(pointer(patchPosition)^)^);
{$ENDIF CPUX64}
end;
offset := pansiChar(NewProc) - pansiChar(pointer(patchPosition)) - 5;

Patch[0] := ansichar($E9);
Patch[1] := ansichar(offset and 255);
Patch[2] := ansichar((offset shr 8) and 255);
Patch[3] := ansichar((offset shr 16) and 255);
Patch[4] := ansichar((offset shr 24) and 255);

Original[0] := PatchPosition[0];
Original[1] := PatchPosition[1];
Original[2] := PatchPosition[2];
Original[3] := PatchPosition[3];
Original[4] := PatchPosition[4];

if not VirtualProtect(Pointer(PatchPosition), 5,
PAGE_EXECUTE_READWRITE, @ov)
then
RaiseLastOSError;

end;

procedure THook.Shutdown;
begin
Disable;
PatchPosition := nil;

end;

procedure HookIntoResourceStrings(enabled: boolean = true;
SupportPackages:
boolean = false);
begin
HookLoadResString.Reset(SupportPackages);
if enabled then
begin
HookLoadResString.Enable;
end;
end;

var
param0:string;

initialization
HookLoadResString := THook.Create(@system.LoadResString,
@LoadResStringW);
param0:=lowercase(extractfilename(paramstr(0)));
if (param0<>'delphi32.exe') and (param0<>'kylix') and
(param0<>'bds.exe') then
begin
//HookIntoResourceStrings (true,false);
HookLoadResString.Reset(false);
HookLoadResString.Enable;
end;

finalization
FreeAndNil (HookLoadResString);

end.
  #2  
Old 11th March 2019, 10:12 AM
Sue King
 
Posts: n/a
Default Re: Client to Client Remoting with gnugettext (again)

It looks like we have worked out what is happening to generate this
error.

I've been asked if I can provide a minimal demo which can be run with
the trial dcus.

The test program I'm using is the Remoting Client to client example,
with a minor change. Would someone who has the trial dcu edition be
able to recompile this project ?

Sue


Sue King wrote:

> I think this is what is happening.
>
> Normally when the Client to Client messaging demo is run, the connect
> button makes the client to client component active. The disconnect
> button closes the Winsock transport, which automatically closes the
> client to client messaging component.
>
> When gnugettext.pas is included in the dpr file, the demo goes into an
> infinite loop trying to close the call back threads. There seems to
> be an exception raised in the thread that results in the thread never
> terminating.
>
> In an attempt to narrow the problem down, I've taken a very small
> amount of code from gnugettext.pas that is responsible for hooking
> into LoadResStringW and added it to the demo. This is enough to
> cause the call back threads to fail to terminate.
>
> The cut down custom version of custom version of LoadResStringW is
>
> function LoadResStringW(ResStringRec: PResStringRec): UnicodeString;
> var
> lUTF8String;: RawUTF8String;
> szMsgId: UnicodeString;
> begin
> szMsgId := GetResString(ResStringRec);
> lUTF8String := utf8Encode(szMsgId);
> lResult := szMsgId;
> // this line triggers the error
> lResult := UTF8Decode(lUTF8String);
> Result := lResult;
> end;
>
> If anyone has any ideas, or would be interested to have a look at the
> project, the test .pas file is below.
>
> There are no change to the .dfm. It is based on
> examples\delphi\remoting\client to client messaging\Project1.dpr.
>
> As it stands, I cannot use the client to client messaging in any
> project that uses gnugettext.pas with hooking. I'll use the unit
> without hooking if a solution isn't found.
>
> I'm interested in any comments - as much to learn about what is going
> on as to fix it.
>
> TIA
>
> Sue
>
>
> unit Unit1;
>
> interface
>
> uses
> Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
> System.Classes, Vcl.Graphics,
> Vcl.Controls, Vcl.Forms, Vcl.Dialogs, nxdb, nxllTransport,
> nxptBasePooledTransport, nxtwWinsockTransport, nxllComponent,
> nxsdServerEngine, nxreRemoteServerEngine,
> nxpvPlatformImplementation, nxmrClient, nxmrTypes,
> Vcl.StdCtrls, {$IFDEF CPUX86}Vcl.OleAuto, {$ELSE}System.Win.ComObj,
> {$ENDIF}nxrmAllDefaults;
>
> type
> {.$IFDEF CPUX86}
> TTestAutoObject = class(TAutoObject)
> automated
> procedure SetCaption(aCaption: OleVariant);
> end;
> {.$ENDIF}
>
> TForm1 = class(TForm)
> nxRemoteServerEngine1: TnxRemoteServerEngine;
> nxWinsockTransport1: TnxWinsockTransport;
> nxSession1: TnxSession;
> chxProm: TCheckBox;
> edClientDescription: TEdit;
> btnConnect: TButton;
> edMessage: TEdit;
> btnSend: TButton;
> Memo1: TMemo;
> btnBroadcast: TButton;
> btnGetClients: TButton;
> cbClients: TComboBox;
> Label1: TLabel;
> Label2: TLabel;
> Label3: TLabel;
> Label4: TLabel;
> btnDisconnect: TButton;
> btnSendIntf: TButton;
> btnBytes: TButton;
> procedure FormCreate(Sender: TObject);
> procedure btnConnectClick(Sender: TObject);
> procedure btnSendClick(Sender: TObject);
> procedure btnBroadcastClick(Sender: TObject);
> procedure btnGetClientsClick(Sender: TObject);
> procedure btnDisconnectClick(Sender: TObject);
> procedure btnSendIntfClick(Sender: TObject);
> procedure btnBytesClick(Sender: TObject);
> private
> MessageRelayClient: TnxMessageRelayClient;
> AutoObject: Variant;
> public
> procedure MessageReceived(aSender: TnxMessageRelayClient;
> aMessage: TnxReceivedMessage);
> end;
>
> TCharArray5 = array[0..4] of ansichar;
> THook = // Replaces a runtime library procedure with a custom
> procedure
> class
> public
> constructor Create(OldProcedure, NewProcedure: pointer;
> FollowJump: boolean
> = false);
> destructor Destroy; override; // Restores unhooked state
> procedure Reset(FollowJump: boolean = false);
> // Disables and picks up patch points again
> procedure Disable;
> procedure Enable;
> private
> oldproc, newproc: Pointer;
> Patch: TCharArray5;
> Original: TCharArray5;
> PatchPosition: PAnsiChar;
> procedure Shutdown; // Same as destroy, except that object is not
> destroyed
> end;
>
> var
> Form1: TForm1;
> HookLoadResString: THook;
>
> implementation
>
> {$R *.dfm}
>
> uses
> nxllTypes;
>
> type
> RawUtf8String = RawByteString;
> MsgIdString = UnicodeString;
>
> function GetResString(ResStringRec: PResStringRec): UnicodeString;
>
> var
> Len: Integer;
> Buffer: array[0..1023] of char;
> begin
> if ResStringRec = nil then
> exit;
> if ResStringRec.Identifier >= 64 * 1024 then
> begin
> {$IFDEF DXGETTEXTDEBUG}
> DebugWriteln('LoadResString was given an invalid
> ResStringRec.Identifier');
> {$ENDIF}
> Result := 'ERROR';
> exit;
> end;
> // if not Win32PlatformIsUnicode then
> // begin
> // SetString(Result, Buffer,
> // LoadString(FindResourceHInstance(ResStringRec.Modu le^),
> // ResStringRec.Identifier, Buffer, Length(Buffer)))
> // end
> // else
> begin
> Result := '';
> Len := 0;
> while Length(Result) <= Len + 1 do
> begin
> if Length(Result) = 0 then
> SetLength(Result, 1024)
> else
> SetLength(Result, Length(Result) * 2);
> Len := LoadStringW(FindResourceHInstance(ResStringRec.Mod ule^),
> ResStringRec.Identifier, PWideChar(Result), Length(Result));
> end;
> SetLength(Result, Len);
> end;
> {$IFDEF DXGETTEXTDEBUG}
> DebugWriteln('Loaded resourcestring: ' +
> string(utf8encode(Result))); {$ENDIF}
> end;
>
> function Utf8Decode2(const S: RawByteString): WideString;
> var
> L: Integer;
> Temp: WideString;
> begin
> Result := '';
> if S = '' then Exit;
> L := Length(S);
> SetLength(Temp, L);
>
> L := Utf8ToUnicode(PWideChar(Temp), L + 1, PAnsiChar(S), L);
> if L > 0 then
> SetLength(Temp, L - 1)
> else
> Temp := '';
> Result := Temp;
> end;
>
>
> function LoadResStringW(ResStringRec: PResStringRec): UnicodeString;
> var
> lResult: UnicodeString;
> lUTF8String: RawUtf8String;
> szMsgId: Unicodestring;
> begin
> szMsgId := GetResString(ResStringRec);
> lUTF8String := utf8encode(szMsgId);
> lResult := szMsgId;
> // OutputDebugStringA(PAnsiChar(lUTF8String));
>
> // commenting out this line stops the error occuring
> lResult := UTF8Decode2(lUTF8String);
>
> // OutputDebugStringW(PWideChar(Result));
> Result := lResult;
>
> end;
>
> procedure TForm1.btnBroadcastClick(Sender: TObject);
> begin
> MessageRelayClient.BroadcastMessage(nxMsgIDNone, edMessage.Text,
> nil, nil);
> end;
>
> procedure TForm1.btnBytesClick(Sender: TObject);
> var
> TheBytes: TnxBytes;
> b: Byte;
> s: string;
> ID: TGuid;
> begin
> s := cbClients.Text;
> s := Copy(s, Length(s) - 37, 38);
> ID := StringToGUID(s);
>
> SetLength(TheBytes, 100);
> for b := Low(TheBytes) to High(TheBytes) do
> TheBytes[b] := b;
>
> MessageRelayClient.SendMessage(ID, nxMsgIDNone, '', TheBytes, nil);
> end;
>
> procedure TForm1.btnConnectClick(Sender: TObject);
> begin
> Memo1.Clear;
> MessageRelayClient.Active := False;
> MessageRelayClient.Description := edClientDescription.Text;
> MessageRelayClient.Promiscuous := chxProm.Checked;
> MessageRelayClient.OnMessageReceived := MessageReceived;
> MessageRelayClient.Active := True;
> OutputDebugStringW(PWideChar('active ' +
> BoolToStr(MessageRelayClient.Active,
> True)));
> end;
>
> procedure TForm1.btnGetClientsClick(Sender: TObject);
> var
> Clients: InxMessageRelayClientList;
> i: Integer;
> begin
> Clients := MessageRelayClient.Clients;
> with cbClients.Items, Clients do
> begin
> BeginUpdate;
> try
> Clear;
> for i := 0 to Pred(ClientCount) do
> Add(ClientDescription[i] + ' ' + GUIDToString(ClientID[i]));
> finally
> EndUpdate;
> end;
> end;
> end;
>
> procedure TForm1.btnSendClick(Sender: TObject);
> var
> s: string;
> ID: TGuid;
> begin
> s := cbClients.Text;
> s := Copy(s, Length(s) - 37, 38);
> ID := StringToGUID(s);
> MessageRelayClient.SendMessage(ID, nxMsgIDNone, edMessage.Text, nil,
> nil);
> end;
>
> procedure TForm1.btnDisconnectClick(Sender: TObject);
> begin
> nxWinsockTransport1.Active := False;
> // MessageRelayClient.Active := False;
> OutputDebugStringW(PWideChar('winsock active ' +
> BoolToStr(nxWinsockTransport1.Active, True)));
> end;
>
> procedure TForm1.btnSendIntfClick(Sender: TObject);
> var
> s: string;
> ID: TGuid;
> Dispatch: IDispatch;
> begin
> s := cbClients.Text;
> s := Copy(s, Length(s) - 37, 38);
> ID := StringToGUID(s);
> Dispatch := AutoObject;
> MessageRelayClient.SendMessage(ID, nxMsgIDNone, edMessage.Text, nil,
> Dispatch);
> end;
>
> procedure TForm1.FormCreate(Sender: TObject);
> begin
> MessageRelayClient := TnxMessageRelayClient.Create(Self);
> MessageRelayClient.Session := nxSession1;
> {.$IFDEF CPUX86}
> // AutoObject := TTestAutoObject.Create;//..OleObject;
> {.$ENDIF}
> end;
>
> procedure TForm1.MessageReceived(aSender: TnxMessageRelayClient;
> aMessage: TnxReceivedMessage);
> var
> Dispatch: IDispatch;
> v: OleVariant;
> b: Byte;
> s: string;
> begin
> if aMessage.rmMsg <> '' then
> Memo1.Lines.Add(aMessage.rmMsg)
> else
> begin
> Memo1.Lines.Add('Bytes received, length: ' +
> IntToStr(Length(aMessage.rmData)));
> s := '';
> for b := Low(aMessage.rmData) to High(aMessage.rmData) do
> s := s + IntToStr(aMessage.rmData[b]) + ', ';
> Memo1.Lines.Add(s);
> end;
>
> if Supports(aMessage.rmIntf, IDispatch, Dispatch) then
> begin
> v := Dispatch;
> v.SetCaption(edClientDescription.Text);
> end;
> end;
>
> {.$IFDEF CPUX86}
> { TTestAutoObject }
>
> { Messaging methods run in whatever thread the transport returns them
> on,
> do not update the GUI directly from these methods!
> }
>
> procedure TTestAutoObject.SetCaption(aCaption: OleVariant);
> begin
> TThread.Synchronize(nil,
> procedure
> var
> TempCaption: string;
> begin
> TempCaption := aCaption;
> Form1.Caption := TempCaption;
> end);
> end;
> {.$ENDIF}
>
> { THook }
>
> constructor THook.Create(OldProcedure, NewProcedure: pointer;
> FollowJump: boolean);
> begin
> {$IFNDEF CPU386}
> {$IFNDEF CPUx64}
> raise
> Exception.Create('This procedure only works on Intel i386 or x64
> compatible processors.');
> {$ENDIF}
> {$ENDIF}
>
> oldproc := OldProcedure;
> newproc := NewProcedure;
>
> Reset(FollowJump);
>
> end;
>
> destructor THook.Destroy;
> begin
> Shutdown;
>
> inherited;
> end;
>
> procedure THook.Disable;
> begin
> Assert(PatchPosition <> nil,
> 'Patch position in THook was nil when Disable was called');
> PatchPosition[0] := Original[0];
> PatchPosition[1] := Original[1];
> PatchPosition[2] := Original[2];
> PatchPosition[3] := Original[3];
> PatchPosition[4] := Original[4];
>
> end;
>
> procedure THook.Enable;
> begin
> Assert(PatchPosition <> nil,
> 'Patch position in THook was nil when Enable was called');
> PatchPosition[0] := Patch[0];
> PatchPosition[1] := Patch[1];
> PatchPosition[2] := Patch[2];
> PatchPosition[3] := Patch[3];
> PatchPosition[4] := Patch[4];
>
> end;
>
> procedure THook.Reset(FollowJump: boolean);
> var
> offset: integer;
> ov: cardinal;
> begin
> if PatchPosition <> nil then
> Shutdown;
>
> patchPosition := OldProc;
> if FollowJump and (Word(OldProc^) = $25FF) then
> begin
> // This finds the correct procedure if a virtual jump has been
> inserted
> // at the procedure address
> Inc(patchPosition, 2); // skip the jump
> {$IFDEF CPUX64}
> patchPosition := pansiChar(Pointer(patchPosition + 4 +
> PInteger(patchPosition)^)^);
> {$ELSE}
> patchPosition := pansiChar(Pointer(pointer(patchPosition)^)^);
> {$ENDIF CPUX64}
> end;
> offset := pansiChar(NewProc) - pansiChar(pointer(patchPosition)) -
> 5;
>
> Patch[0] := ansichar($E9);
> Patch[1] := ansichar(offset and 255);
> Patch[2] := ansichar((offset shr 8) and 255);
> Patch[3] := ansichar((offset shr 16) and 255);
> Patch[4] := ansichar((offset shr 24) and 255);
>
> Original[0] := PatchPosition[0];
> Original[1] := PatchPosition[1];
> Original[2] := PatchPosition[2];
> Original[3] := PatchPosition[3];
> Original[4] := PatchPosition[4];
>
> if not VirtualProtect(Pointer(PatchPosition), 5,
> PAGE_EXECUTE_READWRITE, @ov)
> then
> RaiseLastOSError;
>
> end;
>
> procedure THook.Shutdown;
> begin
> Disable;
> PatchPosition := nil;
>
> end;
>
> procedure HookIntoResourceStrings(enabled: boolean = true;
> SupportPackages:
> boolean = false);
> begin
> HookLoadResString.Reset(SupportPackages);
> if enabled then
> begin
> HookLoadResString.Enable;
> end;
> end;
>
> var
> param0:string;
>
> initialization
> HookLoadResString := THook.Create(@system.LoadResString,
> @LoadResStringW);
> param0:=lowercase(extractfilename(paramstr(0)));
> if (param0<>'delphi32.exe') and (param0<>'kylix') and
> (param0<>'bds.exe') then
> begin
> //HookIntoResourceStrings (true,false);
> HookLoadResString.Reset(false);
> HookLoadResString.Enable;
> end;
>
> finalization
> FreeAndNil (HookLoadResString);
>
> end.


  #3  
Old 11th March 2019, 02:30 PM
Eivind Bakkestuen [NDD]
 
Posts: n/a
Default Re: Client to Client Remoting with gnugettext (again)

> The test program I'm using is the Remoting Client to client example,
> with a minor change. Would someone who has the trial dcu edition be
> able to recompile this project ?


Probably, although I'd have to test to make sure. Install the trial in
a temporal VM?

--
Eivind Bakkestuen [NDD]
  #4  
Old 12th March 2019, 05:46 AM
Sue King
 
Posts: n/a
Default Re: Client to Client Remoting with gnugettext (again)

It looks like they are happy to accept me running my test, along with
the normal test suite, as confirmation that the fix works.

FYI the related to UTF8 string conversion.

I'm not sure of the intricacies of why the error occurred, but it was
fixed by changing a call to convert a UTF8 string to a unicode string
from the version that returned a widestring to a version that returned
a UnicodeString.

The statement was written in a version of Delphi before UnicodeStrings
were added.

Why it interferred with closing the call back threads in remoting I
don't know.

Sue

Eivind Bakkestuen [NDD] wrote:

> > The test program I'm using is the Remoting Client to client example,
> > with a minor change. Would someone who has the trial dcu edition be
> > able to recompile this project ?

>
> Probably, although I'd have to test to make sure. Install the trial in
> a temporal VM?


  #5  
Old 12th March 2019, 10:27 PM
Franz-Leo Chomse [NDX]
 
Posts: n/a
Default Re: Client to Client Remoting with gnugettext (again)


>The statement was written in a version of Delphi before UnicodeStrings
>were added.
>


Unicodestrings are handled by the Delphi Memory Manager, Widestrings
are handled by Windows. Thus the probability for sideeffects is
higher.

Regards from Germany

Franz-Leo
Regards from Germany

Franz-Leo Chomse [NexusDB Expert]
franz.leo.chomse@ndx.nexusdb_x.com (please remove "_x" to reply)


Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

vB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Client to Client Remoting Andreas Schachtner nexusdb.public.remoting 2 9th April 2017 04:01 PM
Client to Client messaging Sue King nexusdb.public.support 10 25th October 2013 10:00 AM
Client to Client messaging Sue King nexusdb.public.support 1 15th October 2013 11:48 AM
Remoting client not in a visible component Sue King nexusdb.public.remoting 3 27th January 2012 07:16 AM
Client ID Lee Mc Cauley nexusdb.public.support 1 8th October 2003 02:08 AM


All times are GMT +11. The time now is 12:01 AM.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.