[utf8vcl-cvs] utf8vcl MissingMethods-incomplete.txt, 1.4, 1.5 TestForm.dfm, 1.9, 1.10 TestForm.pas,
Status: Alpha
Brought to you by:
bluelive
Menu
▾
▴
[utf8vcl-cvs] utf8vcl MissingMethods-incomplete.txt, 1.4, 1.5 TestForm.dfm, 1.9, 1.10 TestForm.pas, 1.14, 1.15 UTF8VCL.pas, 1.13, 1.14
|
From: Robert M. <mar...@us...> - 2007-03-15 12:10:01
|
Update of /cvsroot/utf8vcl/utf8vcl In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv11371 Modified Files: MissingMethods-incomplete.txt TestForm.dfm TestForm.pas UTF8VCL.pas Log Message: hooking refactored, some functions intercepted Index: TestForm.pas =================================================================== RCS file: /cvsroot/utf8vcl/utf8vcl/TestForm.pas,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** TestForm.pas 14 Mar 2007 11:29:02 -0000 1.14 --- TestForm.pas 15 Mar 2007 12:09:49 -0000 1.15 *************** *** 34,39 **** --- 34,41 ---- Activate: TButton; Deactivate: TButton; + Button4: TButton; procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); + procedure Button4Click(Sender: TObject); public end; *************** *** 146,149 **** --- 148,152 ---- ShowMessageFmt('Strange text: %s', [TestText]); + OutputDebugString(PChar(TestText)); Content := Menu1.Caption; *************** *** 230,233 **** --- 233,241 ---- end; + procedure TForm1.Button4Click(Sender: TObject); + begin + FatalAppExit(0, TestText); + end; + end. Index: UTF8VCL.pas =================================================================== RCS file: /cvsroot/utf8vcl/utf8vcl/UTF8VCL.pas,v retrieving revision 1.13 retrieving revision 1.14 diff -C2 -d -r1.13 -r1.14 *** UTF8VCL.pas 13 Mar 2007 12:36:52 -0000 1.13 --- UTF8VCL.pas 15 Mar 2007 12:09:49 -0000 1.14 *************** *** 19,26 **** --- 19,28 ---- UTF8VCLUtils, UTF8VCLMessages; + { function _CreateWindowExA(dwExStyle: DWORD; lpClassName: PAnsiChar; lpWindowName: PAnsiChar; dwStyle: DWORD; X, Y, nWidth, nHeight: Integer; hWndParent: HWND; hMenu: HMENU; hInstance: HINST; lpParam: Pointer): HWND; stdcall; external user32 name 'CreateWindowExA'; + } function _CreateWindowExW(dwExStyle: DWORD; lpClassName: PWideChar; lpWindowName: PWideChar; dwStyle: DWORD; X, Y, nWidth, nHeight: Integer; *************** *** 64,70 **** TempWParam, TempLParam: Longint; begin ! MessageU2WBefore(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, Pointer(@SendMessageW)); ! Result := SendMessageW(hWnd, Msg, TempWParam, TempLParam); ! Result := MessageU2WAfter(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, Result, Pointer(@SendMessageW)); end; --- 66,77 ---- TempWParam, TempLParam: Longint; begin ! if LongWord(GetWindowLong(hWnd, GWL_HINSTANCE)) = HInstance then ! begin ! MessageU2WBefore(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, Pointer(@SendMessageW)); ! Result := SendMessageW(hWnd, Msg, TempWParam, TempLParam); ! Result := MessageU2WAfter(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, Result, Pointer(@SendMessageW)); ! end ! else ! Result := SendMessageA(hWnd, Msg, WParam, LParam); end; *************** *** 73,79 **** TempWParam, TempLParam: Longint; begin ! MessageU2WBefore(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, Pointer(@PostMessageW)); ! Result := PostMessageW(hWnd, Msg, TempWParam, TempLParam); ! MessageU2WAfter(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, 0, Pointer(@PostMessageW)); end; --- 80,91 ---- TempWParam, TempLParam: Longint; begin ! if LongWord(GetWindowLong(hWnd, GWL_HINSTANCE)) = HInstance then ! begin ! MessageU2WBefore(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, Pointer(@PostMessageW)); ! Result := PostMessageW(hWnd, Msg, TempWParam, TempLParam); ! MessageU2WAfter(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, 0, Pointer(@PostMessageW)); ! end ! else ! Result := PostMessageA(hWnd, Msg, WParam, LParam); end; *************** *** 430,443 **** end; var LibUser32: HMODULE = 0; LibGdi32: HMODULE = 0; ! function HookUser32Func(const FunctionName: PChar; NewFunc: Pointer): Pointer; begin ! if LibUser32 = 0 then ! LibUser32 := GetModuleHandle(user32); ! Result := GetProcAddress(LibUser32, FunctionName); ! Assert(Result <> nil, Format('Function "%s" not found in user32.dll', [FunctionName])); // must not be localized ReplaceImport(Pointer(HInstance), Result, NewFunc); --- 442,482 ---- end; + procedure OutputDebugStringAIntercept(lpOutputString: PAnsiChar); stdcall; + var + OutputString: PWideChar; + begin + OutputString := nil; + try + OutputString := ConvertFromUTF8(lpOutputString); + OutputDebugStringW(OutputString); + finally + FreeMem(OutputString); + end; + end; + + procedure FatalAppExitAIntercept(uAction: UINT; lpMessageText: PAnsiChar); stdcall; + var + MessageText: PWideChar; + begin + MessageText := nil; + try + MessageText := ConvertFromUTF8(lpMessageText); + FatalAppExitW(uAction, MessageText); + finally + FreeMem(MessageText); + end; + end; + var LibUser32: HMODULE = 0; LibGdi32: HMODULE = 0; + LibKernel32: HMODULE = 0; ! function HookFunc(const FunctionName: PChar; NewFunc: Pointer; var Module: HMODULE; const ModuleName: PChar): Pointer; begin ! if Module = 0 then ! Module := GetModuleHandle(ModuleName); ! Result := GetProcAddress(Module, FunctionName); ! Assert(Result <> nil, Format('Function "%s" not found in %s', [FunctionName, ModuleName])); // must not be localized ReplaceImport(Pointer(HInstance), Result, NewFunc); *************** *** 445,457 **** end; function HookGdi32Func(const FunctionName: PChar; NewFunc: Pointer): Pointer; begin ! if LibGdi32 = 0 then ! LibGdi32 := GetModuleHandle(gdi32); ! Result := GetProcAddress(LibGdi32, FunctionName); ! Assert(Result <> nil, Format('Function "%s" not found in gdi32.dll', [FunctionName])); // must not be localized ! ReplaceImport(Pointer(HInstance), Result, NewFunc); ! //InjectJumpHook(Result, NewFunc); // no call to "Result" possible end; --- 484,500 ---- end; + function HookUser32Func(const FunctionName: PChar; NewFunc: Pointer): Pointer; + begin + Result := HookFunc(FunctionName, NewFunc, LibUser32, user32); + end; + function HookGdi32Func(const FunctionName: PChar; NewFunc: Pointer): Pointer; begin ! Result := HookFunc(FunctionName, NewFunc, LibGdi32, gdi32); ! end; ! function HookKernel32Func(const FunctionName: PChar; NewFunc: Pointer): Pointer; ! begin ! Result := HookFunc(FunctionName, NewFunc, LibKernel32, kernel32); end; *************** *** 473,480 **** HookUser32Func('DrawTextA', @DrawTextAIntercept); // do not localize HookUser32Func('DrawTextExA', @DrawTextExAIntercept); // do not localize - HookGdi32Func('TextOutA', @TextOutAIntercept); // do not localize - HookGdi32Func('ExtTextOutA', @ExtTextOutAIntercept); // do not localize - HookGdi32Func('GetTextExtentPoint32A', @GetTextExtentPoint32AIntercept); // do not localize - HookGdi32Func('GetTextExtentExPointA', @GetTextExtentExPointAIntercept); // do not localize HookUser32Func('SetWindowLongA', @SetWindowLongAIntercept); // do not localize HookUser32Func('SetWindowTextA', @SetWindowTextAIntercept); // do not localize --- 516,519 ---- *************** *** 489,492 **** --- 528,539 ---- HookUser32Func('InsertMenuItemA', @InsertMenuItemAIntercept); // do not localize HookUser32Func('MessageBoxA', @MessageBoxAIntercept); // do not localize + + HookGdi32Func('TextOutA', @TextOutAIntercept); // do not localize + HookGdi32Func('ExtTextOutA', @ExtTextOutAIntercept); // do not localize + HookGdi32Func('GetTextExtentPoint32A', @GetTextExtentPoint32AIntercept); // do not localize + HookGdi32Func('GetTextExtentExPointA', @GetTextExtentExPointAIntercept); // do not localize + + HookKernel32Func('OutputDebugStringA', @OutputDebugStringAIntercept); // do not localize + HookKernel32Func('FatalAppExitA', @FatalAppExitAIntercept); // do not localize end else Index: TestForm.dfm =================================================================== RCS file: /cvsroot/utf8vcl/utf8vcl/TestForm.dfm,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** TestForm.dfm 14 Mar 2007 11:29:02 -0000 1.9 --- TestForm.dfm 15 Mar 2007 12:09:49 -0000 1.10 *************** *** 176,179 **** --- 176,188 ---- TabOrder = 14 end + object Button4: TButton + Left = 385 + Top = 398 + Width = 70 + Height = 24 + Caption = 'FatalAppExit' + TabOrder = 15 + OnClick = Button4Click + end object MainMenu1: TMainMenu Left = 104 Index: MissingMethods-incomplete.txt =================================================================== RCS file: /cvsroot/utf8vcl/utf8vcl/MissingMethods-incomplete.txt,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** MissingMethods-incomplete.txt 12 Mar 2007 06:27:49 -0000 1.4 --- MissingMethods-incomplete.txt 15 Mar 2007 12:09:49 -0000 1.5 *************** *** 67,73 **** Candidates found by checking Windows.pas (rom): - FatalAppExitA - GetStartupInfoA - OutputDebugStringA SendMessageTimeoutA PostThreadMessageA --- 67,70 ---- |
