Type TResTableString =
packed Record
Len: Word;
Text:
packed Array[0..0]
of WideChar;
End;
PResTableString = ^TResTableString;
TEnumResRec =
packed Record
hModule: THandle;
ResType: PWideChar;
ResName: PWideChar;
LangIDs:
packed Array of packed Record
LangID: LANGID;
Case Byte
of
0: (P: Pointer; Len: Integer);
1: (Text: PResTableString);
// RT_STRING
End;
End;
PEnumResRec = ^TEnumResRec;
Const DefaultLang = LANG_ENGLISH
or (SUBLANG_ENGLISH_US
shl 10);
Var GUILang: LANGID = LANG_NEUTRAL
or (SUBLANG_NEUTRAL
shl 10);
ResErrorStr: WideString;
Function FindResourceLang(
Var LangResList: TEnumResRec): Integer;
Function EnumResLangProcW(hModule: THandle; lpszType, lpszName: PWideChar; wIDLanguage: LANGID; lParam: PEnumResRec): LongBool;
StdCall;
Var hRes: HRSRC;
hResLoad: THandle;
ResP: PResTableString;
ResL, i, i2: Integer;
Begin
Result := True;
If lpszType = PWideChar(RT_STRING)
Then Begin
hRes := FindResourceExW(lParam^.hModule, lParam^.ResType,
MakeIntResourceW(Integer(lParam^.ResName)
shr 4 + 1), wIDLanguage);
hResLoad := LoadResource(lParam^.hModule, hRes);
ResL := SizeOfResource(lParam^.hModule, hRes);
ResP := LockResource(hResLoad);
If ResP =
nil Then Exit;
i := ResL;
For i2 := 1
to Integer(lParam^.ResName)
and $0F
do Begin
Dec(i, (ResP^.Len + 1) * 2);
Inc(PWideChar(ResP), ResP^.Len + 1);
If i <= 0
Then Exit;
End;
If (ResP^.Len = 0)
or ((ResP^.Len + 1) * 2 > i)
Then Exit;
ResL := ResP^.Len + 2;
End Else Begin
hRes := FindResourceExW(lParam^.hModule, lParam^.ResType, lParam^.ResName, wIDLanguage);
hResLoad := LoadResource(lParam^.hModule, hRes);
ResL := SizeOfResource(lParam^.hModule, hRes);
ResP := LockResource(hResLoad);
End;
i := Length(lParam^.LangIDs);
SetLength(lParam^.LangIDs, i + 1);
lParam^.LangIDs[i].LangID := wIDLanguage;
lParam^.LangIDs[i].P := ResP;
lParam^.LangIDs[i].Len := ResL;
End;
Var ResName: PWideChar;
LangX, MaskX: LANGID;
i, i2: Integer;
S, S2: WideString;
Begin
Result := -1;
LangResList.LangIDs :=
nil;
If (Cardinal(LangResList.ResName) <= $0000FFFF)
and (LangResList.ResType = PWideChar(RT_STRING))
Then
ResName := MakeIntResourceW(Integer(LangResList.ResName)
shr 4 + 1)
Else ResName := LangResList.ResName;
EnumResourceLanguagesW(LangResList.hModule, LangResList.ResType, ResName, @EnumResLangProcW, Integer(@LangResList));
If LangResList.LangIDs =
nil Then Begin
If Cardinal(LangResList.ResName) < $0000FFFF
Then S := IntToStrT(Integer(LangResList.ResName))
Else S := WideString('
''
') + LangResList.ResName + WideString('
''
');
Case Integer(LangResList.ResType)
of
Integer(RT_STRING):
Begin
Result := 0;
ResErrorStr := #0'
[Resource ' + S + '
(' + '
RT_STRING' + '
) not found]';
ResErrorStr[1] := WideChar(Length(ResErrorStr) - 1);
SetLength(LangResList.LangIDs, 1);
LangResList.LangIDs[0].LangID := LANG_NEUTRAL
or (SUBLANG_NEUTRAL
shl 10);
LangResList.LangIDs[0].Text := @ResErrorStr[1];
LangResList.LangIDs[0].Len := Length(ResErrorStr) - 1;
Exit;
End;
Integer(
nil): S2 := WideString('
''
') + WideString('
''
');
Integer(RT_CURSOR): S2 := '
RT_CURSOR';
Integer(RT_BITMAP): S2 := '
RT_BITMAP';
Integer(RT_ICON): S2 := '
RT_ICON';
Integer(RT_MENU): S2 := '
RT_MENU';
Integer(RT_DIALOG): S2 := '
RT_DIALOG';
Integer(RT_FONTDIR): S2 := '
RT_FONTDIR';
Integer(RT_FONT): S2 := '
RT_FONT';
Integer(RT_ACCELERATOR): S2 := '
RT_ACCELERATOR';
Integer(RT_RCDATA): S2 := '
RT_RCDATA';
Integer(RT_MESSAGETABLE): S2 := '
RT_MESSAGETABLE';
12..$FFFF: S2 := IntToStrT(Integer(LangResList.ResType));
Else S2 := WideString('
''
') + LangResList.ResType + WideString('
''
');
End;
Exception(888, ['
Resource ' + S + '
(type ' + S2 + '
) not found.']);
End;
MaskX := $FFFF;
For i2 := 0
to 9
do Begin
Case i2
of
0, 4:
If GUILang = LANG_NEUTRAL
or (SUBLANG_NEUTRAL
shl 10)
Then Continue
Else LangX := GUILang;
1, 5: LangX := Word(GetThreadLocale);
2, 6: LangX := GetUserDefaultLangID;
3, 7: LangX := GetSystemDefaultLangID;
8: LangX := DefaultLang;
Else LangX := LANG_NEUTRAL
or (SUBLANG_NEUTRAL
shl 10);
End;
If (i2 = 4)
or (LangX
and not $03FF = 0)
Then MaskX := $03FF;
For i := High(LangResList.LangIDs)
downto 0
do
If LangResList.LangIDs[i].LangID
and MaskX = LangX
and MaskX
Then
Result := i;
If Result >= 0
Then Break;
End;
If Result < 0
Then Result := 0;
End;