[utf8vcl-cvs] utf8vcl TestForm.dfm, 1.12, 1.13 TestForm.pas, 1.17, 1.18 UTF8VCL.pas, 1.16, 1.17 UTF
Status: Alpha
Brought to you by:
bluelive
Menu
▾
▴
[utf8vcl-cvs] utf8vcl TestForm.dfm, 1.12, 1.13 TestForm.pas, 1.17, 1.18 UTF8VCL.pas, 1.16, 1.17 UTF8VCLUtils.pas, 1.12, 1.13
|
From: Bart v. d. W. <blu...@us...> - 2007-03-18 11:26:47
|
Update of /cvsroot/utf8vcl/utf8vcl In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv23150 Modified Files: TestForm.dfm TestForm.pas UTF8VCL.pas UTF8VCLUtils.pas Log Message: Fixed a bug in the SetWindowLong function that caused the OpenFile dialog to overflow its stack, possibly some other bugs too. Added initial support for OpenFile dialog. Added better hooks for some of the DefProc thingies. Index: UTF8VCLUtils.pas =================================================================== RCS file: /cvsroot/utf8vcl/utf8vcl/UTF8VCLUtils.pas,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** UTF8VCLUtils.pas 18 Mar 2007 07:56:10 -0000 1.12 --- UTF8VCLUtils.pas 18 Mar 2007 11:26:41 -0000 1.13 *************** *** 29,32 **** --- 29,35 ---- function IsW2UWndProc(Potential: Pointer): Boolean; + function WrapWndProcU2W(Proc: Pointer; Intercept: TStdWndProcInterceptDef): Pointer; + function WrapWndProcW2U(Proc: Pointer; Intercept: TStdWndProcInterceptDef): Pointer; + procedure InjectJumpHook(OrgProc, NewProc: Pointer); function ReplaceImport(ModuleBase: Pointer; OrgProc, ToProc: Pointer): Boolean; Index: UTF8VCL.pas =================================================================== RCS file: /cvsroot/utf8vcl/utf8vcl/UTF8VCL.pas,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** UTF8VCL.pas 17 Mar 2007 21:48:28 -0000 1.16 --- UTF8VCL.pas 18 Mar 2007 11:26:40 -0000 1.17 *************** *** 16,20 **** uses ! Windows, Messages, SysUtils, Classes, UTF8VCLUtils, UTF8VCLMessages, UTF8VCLControls; --- 16,20 ---- uses ! Windows, Messages, SysUtils, Classes, CommDlg, UTF8VCLUtils, UTF8VCLMessages, UTF8VCLControls; *************** *** 32,40 **** if SpecialWndProc(Cardinal(@Original)) then Result := CallWindowProcW(@Original, hWnd, Msg, WParam, LParam) ! else ! if (@DefWindowProcA = @Original) or (@DefWindowProc = @Original) or ! (@DefFrameProcA = @Original) or (@DefFrameProc = @Original) or ! (@DefMDIChildProcA = @Original) or (@DefMDIChildProc = @Original) then Result := CallWindowProcW(@DefWindowProcW, hWnd, Msg, WParam, LParam) else begin --- 32,41 ---- if SpecialWndProc(Cardinal(@Original)) then Result := CallWindowProcW(@Original, hWnd, Msg, WParam, LParam) ! else if (@DefWindowProcA = @Original) or (@DefWindowProc = @Original) then Result := CallWindowProcW(@DefWindowProcW, hWnd, Msg, WParam, LParam) + else if (@DefMDIChildProcA = @Original) or (@DefMDIChildProc = @Original) then + Result := CallWindowProcW(@DefMDIChildProcW, hWnd, Msg, WParam, LParam) + else if (@DefDlgProcA = @Original) or (@DefDlgProc = @Original) then + Result := CallWindowProcW(@DefDlgProcW, hWnd, Msg, WParam, LParam) else begin *************** *** 60,71 **** 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; --- 61,67 ---- 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; *************** *** 74,85 **** 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; --- 70,76 ---- 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; *************** *** 90,99 **** var TempWParam, TempLParam: Longint; begin ! // the proc does a reverse convert ! TStdWndProcDef(lpPrevWndFunc) := WndProcConvertW2U(lpPrevWndFunc, StdWndProcInterceptU2W, StdWndProcInterceptW2U); ! MessageU2WBefore(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, TStdWndProcDef(lpPrevWndFunc)); ! Result := CallWindowProcW(lpPrevWndFunc, hWnd, Msg, TempWParam, TempLParam); ! Result := MessageU2WAfter(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, Result, TStdWndProcDef(lpPrevWndFunc)); end; --- 81,91 ---- var TempWParam, TempLParam: Longint; + Proc: Pointer; begin ! TStdWndProcDef(Proc) := WndProcConvertW2U(lpPrevWndFunc, StdWndProcInterceptU2W, StdWndProcInterceptW2U); ! ! MessageU2WBefore(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, TStdWndProcDef(Proc)); ! Result := CallWindowProcW(Proc, hWnd, Msg, TempWParam, TempLParam); ! Result := MessageU2WAfter(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, Result, TStdWndProcDef(Proc)); end; *************** *** 139,143 **** WndClassW.lpfnWndProc := WndProcConvertW2U(WndClassA.lpfnWndProc, Pointer(@StdWndProcInterceptU2W), Pointer(@StdWndProcInterceptW2U)); - //WndClassW.hInstance := hInstance; // the WndProc is now in this module WndClassW.lpszMenuName := ConvertFromUTF8(WndClassA.lpszMenuName); WndClassW.lpszClassName := ConvertFromUTF8(WndClassA.lpszClassName); --- 131,134 ---- *************** *** 159,163 **** WndClassW.lpfnWndProc := WndProcConvertW2U(WndClassA.lpfnWndProc, Pointer(@StdWndProcInterceptU2W), Pointer(@StdWndProcInterceptW2U)); - //WndClassW.hInstance := hInstance; // the WndProc is now in this module WndClassW.lpszMenuName := ConvertFromUTF8(WndClassA.lpszMenuName); WndClassW.lpszClassName := ConvertFromUTF8(WndClassA.lpszClassName); --- 150,153 ---- *************** *** 259,264 **** begin Proc := WndProcConvertW2U(Pointer(dwNewLong), Pointer(@StdWndProcInterceptU2W), Pointer(@StdWndProcInterceptW2U)); ! SetWindowLongW(hWnd, nIndex, Integer(Proc)); ! Result := dwNewLong; end else --- 249,254 ---- begin Proc := WndProcConvertW2U(Pointer(dwNewLong), Pointer(@StdWndProcInterceptU2W), Pointer(@StdWndProcInterceptW2U)); ! Proc := Pointer(SetWindowLongW(hWnd, nIndex, Integer(Proc))); ! Result := Integer(WndProcConvertU2W(Pointer(Proc), Pointer(@StdWndProcInterceptU2W), Pointer(@StdWndProcInterceptW2U))); end else *************** *** 299,303 **** C := ConvertFromUTF8(lpClassName) else ! // (rom) suspicious. The string stays ANSI. GetClassInfoW may complain. C := PWideChar(lpClassName); try --- 289,293 ---- C := ConvertFromUTF8(lpClassName) else ! // This isn't a string but a special id C := PWideChar(lpClassName); try *************** *** 326,330 **** C := ConvertFromUTF8(ClassName) else ! // (rom) suspicious. The string stays ANSI. GetClassInfoExW may complain. C := PWideChar(ClassName); try --- 316,320 ---- C := ConvertFromUTF8(ClassName) else ! // This isn't a string but a special id C := PWideChar(ClassName); try *************** *** 359,362 **** --- 349,370 ---- end; + function DefMDIChildProcAIntercept(hWnd: HWND; Msg: UINT; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall; + var + TempWParam, TempLParam: Longint; + begin + MessageU2WBefore(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, Pointer(nil)); + Result := DefMDIChildProcW(hWnd, Msg, TempWParam, TempLParam); + Result := MessageU2WAfter(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, Result, Pointer(nil)); + end; + + function DefDlgProcAIntercept(hWnd: HWND; Msg: UINT; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall; + var + TempWParam, TempLParam: Longint; + begin + MessageU2WBefore(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, Pointer(@DefDlgProcW)); + Result := DefDlgProcW(hWnd, Msg, TempWParam, TempLParam); + Result := MessageU2WAfter(hWnd, Msg, WParam, LParam, TempWParam, TempLParam, Result, Pointer(@DefDlgProcW)); + end; + function GetWindowTextAIntercept(hWnd: HWND; lpString: PAnsiChar; nMaxCount: Integer): Integer; stdcall; var *************** *** 442,445 **** --- 450,567 ---- end; + function GetOpenFileNameAIntercept(var OpenFileA: TOpenFilenameA): Bool; stdcall; + + function ConvertFilterStringFrom(const S: PChar): PChar; + var + I, L: Integer; + P: Boolean; + begin + L := 0; + P := False; + while Assigned(S) and not (P and (S[L] = #0)) do + begin + P := S[L] = #0; + Inc(L); + end; + if L = 0 then + begin + Result := nil; + Exit; + end + else + begin + Inc(L); + GetMem(Result, L); + for I := 0 to L-2 do + begin + if S[I] = #0 then + Result[I] := #1 + else + Result[I] := S[I]; + end; + Result[L-1] := #0; + end; + end; + + procedure ConvertFilterStringTo(S: PWideChar); + var + I: Integer; + begin + I := 0; + while Assigned(S) and (S[I] <> #0) do + begin + if S[I] = #1 then + S[I] := #0; + Inc(i); + end; + end; + + var + OpenFileW: TOpenFilenameW; + X: PChar; + S: PChar; + L: Integer; + begin + Move(OpenFileA, OpenFileW, SizeOf(TOpenFilenameA)); + + X := nil; + S := nil; + + OpenFileW.lpstrFilter := nil; + OpenFileW.lpstrInitialDir := nil; + OpenFileW.lpstrTitle := nil; + OpenFileW.lpstrDefExt := nil; + OpenFileW.lpstrCustomFilter := nil; + OpenFileW.lpstrFile := nil; + OpenFileW.lpstrFileTitle := nil; + OpenFileW.lpTemplateName := nil; + try + + S := ConvertFilterStringFrom(OpenFileA.lpstrFilter); + OpenFileW.lpstrFilter := ConvertFromUTF8(S); + ConvertFilterStringTo(OpenFileW.lpstrFilter); + + OpenFileW.lpstrInitialDir := ConvertFromUTF8(OpenFileA.lpstrInitialDir); + OpenFileW.lpstrTitle := ConvertFromUTF8(OpenFileA.lpstrTitle); + OpenFileW.lpstrDefExt := ConvertFromUTF8(OpenFileA.lpstrDefExt); + OpenFileW.lpTemplateName := ConvertFromUTF8(OpenFileA.lpTemplateName); + + OpenFileW.lpstrFile := ConvertFromUTF8(OpenFileA.lpstrFile); + if OpenFileA.nMaxFile <> 0 then + ReallocMem(OpenFileW.lpstrFile, OpenFileA.nMaxFile*2 + 4); + OpenFileW.lpstrCustomFilter := ConvertFromUTF8(OpenFileA.lpstrCustomFilter); + if OpenFileA.nMaxCustFilter <> 0 then + ReallocMem(OpenFileW.lpstrCustomFilter, OpenFileA.nMaxCustFilter*2 + 4); + OpenFileW.lpstrFileTitle := ConvertFromUTF8(OpenFileA.lpstrFileTitle); + if OpenFileA.nMaxFileTitle <> 0 then + ReallocMem(OpenFileW.lpstrFileTitle, OpenFileA.nMaxFileTitle*2 + 4); + + OpenFileW.lpfnHook := WndProcConvertW2U(Pointer(@OpenFileA.lpfnHook), + Pointer(@StdWndProcInterceptU2W), Pointer(@StdWndProcInterceptW2U)); + + Result := GetOpenFileNameW(OpenFileW); + + X := ConvertToUTF8(OpenFileW.lpstrFile, -1, L); + CopyMemory(OpenFileA.lpstrFile, X, L+1); + FreeMem(X); + X := ConvertToUTF8(OpenFileW.lpstrCustomFilter, -1, L); + CopyMemory(OpenFileA.lpstrCustomFilter, X, L+1); + FreeMem(X); + X := ConvertToUTF8(OpenFileW.lpstrFileTitle, -1, L); + CopyMemory(OpenFileA.lpstrFileTitle, X, L+1); + finally + FreeMem(S); + FreeMem(X); + FreeMem(OpenFileW.lpstrFilter); + FreeMem(OpenFileW.lpstrInitialDir); + FreeMem(OpenFileW.lpstrTitle); + FreeMem(OpenFileW.lpstrDefExt); + FreeMem(OpenFileW.lpstrFile); + FreeMem(OpenFileW.lpstrCustomFilter); + FreeMem(OpenFileW.lpstrFileTitle); + FreeMem(OpenFileW.lpTemplateName); + end; + end; + procedure FatalAppExitAIntercept(uAction: UINT; lpMessageText: PAnsiChar); stdcall; var *************** *** 459,462 **** --- 581,588 ---- LibGdi32: HMODULE = 0; LibKernel32: HMODULE = 0; + LibCommdlg32: HMODULE = 0; + + const + commdlg32 = 'comdlg32.dll'; function HookFunc(const FunctionName: PChar; NewFunc: Pointer; var Module: HMODULE; const ModuleName: PChar): Pointer; *************** *** 486,489 **** --- 612,620 ---- end; + function HookCommdlg32Func(const FunctionName: PChar; NewFunc: Pointer): Pointer; + begin + Result := HookFunc(FunctionName, NewFunc, LibCommdlg32, commdlg32); + end; + var ActiveState: Boolean = False; *************** *** 512,516 **** --- 643,651 ---- HookUser32Func('IsWindowUnicode', @IsWindowUnicodeIntercept); // do not localize HookUser32Func('GetWindowLongA', @GetWindowLongAIntercept); // do not localize + HookUser32Func('DefWindowProcA', @DefWindowProcAIntercept); // do not localize + HookUser32Func('DefMDIChildProcA', @DefMDIChildProcAIntercept); // do not localize + HookUser32Func('DefDlgProcA', @DefDlgProcAIntercept); // do not localize + HookUser32Func('GetWindowTextA', @GetWindowTextAIntercept); // do not localize HookUser32Func('InsertMenuA', @InsertMenuAIntercept); // do not localize *************** *** 525,528 **** --- 660,665 ---- HookKernel32Func('OutputDebugStringA', @OutputDebugStringAIntercept); // do not localize HookKernel32Func('FatalAppExitA', @FatalAppExitAIntercept); // do not localize + + HookCommdlg32Func('GetOpenFileNameA', @GetOpenFileNameAIntercept); // do not localize end else Index: TestForm.dfm =================================================================== RCS file: /cvsroot/utf8vcl/utf8vcl/TestForm.dfm,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** TestForm.dfm 18 Mar 2007 07:56:10 -0000 1.12 --- TestForm.dfm 18 Mar 2007 11:26:40 -0000 1.13 *************** *** 39,43 **** TabOrder = 0 Text = 'Edit1' - OnChange = Edit1Change end object Memo1: TMemo --- 39,42 ---- *************** *** 242,244 **** --- 241,252 ---- end end + object OpenDialog1: TOpenDialog + DefaultExt = 'OpenDialog1' + FileName = 'OpenDialog1' + Filter = 'OpenDialog1' + InitialDir = 'OpenDialog1' + Title = 'OpenDialog1' + Left = 8 + Top = 336 + end end Index: TestForm.pas =================================================================== RCS file: /cvsroot/utf8vcl/utf8vcl/TestForm.pas,v retrieving revision 1.17 retrieving revision 1.18 diff -C2 -d -r1.17 -r1.18 *** TestForm.pas 18 Mar 2007 07:56:10 -0000 1.17 --- TestForm.pas 18 Mar 2007 11:26:40 -0000 1.18 *************** *** 40,47 **** ValueListEditor1: TValueListEditor; Panel1: TPanel; procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); - procedure Edit1Change(Sender: TObject); public end; --- 40,47 ---- ValueListEditor1: TValueListEditor; Panel1: TPanel; + OpenDialog1: TOpenDialog; procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); public end; *************** *** 146,149 **** --- 146,151 ---- Content: string; begin + OpenDialog1.Execute; + Content := Menu1.Caption; Content := menuItem1.Caption; *************** *** 261,269 **** end; - procedure TForm1.Edit1Change(Sender: TObject); - begin - Sender := Sender; - end; - end. --- 263,266 ---- |
