?? tntsystem.pas
字號:
end;
// check calling code pattern
if CodeMatchesPatternForUnicode(ReturnAddr) then begin
// result will probably be assigned to an intermediate AnsiString
// on its way to either a WideString or Variant.
LastWideResString := WideLoadResString(ResStringRec);
Result := LastWideResString;
LastResStringValue := Result;
if Result = '' then
PLastResString := nil
else
PLastResString := PAnsiChar(Result);
end else begin
// result will probably be assigned to an actual AnsiString variable.
PLastResString := nil;
Result := WideLoadResString(ResStringRec);
end;
end;
//--------------------------------------------------------------------
// WStrFromPCharLen()
//
// This system function is used to assign an AnsiString to a WideString.
// It has been modified to assign Unicode results from LoadResString.
// Another purpose of this function is to specify the code page.
//--------------------------------------------------------------------
procedure Custom_System_WStrFromPCharLen(var Dest: WideString; Source: PAnsiChar; Length: Integer);
var
DestLen: Integer;
Buffer: array[0..2047] of WideChar;
Local_PLastResString: Pointer;
begin
Local_PLastResString := PLastResString;
if (Local_PLastResString <> nil)
and (Local_PLastResString = Source)
and (System.Length(LastResStringValue) = Length)
and (LastResStringValue = Source) then begin
// use last unicode resource string
PLastResString := nil; { clear for further use }
Dest := LastWideResString;
end else begin
if Local_PLastResString <> nil then
PLastResString := nil; { clear for further use }
if Length <= 0 then
begin
Dest := '';
Exit;
end;
if Length + 1 < High(Buffer) then
begin
DestLen := MultiByteToWideChar(DefaultSystemCodePage, 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 := MultiByteToWideChar(DefaultSystemCodePage, 0, Source, Length, Pointer(Dest),
DestLen);
if DestLen < 0 then
DestLen := 0;
SetLength(Dest, DestLen);
end;
end;
{$IFNDEF COMPILER_9_UP}
//--------------------------------------------------------------------
// LStrFromPWCharLen()
//
// This system function is used to assign an WideString to an AnsiString.
// It has not been modified from its original purpose other than to specify the code page.
//--------------------------------------------------------------------
procedure Custom_System_LStrFromPWCharLen(var Dest: AnsiString; Source: PWideChar; Length: Integer);
var
DestLen: Integer;
Buffer: array[0..4095] of AnsiChar;
begin
if Length <= 0 then
begin
Dest := '';
Exit;
end;
if Length + 1 < (High(Buffer) div sizeof(WideChar)) then
begin
DestLen := WideCharToMultiByte(DefaultSystemCodePage, 0, Source,
Length, Buffer, High(Buffer),
nil, nil);
if DestLen >= 0 then
begin
SetLength(Dest, DestLen);
Move(Pointer(@Buffer[0])^, PAnsiChar(Dest)^, DestLen);
Exit;
end;
end;
DestLen := (Length + 1) * sizeof(WideChar);
SetLength(Dest, DestLen); // overallocate, trim later
DestLen := WideCharToMultiByte(DefaultSystemCodePage, 0, Source, Length, Pointer(Dest), DestLen,
nil, nil);
if DestLen < 0 then
DestLen := 0;
SetLength(Dest, DestLen);
end;
//--------------------------------------------------------------------
// WStrToString()
//
// This system function is used to assign an WideString to an short string.
// It has not been modified from its original purpose other than to specify the code page.
//--------------------------------------------------------------------
procedure Custom_System_WStrToString(Dest: PShortString; const Source: WideString; MaxLen: Integer);
var
SourceLen, DestLen: Integer;
Buffer: array[0..511] of AnsiChar;
begin
if MaxLen > 255 then MaxLen := 255;
SourceLen := Length(Source);
if SourceLen >= MaxLen then SourceLen := MaxLen;
if SourceLen = 0 then
DestLen := 0
else begin
DestLen := WideCharToMultiByte(DefaultSystemCodePage, 0, Pointer(Source), SourceLen,
Buffer, SizeOf(Buffer), nil, nil);
if DestLen > MaxLen then DestLen := MaxLen;
end;
Dest^[0] := Chr(DestLen);
if DestLen > 0 then Move(Buffer, Dest^[1], DestLen);
end;
{$ENDIF}
//--------------------------------------------------------------------
// VarFromLStr()
//
// This system function is used to assign an AnsiString to a Variant.
// It has been modified to assign Unicode results from LoadResString.
//--------------------------------------------------------------------
procedure Custom_System_VarFromLStr(var V: TVarData; const Value: AnsiString);
const
varDeepData = $BFE8;
var
Local_PLastResString: Pointer;
begin
if (V.VType and varDeepData) <> 0 then
VarClear(PVariant(@V)^);
Local_PLastResString := PLastResString;
if (Local_PLastResString <> nil)
and (Local_PLastResString = PAnsiChar(Value))
and (LastResStringValue = Value) then begin
// use last unicode resource string
PLastResString := nil; { clear for further use }
V.VOleStr := nil;
V.VType := varOleStr;
WideString(Pointer(V.VOleStr)) := Copy(LastWideResString, 1, MaxInt);
end else begin
if Local_PLastResString <> nil then
PLastResString := nil; { clear for further use }
V.VString := nil;
V.VType := varString;
AnsiString(V.VString) := Value;
end;
end;
{$IFNDEF COMPILER_9_UP}
//--------------------------------------------------------------------
// WStrCat3() A := B + C;
//
// This system function is used to concatenate two strings into one result.
// This function is added because A := '' + '' doesn't necessarily result in A = '';
//--------------------------------------------------------------------
procedure Custom_System_WStrCat3(var Dest: WideString; const Source1, Source2: WideString);
function NewWideString(CharLength: Longint): Pointer;
var
_NewWideString: function(CharLength: Longint): Pointer;
begin
asm
PUSH ECX
MOV ECX, offset System.@NewWideString;
MOV _NewWideString, ECX
POP ECX
end;
Result := _NewWideString(CharLength);
end;
procedure WStrSet(var S: WideString; P: PWideChar);
var
Temp: Pointer;
begin
Temp := Pointer(InterlockedExchange(Integer(S), Integer(P)));
if Temp <> nil then
WideString(Temp) := '';
end;
var
Source1Len, Source2Len: Integer;
NewStr: PWideChar;
begin
Source1Len := Length(Source1);
Source2Len := Length(Source2);
if (Source1Len <> 0) or (Source2Len <> 0) then
begin
NewStr := NewWideString(Source1Len + Source2Len);
Move(Pointer(Source1)^, Pointer(NewStr)^, Source1Len * sizeof(WideChar));
Move(Pointer(Source2)^, NewStr[Source1Len], Source2Len * sizeof(WideChar));
WStrSet(Dest, NewStr);
end else
Dest := '';
end;
{$ENDIF}
//--------------------------------------------------------------------
// System proc replacements
//--------------------------------------------------------------------
type
POverwrittenData = ^TOverwrittenData;
TOverwrittenData = record
Location: Pointer;
OldCode: array[0..6] of Byte;
end;
procedure OverwriteProcedure(OldProcedure, NewProcedure: pointer; Data: POverwrittenData = nil);
{ OverwriteProcedure originally from Igor Siticov }
{ Modified by Jacques Garcia Vazquez }
var
x: PAnsiChar;
y: integer;
ov2, ov: cardinal;
p: pointer;
begin
if Assigned(Data) and (Data.Location <> nil) then
exit; { procedure already overwritten }
// need six bytes in place of 5
x := PAnsiChar(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 := PAnsiChar(p);
if not VirtualProtect(Pointer(x), 6, PAGE_EXECUTE_READWRITE, @ov) then
RaiseLastOSError;
end;
if Assigned(Data) then
begin
Move(x^, Data.OldCode, 6);
{ Assign Location last so that Location <> nil only if OldCode is properly initialized. }
Data.Location := x;
end;
x[0] := AnsiChar($E9);
y := integer(NewProcedure) - integer(p) - 5;
x[1] := AnsiChar(y and 255);
x[2] := AnsiChar((y shr 8) and 255);
x[3] := AnsiChar((y shr 16) and 255);
x[4] := AnsiChar((y shr 24) and 255);
if not VirtualProtect(Pointer(x), 6, ov, @ov2) then
RaiseLastOSError;
end;
procedure RestoreProcedure(OriginalProc: Pointer; Data: TOverwrittenData);
var
ov, ov2: Cardinal;
begin
if Data.Location <> nil then begin
if not VirtualProtect(Data.Location, 6, PAGE_EXECUTE_READWRITE, @ov) then
RaiseLastOSError;
Move(Data.OldCode, Data.Location^, 6);
if not VirtualProtect(Data.Location, 6, ov, @ov2) then
RaiseLastOSError;
end;
end;
function Addr_System_EndThread: Pointer;
begin
Result := @System.EndThread;
end;
function Addr_System_LoadResString: Pointer;
begin
Result := @System.LoadResString{TNT-ALLOW LoadResString};
end;
function Addr_System_WStrFromPCharLen: Pointer;
asm
mov eax, offset System.@WStrFromPCharLen;
end;
{$IFNDEF COMPILER_9_UP}
function Addr_System_LStrFromPWCharLen: Pointer;
asm
mov eax, offset System.@LStrFromPWCharLen;
end;
function Addr_System_WStrToString: Pointer;
asm
mov eax, offset System.@WStrToString;
end;
{$ENDIF}
function Addr_System_VarFromLStr: Pointer;
asm
mov eax, offset System.@VarFromLStr;
end;
function Addr_System_WStrCat3: Pointer;
asm
mov eax, offset System.@WStrCat3;
end;
var
System_EndThread_Code,
System_LoadResString_Code,
System_WStrFromPCharLen_Code,
{$IFNDEF COMPILER_9_UP}
System_LStrFromPWCharLen_Code,
System_WStrToString_Code,
{$ENDIF}
System_VarFromLStr_Code
{$IFNDEF COMPILER_9_UP}
,
System_WStrCat3_Code,
SysUtils_WideFmtStr_Code
{$ENDIF}
: TOverwrittenData;
procedure InstallEndThreadOverride;
begin
OverwriteProcedure(Addr_System_EndThread, @Custom_System_EndThread, @System_EndThread_Code);
end;
procedure InstallStringConversionOverrides;
begin
OverwriteProcedure(Addr_System_WStrFromPCharLen, @Custom_System_WStrFromPCharLen, @System_WStrFromPCharLen_Code);
{$IFNDEF COMPILER_9_UP}
OverwriteProcedure(Addr_System_LStrFromPWCharLen, @Custom_System_LStrFromPWCharLen, @System_LStrFromPWCharLen_Code);
OverwriteProcedure(Addr_System_WStrToString, @Custom_System_WStrToString, @System_WStrToString_Code);
{$ENDIF}
end;
procedure InstallWideResourceStrings;
begin
OverwriteProcedure(Addr_System_LoadResString, @Custom_System_LoadResString, @System_LoadResString_Code);
OverwriteProcedure(Addr_System_VarFromLStr, @Custom_System_VarFromLStr, @System_VarFromLStr_Code);
end;
{$IFNDEF COMPILER_9_UP}
procedure InstallWideStringConcatenationFix;
begin
OverwriteProcedure(Addr_System_WStrCat3, @Custom_System_WStrCat3, @System_WStrCat3_Code);
end;
procedure InstallWideFormatFixes;
begin
OverwriteProcedure(@SysUtils.WideFmtStr, @TntSysUtils.Tnt_WideFmtStr, @SysUtils_WideFmtStr_Code);
end;
{$ENDIF}
procedure InstallTntSystemUpdates(Updates: TTntSystemUpdateSet = AllTntSystemUpdates);
begin
InstallEndThreadOverride;
if tsWideResourceStrings in Updates then begin
InstallStringConversionOverrides;
InstallWideResourceStrings;
end;
{$IFNDEF COMPILER_9_UP}
if tsFixImplicitCodePage in Updates then begin
InstallStringConversionOverrides;
{ CP_ACP is the code page used by the non-Unicode Windows API. }
GDefaultSystemCodePage := CP_ACP{TNT-ALLOW CP_ACP};
end;
if tsFixWideStrConcat in Updates then begin
InstallWideStringConcatenationFix;
end;
if tsFixWideFormat in Updates then begin
InstallWideFormatFixes;
end;
{$ENDIF}
end;
{$IFNDEF COMPILER_9_UP}
var
StartupDefaultUserCodePage: Cardinal;
{$ENDIF}
procedure UninstallSystemOverrides;
begin
RestoreProcedure(Addr_System_EndThread, System_EndThread_Code);
// String Conversion
RestoreProcedure(Addr_System_WStrFromPCharLen, System_WStrFromPCharLen_Code);
{$IFNDEF COMPILER_9_UP}
RestoreProcedure(Addr_System_LStrFromPWCharLen, System_LStrFromPWCharLen_Code);
RestoreProcedure(Addr_System_WStrToString, System_WStrToString_Code);
GDefaultSystemCodePage := StartupDefaultUserCodePage;
{$ENDIF}
// Wide resourcestring
RestoreProcedure(Addr_System_LoadResString, System_LoadResString_Code);
RestoreProcedure(Addr_System_VarFromLStr, System_VarFromLStr_Code);
{$IFNDEF COMPILER_9_UP}
// WideString concat fix
RestoreProcedure(Addr_System_WStrCat3, System_WStrCat3_Code);
// WideFormat fixes
RestoreProcedure(@SysUtils.WideFmtStr, SysUtils_WideFmtStr_Code);
{$ENDIF}
end;
initialization
{$IFDEF COMPILER_9_UP}
GDefaultSystemCodePage := GetACP;
{$ELSE}
{$IFDEF COMPILER_7_UP}
if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 5) then
GDefaultSystemCodePage := CP_THREAD_ACP // Win 2K/XP/...
else
GDefaultSystemCodePage := LCIDToCodePage(GetThreadLocale); // Win NT4/95/98/ME
{$ELSE}
GDefaultSystemCodePage := CP_ACP{TNT-ALLOW CP_ACP};
{$ENDIF}
{$ENDIF}
{$IFNDEF COMPILER_9_UP}
StartupDefaultUserCodePage := DefaultSystemCodePage;
{$ENDIF}
IsDebugging := DebugHook > 0;
finalization
UninstallSystemOverrides;
FreeTntSystemThreadVars; { Make MemorySleuth happy. }
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -