Assigning resourcestring directly to a WideString

[FL]

I've implemented proof-of-concept sample code that allows the assignment
of
resourcestring directly to a WideString without Unicode->Ansi->Unicode
conversion, with the help of UTF-8.

Currently, this only works for Delphi 5. For later versions,
WStrFromPCharLen_Offset
has to be adjusted and some minor adjustments to _WStrFromPCharLen_UTF8
should be made
to use the thread locale codepage. Other than that, it should be
similar.

Francisco

---

const
UTF8_BOM = #$EF#$BB#$BF;

function LoadResString_Ansi(ResStringRec: PResStringRec): string;
var
Buffer: array[0..1023] of Char;
begin
if ResStringRec <> nil then
if ResStringRec.Identifier < 64 * 1024 then
SetString(Result, Buffer,
LoadString(FindResourceHInstance(ResStringRec.Module^),
ResStringRec.Identifier, Buffer, SizeOf(Buffer)))
else
Result := PChar(ResStringRec.Identifier);
end;

function LoadResString_UTF8(ResStringRec: PResStringRec): string;
var
Buffer: array[0..1023] of WideChar;
begin
if ResStringRec <> nil then
if ResStringRec.Identifier < 64 * 1024 then
begin
SetString(Result, Buffer,
LoadStringW(FindResourceHInstance(ResStringRec.Module^),
ResStringRec.Identifier, Buffer, SizeOf(Buffer)));
Result := UTF8_BOM + WideStringToUTF8(PWideChar(@Buffer[0]));
end
else
Result := PChar(ResStringRec.Identifier);
end;

procedure OverwriteProcedure(OldProcedure, NewProcedure: pointer);
{ OverwriteProcedure originally from Igor Siticov }
{ Modified by Jacques Garcia Vazquez }
var
x: pchar;
y: integer;
ov2, ov: cardinal;
p: pointer;
begin
// need six bytes in place of 5
x := PChar(OldProcedure);
if not VirtualProtect(Pointer(x), 6, PAGE_EXECUTE_READWRITE, @ov) then
RaiseLastWin32Error;

// if a jump is present then a redirect is found
// $FF25 = jmp dword ptr [xxx]
// This redirect is normally present in bpl files, but not in exe
files
p := OldProcedure;
if Word(p^) = $25FF then
begin
Inc(Integer(p), 2); // skip the jump
// get the jump address p^ and dereference it p^^
p := Pointer(Pointer(p^)^);

// release the memory
if not VirtualProtect(Pointer(x), 6, ov, @ov2) then
RaiseLastWin32Error;

// re protect the correct one
x := pchar(p);
if not VirtualProtect(Pointer(x), 6, PAGE_EXECUTE_READWRITE, @ov)
then
RaiseLastWin32Error;
end;

x[0] := char($E9);
y := integer(NewProcedure) - integer(p) - 5;
x[1] := char(y and 255);
x[2] := char((y shr 8) and 255);
x[3] := char((y shr 16) and 255);
x[4] := char((y shr 24) and 255);

if not VirtualProtect(Pointer(x), 6, ov, @ov2) then
RaiseLastWin32Error;
end;

procedure _WStrFromPCharLen_UTF8(var Dest: WideString; Source:
PAnsiChar; Length: Integer);
var
DestLen: Integer;
Buffer: array[0..1023] of WideChar;
Codepage: WORD;
begin
if Length < 3 then
Codepage := CP_ACP
else
begin
if (Source[0] = UTF8_BOM[1])
and (Source[1] = UTF8_BOM[2])
and (Source[2] = UTF8_BOM[3]) then
begin
Inc(Source, 3);
Dec(Length, 3);
Codepage := CP_UTF8;
end
else
Codepage := CP_ACP;
end;
if Length <= 0 then
begin
Dest := '';
Exit;
end;
if Length < SizeOf(Buffer) div 2 then
begin
DestLen := MultiByteToWideChar(CodePage, 0, Source, Length,
Buffer, SizeOf(Buffer) div 2);
if DestLen > 0 then
begin
SetLength(Dest, DestLen);
Move(Pointer(@Buffer[0])^, Pointer(Dest)^, DestLen);
Exit;
end;
end;
DestLen := MultiByteToWideChar(CodePage, 0, Source, Length, nil, 0);
SetLength(Dest, DestLen);
MultiByteToWideChar(CodePage, 0, Source, Length, Pointer(Dest),
DestLen);
end;

procedure NewLoadResString;
asm
// Check the caller's code to see whether it is assigning a
resourcestring to a widestring (Compiler dependent)
push ebx
mov ebx,[esp+4];
lea ebx,[ebx-12];
mov ecx,[esp+4];
lea ecx,[ecx+1];
push dx;
mov dx, word ptr [ecx];
cmp dx, word ptr [ebx];
pop dx;
pop ebx
jne LoadResString_ANSI
jmp LoadResString_UTF8
end;

procedure InstallWideStringHandler;
const
WStrFromPCharLen_Offset = -4896;
var
Old_WStrFromPCharLen: Pointer;
begin
OverwriteProcedure(@System.LoadResString, @NewLoadResString);
Old_WStrFromPCharLen := Pointer(PChar(@System.LoadResString) +
WStrFromPCharLen_Offset);
OverwriteProcedure(Old_WStrFromPCharLen, @_WStrFromPCharLen_UTF8);
end;

[Maris Janis Vasilevskis]

Thank you, your code is very interesting.
A remark: LoadResString_UTF8 works only at NT/2K/XP. To have a universal solution, you should avoid use of LoadStringW.

Mahris

[FL]

Of course. It is only a proof-of-concept code. There are still some
rough edges to iron out to make it fully work.

Francisco

[FL]

After more testing, I've found that the following offset is more
reliable.

procedure InstallWideStringHandler;
const
WStrFromPCharLen_Offset = 11632;

var
Old_WStrFromPCharLen: Pointer;
begin
OverwriteProcedure(@System.LoadResString, @NewLoadResString);

Old_WStrFromPCharLen := Pointer(PChar(@System.TextStart) +
WStrFromPCharLen_Offset);
OverwriteProcedure(Old_WStrFromPCharLen, @_WStrFromPCharLen_UTF8);
end;

Francisco

[FL]

Hmmm... after more testing, I've found the offset method is unreliable,
due to the smart linker. I think have to find another way to patch this
function.

Francisco

[Lars B. Dybdahl]

FL wrote:
> I've implemented proof-of-concept sample code that allows the assignment

> resourcestring directly to a WideString without Unicode->Ansi->Unicode
> conversion, with the help of UTF-8.

Hi, Francisco.

Hehe... I'm impressed with the idea you put behind this.

I know, that this is only concept code - but would you seriously consider
actually using it? I mean, since it is based on the detection of what you
assign this to? I don't think I would.

Let us hope that Delphi 8 bringes widestring to VCL and resourcestrings.

Lars.

--
Dybdahl Engineering
Denmark

Free GNU gettext for Delphi i18n/localization tool:
http://dybdahl.dk/dxgettext/

[FL]

"Lars B. Dybdahl" wrote:

> Hi, Francisco.
>
> Hehe... I'm impressed with the idea you put behind this.
>
> I know, that this is only concept code - but would you seriously consider
> actually using it? I mean, since it is based on the detection of what you
> assign this to? I don't think I would.

Of course, this is low-level stuff and probably version dependent. Not
everyone likes this thing, unless you have confidence on what you're
doing.

It is based on the compiler generated code pattern. This pattern has
been constant when assigning a resourcestring to a widestring between
different Delphi versions (actually, it is so small that there shouldn't
be any variation at all, until we have a 64-bit version). The overriden
LoadResString checks whether this is so and invokes the standard
LoadResString or a modified version with UTF-8. The UTF-8 version adds a
UTF-8 BOM that is detected in the overriden _WStrFromPCharLen.

The only problem is to get the actual location of _WStrFromPCharLen. It
varies from project to project, depending on the number of functions
linked in. Since this is problematic by itself, if I cannot find a
satisfactory way to do it, I think the next logical step is to override
MultiByteToWideChar.

Francisco

[Maris Janis Vasilevskis]

FL wrote:
> I think the next logical step is to override
> MultiByteToWideChar.

Really, it is the thing I currently do. Currently, I intercept MessageBoxA, LoadStringA, MultiByteToWideChar, WideCharToMultiByte, CompareStringA, CompareStringW, GetThreadLocale, SetThreadLocale.

Your idea of overwriting System.LoadResString is very interesting. Possibly, I will add it to my intercept family.

Mahris

[FL]

This new version seems to be more reliable than hooking
_WStrFromPCharLen.
JCL is required.

Francisco

---

uses
JclPeImage, JclSysUtils;

procedure NewLoadResString;
asm
// Check the caller's code to see whether it is assigning a
resourcestring to a widestring (Compiler dependent)
push edx
mov ecx,[esp+4];
lea ecx,[ecx-12];
mov edx,[esp+4];
lea edx,[edx+1];
mov dx, word ptr [edx];
cmp dx, word ptr [ecx];
pop edx

jne LoadResString_ANSI
jmp LoadResString_UTF8
end;

var
PeImportHooks: TJclPeMapImgHooks;
OldMultibyteToWideChar: function(CodePage: UINT; dwFlags: DWORD;
const lpMultiByteStr: LPCSTR; cchMultiByte: Integer;
lpWideCharStr: LPWSTR; cchWideChar: Integer): Integer; stdcall =
nil;

function NewMultibyteToWideChar(CodePage: UINT; dwFlags: DWORD;
lpMultiByteStr: LPCSTR; cchMultiByte: Integer;
lpWideCharStr: LPWSTR; cchWideChar: Integer): Integer; stdcall
begin
if (CodePage = 0) and (cchMultibyte >= 3) then
begin
if (lpMultiByteStr[0] = UTF8_BOM[1])
and (lpMultiByteStr[1] = UTF8_BOM[2])
and (lpMultiByteStr[2] = UTF8_BOM[3]) then
begin
Inc(lpMultiByteStr, 3);
Dec(cchMultiByte, 3);
Codepage := CP_UTF8;
end;
end;
Result := OldMultibyteToWideChar(CodePage, dwFlags,
lpMultiByteStr, cchMultiByte, lpWideCharStr, cchWideChar);
end;

procedure InstallWideStringHandler;
begin
OverwriteProcedure(@System.LoadResString, @NewLoadResString);
PeImportHooks.HookImport(Pointer(HInstance), kernel32,
'MultiByteToWideChar',
@NewMultiByteToWideChar, @OldMultiByteToWideChar);
end;

initialization
PeImportHooks := TJclPeMapImgHooks.Create;

finalization
PeImportHooks.UnhookByNewAddress(@NewMultibyteToWideChar);
FreeAndNil(PeImportHooks);

[FL]

Just tested this on Delphi 7. It works equally well, so far.

Currently, this only works for Win2000/XP. CP_UTF8 is not supported on
NT.

Francisco

---

unit WideResStringHandler;

interface

procedure InstallResWideStringHandler;

implementation

uses
SysUtils, Classes, Windows, JclPeImage, JclSysUtils;

const
UTF8_BOM = #$EF#$BB#$BF;

function LoadResString_Ansi(ResStringRec: PResStringRec): string;
var
Buffer: array[0..1023] of Char;
begin
if ResStringRec <> nil then
if ResStringRec.Identifier < 64 * 1024 then
SetString(Result, Buffer,
LoadString(FindResourceHInstance(ResStringRec.Module^),
ResStringRec.Identifier, Buffer, SizeOf(Buffer)))
else
Result := PChar(ResStringRec.Identifier);
end;

function LoadResString_UTF8(ResStringRec: PResStringRec): string;
var
Buffer: array[0..1023] of WideChar;
begin
if ResStringRec <> nil then
if ResStringRec.Identifier < 64 * 1024 then
begin
SetString(Result, Buffer,
LoadStringW(FindResourceHInstance(ResStringRec.Module^),
ResStringRec.Identifier, Buffer, SizeOf(Buffer)));

Result := UTF8_BOM + UTF8Encode(PWideChar(@Buffer[0]));

end
else
Result := PChar(ResStringRec.Identifier);
end;

procedure OverwriteProcedure(OldProcedure, NewProcedure: pointer);
{ OverwriteProcedure originally from Igor Siticov }
{ Modified by Jacques Garcia Vazquez }
var
x: pchar;
y: integer;
ov2, ov: cardinal;
p: pointer;
begin
// need six bytes in place of 5
x := PChar(OldProcedure);
if not VirtualProtect(Pointer(x), 6, PAGE_EXECUTE_READWRITE, @ov) then

RaiseLastOSError;

// if a jump is present then a redirect is found
// $FF25 = jmp dword ptr [xxx]
// This redirect is normally present in bpl files, but not in exe
files
p := OldProcedure;
if Word(p^) = $25FF then
begin
Inc(Integer(p), 2); // skip the jump
// get the jump address p^ and dereference it p^^
p := Pointer(Pointer(p^)^);

// release the memory
if not VirtualProtect(Pointer(x), 6, ov, @ov2) then

RaiseLastOSError;

// re protect the correct one
x := pchar(p);
if not VirtualProtect(Pointer(x), 6, PAGE_EXECUTE_READWRITE, @ov)
then

RaiseLastOSError;
end;

x[0] := char($E9);
y := integer(NewProcedure) - integer(p) - 5;
x[1] := char(y and 255);
x[2] := char((y shr 8) and 255);
x[3] := char((y shr 16) and 255);
x[4] := char((y shr 24) and 255);

if not VirtualProtect(Pointer(x), 6, ov, @ov2) then

RaiseLastOSError;
end;

procedure NewLoadResString;
asm
// Check the caller's code to see whether it is assigning a
resourcestring to a widestring (Compiler dependent)
push edx
mov ecx,[esp+4];
lea ecx,[ecx-12];
mov edx,[esp+4];
lea edx,[edx+1];
mov dx, word ptr [edx];
cmp dx, word ptr [ecx];
pop edx
jne LoadResString_ANSI
jmp LoadResString_UTF8
end;

var
PeImportHooks: TJclPeMapImgHooks = nil;

OldMultibyteToWideChar: function(CodePage: UINT; dwFlags: DWORD;
const lpMultiByteStr: LPCSTR; cchMultiByte: Integer;
lpWideCharStr: LPWSTR; cchWideChar: Integer): Integer; stdcall =
nil;

function NewMultibyteToWideChar(CodePage: UINT; dwFlags: DWORD;
lpMultiByteStr: LPCSTR; cchMultiByte: Integer;
lpWideCharStr: LPWSTR; cchWideChar: Integer): Integer; stdcall
begin

if ((CodePage = CP_ACP) or (Codepage=CP_THREAD_ACP)) and (cchMultibyte

>= 3) then
begin
if (lpMultiByteStr[0] = UTF8_BOM[1])
and (lpMultiByteStr[1] = UTF8_BOM[2])
and (lpMultiByteStr[2] = UTF8_BOM[3]) then
begin
Inc(lpMultiByteStr, 3);
Dec(cchMultiByte, 3);
Codepage := CP_UTF8;
end;
end;
Result := OldMultibyteToWideChar(CodePage, dwFlags,
lpMultiByteStr, cchMultiByte, lpWideCharStr, cchWideChar);
end;

procedure InstallResWideStringHandler;
begin
if not Assigned(@OldMultiByteToWideChar) then
begin
PeImportHooks := TJclPeMapImgHooks.Create;

OverwriteProcedure(@System.LoadResString, @NewLoadResString);
PeImportHooks.HookImport(Pointer(HInstance), kernel32,
'MultiByteToWideChar',
@NewMultiByteToWideChar, @OldMultiByteToWideChar);
end;

end;

initialization
finalization
if Assigned(PeImportHooks) then
begin
PeImportHooks.UnhookByNewAddress(@NewMultibyteToWideChar);
FreeAndNil(PeImportHooks);
end;
end.

[FL]

Here is the latest version, compatible with NT4 and Win9x.

Francisco

---
unit WideResStringHandler;

interface

procedure InstallResWideStringHandler;

implementation

uses
SysUtils, Classes, Math, Windows, JclPeImage, JclSysUtils;

const
UTF8_BOM = #$EF#$BB#$BF;

function Win9x_LoadStringW(instance: THandle; resource_id: UINT;
buffer: LPWSTR; buflen: Integer): Integer;
var
hmem: HGLOBAL;
hrsrc: THandle;
p: PWideChar;
string_num, i: Integer;
begin
if (HIWORD(resource_id) = $FFFF) (* netscape 3 passes this *) then
resource_id := UINT(-(Integer(resource_id)));

(* Use bits 4 - 19 (incremented by 1) as resourceid, mask out
* 20 - 31. *)
hrsrc := FindResource(instance, LPCSTR(((resource_id shr 4) and $FFFF)
+ 1),
RT_STRING);
if (hrsrc = 0) then
begin
Result := 0;
Exit;
end;
hmem := LoadResource(instance, hrsrc);
if (hmem = 0) then
begin
Result := 0;
Exit;
end;

p := LockResource(hmem);
string_num := resource_id and $000F;
for i := 0 to string_num - 1 do
p := p + Integer(p^) + 1;

if (buffer = nil) then
begin
Result := Integer(p^);
Exit;
end;
i := min(buflen - 1, Integer(p^));
if (i > 0) then
begin
CopyMemory(buffer, p + 1, i * sizeof(WideChar));
buffer[i] := WideCHAR(0);
end
else
begin
if (buflen > 1) then
begin
buffer[0] := WideCHAR(0);
Result := 0;
Exit;
end;
end;

Result := i;
end;

function Tnt_LoadStringW(instance: THandle; resource_id: UINT;
buffer: LPWSTR; buflen: Integer): Integer;
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
Result := LoadStringW(instance, resource_id, buffer, buflen)
else
Result := Win9x_LoadStringW(instance, resource_id, buffer, buflen);
end;

function LoadResString_Ansi(ResStringRec: PResStringRec): string;
var
Buffer: array[0..1023] of Char;
begin
if ResStringRec <> nil then
if ResStringRec.Identifier < 64 * 1024 then
SetString(Result, Buffer,
LoadString(FindResourceHInstance(ResStringRec.Module^),
ResStringRec.Identifier, Buffer, SizeOf(Buffer)))
else
Result := PChar(ResStringRec.Identifier);
end;

function LoadResString_UTF8(ResStringRec: PResStringRec): string;
var
Buffer: array[0..1023] of WideChar;
begin
if ResStringRec <> nil then
if ResStringRec.Identifier < 64 * 1024 then
begin
SetString(Result, Buffer,

Tnt_LoadStringW(FindResourceHInstance(ResStringRec.Module^),
ResStringRec.Identifier, Buffer, SizeOf(Buffer)));
Result := UTF8_BOM + UTF8Encode(PWideChar(@Buffer[0]));

end
else
Result := PChar(ResStringRec.Identifier);
end;

procedure OverwriteProcedure(OldProcedure, NewProcedure: pointer);
{ OverwriteProcedure originally from Igor Siticov }
{ Modified by Jacques Garcia Vazquez }
var
x: pchar;
y: integer;
ov2, ov: cardinal;
p: pointer;
begin
// need six bytes in place of 5
x := PChar(OldProcedure);
if not VirtualProtect(Pointer(x), 6, PAGE_EXECUTE_READWRITE, @ov) then

RaiseLastOSError;

// if a jump is present then a redirect is found
// $FF25 = jmp dword ptr [xxx]
// This redirect is normally present in bpl files, but not in exe
files
p := OldProcedure;
if Word(p^) = $25FF then
begin
Inc(Integer(p), 2); // skip the jump
// get the jump address p^ and dereference it p^^
p := Pointer(Pointer(p^)^);

// release the memory
if not VirtualProtect(Pointer(x), 6, ov, @ov2) then

RaiseLastOSError;

// re protect the correct one
x := pchar(p);
if not VirtualProtect(Pointer(x), 6, PAGE_EXECUTE_READWRITE, @ov)
then

RaiseLastOSError;
end;

x[0] := char($E9);
y := integer(NewProcedure) - integer(p) - 5;
x[1] := char(y and 255);
x[2] := char((y shr 8) and 255);
x[3] := char((y shr 16) and 255);
x[4] := char((y shr 24) and 255);

if not VirtualProtect(Pointer(x), 6, ov, @ov2) then

RaiseLastOSError;
end;

procedure NewLoadResString;
asm
// Check the caller's code to see whether it is assigning a
resourcestring to a widestring (Compiler dependent)
push edx
mov ecx,[esp+4];

lea ecx,[ecx-12];
mov edx,[esp+4];
lea edx,[edx+1];
mov dx, word ptr [edx];
cmp dx, word ptr [ecx];
pop edx

jne LoadResString_ANSI
jmp LoadResString_UTF8
end;

var

PeImportHooks: TJclPeMapImgHooks = nil;
OldMultibyteToWideChar: function(CodePage: UINT; dwFlags: DWORD;
const lpMultiByteStr: LPCSTR; cchMultiByte: Integer;
lpWideCharStr: LPWSTR; cchWideChar: Integer): Integer; stdcall =
nil;

function UTF8ToWideChar(lpMultiByteStr: LPCSTR; cchMultiByte: Integer;

lpWideCharStr: LPWSTR; cchWideChar: Integer): Integer;

var
W: WideString;
TempStr: string;
begin
if cchMultiByte >= 0 then
begin
SetLength(TempStr, cchMultiByte);
StrLCopy(PChar(TempStr), lpMultiByteStr, cchMultiByte);
end
else
begin
TempStr := PChar(lpMultiByteStr);
end;
W := UTF8Decode(TempStr);
Result := Length(W);
if (lpWideCharStr <> nil) and (cchWideChar > 0) then
Move(PWideChar(W)^, lpWideCharStr^, Min(cchWideChar *
SizeOf(WideChar),
Length(W) * SizeOf(WideChar)));
end;

function NewMultibyteToWideChar(CodePage: UINT; dwFlags: DWORD;
lpMultiByteStr: LPCSTR; cchMultiByte: Integer;
lpWideCharStr: LPWSTR; cchWideChar: Integer): Integer; stdcall
begin

if ((CodePage = CP_ACP) or (CodePage = CP_THREAD_ACP) or (CodePage =
GetACP)) and

(cchMultibyte >= 3) then
begin

if (lpMultiByteStr[0] = UTF8_BOM[1])
and (lpMultiByteStr[1] = UTF8_BOM[2])
and (lpMultiByteStr[2] = UTF8_BOM[3]) then
begin
Inc(lpMultiByteStr, 3);
Dec(cchMultiByte, 3);
Codepage := CP_UTF8;
end;
end;
if (CodePage = CP_UTF8) and ((Win32Platform <> VER_PLATFORM_WIN32_NT)
or (Win32MajorVersion <= 4))
then
// NT/9x doesn't support UTF-8
Result := UTF8ToWideChar(lpMultiByteStr, cchMultiByte,
lpWideCharStr, cchWideChar)
else

Result := OldMultibyteToWideChar(CodePage, dwFlags,
lpMultiByteStr, cchMultiByte, lpWideCharStr, cchWideChar);
end;

procedure InstallResWideStringHandler;
begin
if not Assigned(@OldMultiByteToWideChar) then
begin
PeImportHooks := TJclPeMapImgHooks.Create;
OverwriteProcedure(@System.LoadResString, @NewLoadResString);
PeImportHooks.HookImport(Pointer(HInstance), kernel32,
'MultiByteToWideChar',
@NewMultiByteToWideChar, @OldMultiByteToWideChar);
end;
end;

initialization
finalization
if Assigned(PeImportHooks) then
begin
PeImportHooks.UnhookByNewAddress(@NewMultibyteToWideChar);
FreeAndNil(PeImportHooks);
end;
end.

[FL]

One caveat in the current implementation though. Assigning directly to a
variant doesn't work (the compiler pattern is exactly the same), unless
you cast it to a widestring explicitly, that is:

resourcestring
SMsg = 'blah';

var
V: Variant;

begin
V:=SMsg; // doesn't work
V:=WideString(SMsg); // works
end;

Francisco

[FL]

Oops, pressed the send button too quickly.

Alternatively, this also works:

var
V: Variant;
TempStr: string;

begin
TempStr:=SMsg;
V:=TempStr;
end;

Francisco

[FL]

Hmmm... after thinking more about it, I added more checks to ensure that
only WideString assignments will call the UTF8 version. The variant
issue is gone now.

Francisco

---
unit WideResStringHandler;

interface

procedure InstallResWideStringHandler;

implementation

const
UTF8_BOM = #$EF#$BB#$BF;

Result := i;
end;

Result:=LoadStringW(instance, resource_id, buffer, buflen)
else
Result:=Win9x_LoadStringW(instance, resource_id, buffer, buflen);
end;

var
WStrFromLStrAddr: Pointer;

procedure DummyProc;
asm
call System.@WStrFromLStr
end;

procedure SetWStrFromLStrAddr;
var
RelAddr: PInteger;
begin
RelAddr := PInteger(PChar(@DummyProc) + $1);
WStrFromLStrAddr := PChar(@DummyProc) + $5 + RelAddr^;
end;

procedure NewLoadResString;
asm
// Check the caller's code to see whether it is assigning a
resourcestring to a widestring (Compiler dependent)
push edx
mov ecx,[esp+4];
lea ecx,[ecx-12];
mov edx,[esp+4];
lea edx,[edx+1];
mov dx, word ptr [edx];
cmp dx, word ptr [ecx];
pop edx
jne LoadResString_ANSI
push edx
mov ecx,[esp+4]

lea ecx,[ecx+7]
mov ecx,[ecx]; // Relative address of the string->xx call
mov edx,[esp+4]
lea edx,[edx+11]
add ecx,edx
cmp ecx,[WStrFromLStrAddr] // Double check whether it is
WideString->string conversion
pop edx
je LoadResString_UTF8
jmp LoadResString_ANSI
end;

SetWStrFromLStrAddr;
PeImportHooks := TJclPeMapImgHooks.Create;

PeImportHooks.HookImport(Pointer(HInstance), kernel32,
'MultiByteToWideChar',
@NewMultiByteToWideChar, @OldMultiByteToWideChar);

OverwriteProcedure(@System.LoadResString, @NewLoadResString);
end;
end;

initialization
finalization
if Assigned(PeImportHooks) then
begin
PeImportHooks.UnhookByNewAddress(@NewMultibyteToWideChar);
FreeAndNil(PeImportHooks);
end;
end.

[FL]

Silly me. Posted the wrong version. :-)

This is the latest version. In the worst case, it will fall back to the
old behavior. No data is "lost".

Francisco

---

procedure NewLoadResString;
asm
// Check the caller's code to see whether it is assigning a
resourcestring to a widestring (Compiler dependent)
push edx
mov ecx,[esp+4];
lea ecx,[ecx-12];
mov edx,[esp+4];
lea edx,[edx+1];
mov dx, word ptr [edx];
cmp dx, word ptr [ecx];
pop edx
jne LoadResString_ANSI
push edx

mov edx,[esp+4]
lea edx,[edx+6]
cmp byte ptr [edx], $e8 // locate the call instruction
je @@check_call
dec edx
cmp byte ptr [edx], $e8
jne @@no_call_instruction // cannot find the call
@@check_call:
inc edx
mov ecx, [edx]
add edx, 4
add ecx, edx

cmp ecx,[WStrFromLStrAddr] // Double check whether it is
WideString->string conversion

@@no_call_instruction:

pop edx
je LoadResString_UTF8
jmp LoadResString_ANSI
end;

[FL]

Still, I dislike the dependency on JCL to hook MultiByteToWideChar.

The version below eliminates this dependency, but relies on TntSysUtils.
Actually, it is just that I wanted to reuse the global variable
DefaultUserCodePage. Tested the unit on Delphi 5 and Delphi 7 and seems
to be working OK.

A side effect is that you can specify the default code page for all
WideString->string conversions.

Francisco

---

unit WideResStringHandler;

interface

procedure InstallResWideStringHandler;

implementation

{$I TntCompilers.INC}

uses
SysUtils, Classes, Math, Windows, TntSysUtils
{$IFDEF COMPILER_6_UP}, Variants{$ENDIF};

const
UTF8_BOM = #$EF#$BB#$BF;

var
HandlerInstalled: Boolean = False;

Result := i;
end;

Result := LoadStringW(instance, resource_id, buffer, buflen)
else
Result := Win9x_LoadStringW(instance, resource_id, buffer, buflen);
end;

function UTF8ToWideChar(lpMultiByteStr: LPCSTR; cchMultiByte: Integer;

if (CodePage = DefaultUserCodePage) and (cchMultibyte >= 3) then

begin
if (lpMultiByteStr[0] = UTF8_BOM[1])
and (lpMultiByteStr[1] = UTF8_BOM[2])
and (lpMultiByteStr[2] = UTF8_BOM[3]) then
begin
Inc(lpMultiByteStr, 3);
Dec(cchMultiByte, 3);
Codepage := CP_UTF8;
end;
end;
if (CodePage = CP_UTF8) and ((Win32Platform <> VER_PLATFORM_WIN32_NT)
or (Win32MajorVersion <= 4))
then
// NT/9x doesn't support UTF-8
Result := UTF8ToWideChar(lpMultiByteStr, cchMultiByte,
lpWideCharStr, cchWideChar)
else

Result := MultibyteToWideChar(CodePage, dwFlags,

lpMultiByteStr, cchMultiByte, lpWideCharStr, cchWideChar);
end;

procedure WStrFromPCharLen_UTF8(var Dest: WideString; Source: PAnsiChar;

Length: Integer);
var
DestLen: Integer;

Buffer: array[0..2047] of WideChar;
begin

if Length <= 0 then
begin
Dest := '';
Exit;
end;

if Length + 1 < High(Buffer) then
begin
DestLen := NewMultiByteToWideChar(DefaultUserCodePage, 0, Source,
Length, Buffer, High(Buffer));

if DestLen > 0 then
begin
SetLength(Dest, DestLen);

Move(Pointer(@Buffer[0])^, Pointer(Dest)^, DestLen *
SizeOf(WideChar));
Exit;
end;
end;
DestLen := (Length + 1);
SetLength(Dest, DestLen); // overallocate, trim later
DestLen := NewMultiByteToWideChar(DefaultUserCodePage, 0, Source,
Length, Pointer(Dest), DestLen);
if DestLen < 0 then
DestLen := 0;
SetLength(Dest, DestLen);
end;

const
varDeepData = $BFE8;

procedure VarFromLStr_UTF8(var V: TVarData; const Value: string);
begin
if (V.VType and varDeepData) <> 0 then
VarClear(PVariant(@V)^);
if (Length(Value) >= 3) and
(Value[1] = UTF8_BOM[1])
and (Value[2] = UTF8_BOM[2])
and (Value[3] = UTF8_BOM[3]) then
begin
PVariant(@V)^ := UTF8Decode(Copy(Value, 4, Length(Value)))
end
else
begin
V.VString := nil;
V.VType := varString;
string(V.VString) := Value;
end;
end;

var
WStrFromLStrAddr: Pointer;
WStrFromPCharLenAddr: Pointer;
VarFromLStrAddr: Pointer;

procedure DummyProc;
asm
call System.@WStrFromLStr

call System.@WStrFromPCharLen
call System.@VarFromLStr
end;

procedure SetSystemCallAddr;

var
RelAddr: PInteger;
begin
RelAddr := PInteger(PChar(@DummyProc) + $1);
WStrFromLStrAddr := PChar(@DummyProc) + $5 + RelAddr^;

RelAddr := PInteger(PChar(@DummyProc) + $6);
WStrFromPCharLenAddr := PChar(@DummyProc) + $A + RelAddr^;
RelAddr := PInteger(PChar(@DummyProc) + $B);
VarFromLStrAddr := PChar(@DummyProc) + $F + RelAddr^;
end;

procedure NewLoadResString;
asm
// Check the caller's code to see whether it is assigning a
resourcestring to a widestring (Compiler dependent)
push edx
mov ecx,[esp+4];
lea ecx,[ecx-12];
mov edx,[esp+4];
lea edx,[edx+1];
mov dx, word ptr [edx];
cmp dx, word ptr [ecx];
pop edx
jne LoadResString_ANSI

jmp LoadResString_UTF8
end;

procedure InstallResWideStringHandler;
begin
if not HandlerInstalled then
begin
SetSystemCallAddr;
OverwriteProcedure(WStrFromPCharLenAddr, @WStrFromPCharLen_UTF8);
OverwriteProcedure(VarFromLStrAddr, @VarFromLStr_UTF8);
OverwriteProcedure(@System.LoadResString, @NewLoadResString);
end;
end;

end.

[Alexander Melnychenko]

BTW, if somebody don't want to owerwrite procedures, the following function
returns the wide string from the resources:

function GetWideStr(StrName : PString) : WideString;

var
Buffer: array [0..1023] of WideChar;

StrRec : PResStringRec;
begin
StrRec := Pointer(StrName);

if StrRec^.Identifier < 64*1024 then

begin
if Win32Platform = VER_PLATFORM_WIN32_NT then

LoadStringW(FindResourceHInstance(StrRec^.Module^),
StrRec^.Identifier, Buffer, SizeOf(Buffer) div 2)
else
Win9x_LoadStringW(FindResourceHInstance(StrRec^.Module^),
StrRec^.Identifier, Buffer, SizeOf(Buffer) div
2);
Result := Buffer;
end
else
Result := String(PChar(StrRec^.Identifier));
end;

To call it use GetWideStr(@SResString), where SResString is a string
constant defined in the resourcestring section.

--
Best regards,
Alex Melnychenko
http://www.korzh.com