【DirectX9 Get shader bytecode-】
I hook DrawIndexedPrimitive
HookCode(PPointer(g_DeviceBaseAddr + $148)^,#NewDrawIndexedPrimitive, #OldDrawIndexedPrimitive);
function NewDrawIndexedPrimitive(const Device:IDirect3DDevice9;_Type: TD3DPrimitiveType; BaseVertexIndex: Integer; MinVertexIndex, NumVertices, startIndex, primCount: LongWord): HResult; stdcall;
var
ppShader: IDirect3DVertexShader9;
_Code:Pointer;
_CodeLen:Cardinal;
begin
Device.GetVertexShader(ppShader);//<------1.Get ShaderObject(ppShader)
ppShader.GetFunction(nil,_CodeLen);
GetMem(_Code,_CodeLen);
ppShader.GetFunction(_Code,_CodeLen);//<----2.Get bytecode from ShaderObject(ppShader)
Result:=OldDrawIndexedPrimitive(Self,_Type,BaseVertexIndex,MinVertexIndex, NumVertices, startIndex, primCount);
end;
【How to DirectX11 Get VSShader bytecode?】
I hook DrawIndexed
pDrawIndexed:=PPointer(PUINT_PTR(UINT_PTR(g_ImmContext)+0)^ + 12 * SizeOf(Pointer))^;
HookCode(pDrawIndexed,#NewDrawIndexed,#OldDrawIndexed);
procedure NewDrawIndexed(g_Real_ImmContext:ID3D11DeviceContext;IndexCount: UINT;StartIndexLocation: UINT;BaseVertexLocation: Integer); stdcall;
var
game_pVertexShader: ID3D11VertexShader;
ppClassInstances: ID3D11ClassInstance;
NumClassInstances: UINT
begin
g_Real_ImmContext.VSGetShader(game_pVertexShader,ppClassInstances,NumClassInstances); //<------1.Get ShaderObject(game_pVertexShader)
.....//<----【2.Here's how to get bytecode from ShaderObject(game_pVertexShader)?】
OldDrawIndexed(ImmContext, IndexCount, StartIndexLocation, BaseVertexLocation);
end;
Another way:
HOOK CreateVertexShader()
but
HOOK need to be created before the game CreateVertexShader, HOOK will not get bytecode if the game is running later,I need to get bytecode at any time like DirectX9
Related
I have an application that spawns multiple CreateProcess threads and I'm successfully redirecting the stdout and stderr output to text files for each one.
However, I've discovered the feature whereby the stdout/strderr handles are inherited by all such threads and not just the ones I want them to be inherited by. So I've embarked on a journey to use the InitializeProcThreadAttributeList, UpdateProcThreadAttribute functions and EXTENDED_STARTUPINFO_PRESENT and a STARTUPINFOEX structure in the CreateProcess function to get around this but I'm stuck.
If I use PROC_THREAD_ATTRIBUTE_HANDLE_LIST as the Attribute argument in UpdateProcThreadAttribute procedure it expects the lpValue parameter to be a pointer to a list of handles to be inherited by the child process.
For the List I've tried using a
TList<Cardinal>
and also creating an array of Cardinals but couldn't get either approaches to compile!
Question: How do I create and populate such a list?
Secondly, in this example it is using the functions and procedures from kernel32.dll but they also exist in the Windows unit too (I'm using Delphi 10.3) although the definitions differ:
For example, InitializeProcThreadAttributeList( nil, 1, 0, vAListSize ); won't compile using the Windows unit due to the nil argument because Types of actual and formal var parameters must be identical but I have no such issue using the one in kernel32
Question: Which version of these functions/procedures should I be using?
Thanks.
In case it is useful, here's my code to implement all of this:
type
TStartupInfoEx = record
StartupInfo: TStartupInfo;
lpAttributeList: Pointer;
end;
const
PROC_THREAD_ATTRIBUTE_HANDLE_LIST = $00020002;
function InitializeProcThreadAttributeList(
lpAttributeList: Pointer;
dwAttributeCount: DWORD;
dwFlags: DWORD;
var lpSize: SIZE_T
): BOOL; stdcall; external kernel32;
function UpdateProcThreadAttribute(
lpAttributeList: Pointer;
dwFlags: DWORD;
Attribute: DWORD_PTR;
lpValue: Pointer;
cbSize: SIZE_T;
lpPreviousValue: PPointer;
lpReturnSize: PSIZE_T
): BOOL; stdcall; external kernel32;
function DeleteProcThreadAttributeList(
lpAttributeList: Pointer
): BOOL; stdcall; external kernel32;
function CreateProcessWithInheritedHandles(
lpApplicationName: LPCWSTR;
lpCommandLine: LPWSTR;
lpProcessAttributes,
lpThreadAttributes: PSecurityAttributes;
const Handles: array of THandle;
dwCreationFlags: DWORD;
lpEnvironment: Pointer;
lpCurrentDirectory: LPCWSTR;
const lpStartupInfo: TStartupInfo;
var lpProcessInformation: TProcessInformation
): Boolean;
var
i: Integer;
StartupInfoEx: TStartupInfoEx;
size: SIZE_T;
begin
Assert(Length(Handles)>0);
StartupInfoEx.StartupInfo := lpStartupInfo;
StartupInfoEx.StartupInfo.cb := SizeOf(StartupInfoEx);
StartupInfoEx.lpAttributeList := nil;
Win32Check(not InitializeProcThreadAttributeList(nil, 1, 0, size) and (GetLastError=ERROR_INSUFFICIENT_BUFFER));
GetMem(StartupInfoEx.lpAttributeList, size);
try
Win32Check(InitializeProcThreadAttributeList(StartupInfoEx.lpAttributeList, 1, 0, size));
try
Win32Check(UpdateProcThreadAttribute(
StartupInfoEx.lpAttributeList,
0,
PROC_THREAD_ATTRIBUTE_HANDLE_LIST,
#Handles[0],
Length(Handles) * SizeOf(Handles[0]),
nil,
nil
));
for i := 0 to High(Handles) do begin
Win32Check(SetHandleInformation(Handles[i], HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERIT));
end;
Result := CreateProcess(
lpApplicationName,
lpCommandLine,
lpProcessAttributes,
lpThreadAttributes,
True,
dwCreationFlags,
lpEnvironment,
lpCurrentDirectory,
StartupInfoEx.StartupInfo,
lpProcessInformation
);
finally
DeleteProcThreadAttributeList(StartupInfoEx.lpAttributeList);
end;
finally
FreeMem(StartupInfoEx.lpAttributeList);
end;
end;
From your post it would seem that there are some declarations of InitializeProcThreadAttributeList, UpdateProcThreadAttribute and DeleteProcThreadAttributeList in the Windows unit in the latest versions of Delphi, but your post implies that they are incorrectly declared. The above code is known to work correctly.
I would like to call SPSS 'backend' from Delphi. There is a DLL that I can use (it seems): SPSSio64.DLL. But I can not find the interface definition.
What I have found is an example in PowerBasic:
Read and write SPSS sav files
DECLARE FUNCTION spssOpenRead LIB "spssio32.dll" ALIAS "spssOpenRead#8" (BYVAL fileName AS STRING, BYREF hHandle AS LONG) AS LONG
DECLARE FUNCTION spssCloseRead LIB "spssio32.dll" ALIAS "spssCloseRead#4" (BYVAL hHandle AS LONG) AS LONG
Since I only need functions to read and write a file (all the processing will be done via a syntax in that file), I thought that this example might be enough to deduce how to call equivalent functions from Delphi.
So the question is: how would these declarations be in Delphi (64-bit)?
Based on the SPSS 14.0 for Windows Developer's Guide, and PowerBasic documentation, try something like this:
32-bit:
// spssio32.dll exports both 'spssOpenRead' and 'spssOpenRead#8', which are the same function...
function spssOpenRead(filename: PAnsiChar; var hHandle: Integer): Integer; stdcall; external 'spssio32.dll' {name 'spssOpenRead#8'};
// spssio32.dll exports both 'spssCloseRead' and 'spssCloseRead#4', which are the same function...
function spssCloseRead(hHandle: Integer): Integer; stdcall; external 'spssio32.dll' {name 'spssCloseRead#4'};
64-bit:
// I can't find a copy of spssio64.dll to download, so I can't verify the exported names. Adjust if needed..
function spssOpenRead(filename: PAnsiChar; var hHandle: Integer): Integer; stdcall; external 'spssio64.dll' {name 'spssOpenRead#16'};
function spssCloseRead(hHandle: Integer): Integer; stdcall; external 'spssio64.dll' {name 'spssCloseRead#8'};
For the record, this works:
function LoadDLL(DLLname : string) : Uint64;
var
em : TArithmeticExceptionMask;
begin
em:=GetExceptionmask;
SetExceptionmask(em+[exInvalidOp,exZeroDivide,exOverflow,exUnderflow]);
result:=LoadLibrary(PwideChar(DLLname));
SetExceptionmask(em);
end;
function RunSPSSio(filename : string; instructions : Tinstructions) : boolean;
// This will only read SAV files, not SPS files !
type
TspssOpenRead = function (filename: PAnsiChar; var hHandle: Uint64): Integer;
TspssCloseRead = function(hHandle: Uint64): Integer;
TspssGetInterfaceEncoding = function(hHandle : Uint64): Integer;
TspssSetInterfaceEncoding = function(encoding : integer; hHandle : Uint64): Integer;
const
SPSS_ENCODING_UTF8 = 1;
var
p : integer;
spssOpenRead : TspssOpenRead;
spssCloseRead : TspssCloseRead;
spssGetIFencoding : TspssGetInterfaceEncoding;
spssSetIFencoding : TspssSetInterfaceEncoding;
DLLhandle : Uint64;
fileref : PANSIchar;
begin
result:=false;
DLLhandle:=LoadDLL('C:\SPSS\spssio64.dll'); // hardcoded
if DLLhandle=0
then begin p:=GetLastError();
report('DLL load error '+IntToStr(p));
exit;
end;
try
#SPSSopenRead:=getProcAddress(DLLhandle,'spssOpenRead');
#SPSScloseRead:=getProcAddress(DLLhandle,'spssCloseRead');
#SPSSsetIFencoding:=getProcAddress(DLLhandle,'spssSetInterfaceEncoding');
SPSSsetIFencoding(SPSS_ENCODING_UTF8,DLLhandle);
fileref:=PANSIchar(ANSIstring(filename));
p:=SPSSopenRead(fileref,DLLhandle);
if p<>0
then report('*** SPSSio error '+IntToStr(p))
else begin // SPSS database interactions here
result:=SPSScloseRead(DLLhandle)=0;
end;
finally
freeLibrary(DLLhandle);
end;
end;
How can I see if windows explorer is already opened with certain path ? I don't want my application opens many duplicated windows. I was unable to do it with this way :
var
H: hwnd;
begin
if FileExists(edt8.Text) then
begin
H := FindWindow(0, PChar(ExtractFilePath(edt8.Text)));
if H <> 0 then
ShowMessage('explorer already opened')//explorer bring to front
else
ShellExecute(Application.Handle, nil, 'explorer.exe',
PChar(ExtractFilePath(edt8.Text)), nil, SW_NORMAL);
end;
end;
IShellWindows::FindWindowSW method
There is a nice method FindWindowSW that should find an existing Shell window, which includes Windows Explorer windows as well, I'd say. So, in a hope I'll find an existing window easily I wrote this code:
uses
ActiveX, ShlObj, SHDocVw, ComObj;
function IDListFromPath(const Path: WideString): PItemIDList;
var
Count: ULONG;
Attributes: ULONG;
ShellFolder: IShellFolder;
begin
OleCheck(SHGetDesktopFolder(ShellFolder));
OleCheck(ShellFolder.ParseDisplayName(0, nil, PWideChar(Path), Count, Result, Attributes));
end;
function GetExplorerHandle(const Path: WideString): HWND;
var
IDList: PItemIDList;
Unused: OleVariant;
Location: OleVariant;
ShellWindows: IShellWindows;
begin
OleCheck(CoCreateInstance(CLASS_ShellWindows, nil, CLSCTX_LOCAL_SERVER, IID_IShellWindows, ShellWindows));
Unused := Unassigned;
IDList := IDListFromPath(Path);
PVariantArg(#Location).vt := VT_VARIANT or VT_BYREF;
PVariantArg(#Location).pvarVal := PVariant(IDList);
ShellWindows.FindWindowSW(Location, Unused, SWC_EXPLORER, Integer(Result), SWFO_INCLUDEPENDING);
end;
But it never finds the Windows Explorer window with the given folder path (it always returns 0). I've used SWC_EXPLORER class to search only for Windows Explorer windows, build the absolute ID list, used a proper VT_VARIANT | VT_BYREF variant for location (at least I hope so, if not, please let me know). And I also tried to return IDispatch by including the SWFO_NEEDDISPATCH option (method always returned nil reference). So I gave up on this method (haven't found any example).
IShellWindows enumeration
The following code was inspired by this article and this example. Here is a scheme:
1. IShellWindows.Item(n)
2. ⤷ IDispatch.QueryInterface(IWebBrowserApp)
3. ⤷ IWebBrowserApp.QueryInterface(IServiceProvider)
4. ⤷ IServiceProvider.QueryService(STopLevelBrowser, IShellBrowser)
5. ⤷ IShellBrowser.QueryActiveShellView
6. ⤷ IShellView.QueryInterface(IFolderView)
7. ⤷ IFolderView.GetFolder(IPersistFolder2)
8. ⤷ IPersistFolder2.GetCurFolder
9. ⤷ ITEMIDLIST
And some description:
As first you obtain the IShellWindows interface reference and iterate its items.
For each item, the IShellWindows interface returns window's IDispatch interface which you then query for an IWebBrowserApp interface reference.
The obtained IWebBrowserApp interface (for documentation refer to IWebBrowser2, as it's their implementation) provides except others also the information about the host window, like handle which can be later used for bringing the window to foreground. We need to go deeper though. So let's query this interface reference for the IServiceProvider interface (which is an accessor for getting interfaces for the given service).
Now from the top-most browser implementation service query its IShellBrowser interface. A reference of this interface is still not interesting for our aim.
The obtained IShellBrowser query for the displayed Shell view object.
Now we can finally say, if the iterated Shell window is not an Internet Explorer window. So far they were having common interfaces implemented. Now if we query the obtained IShellView for the IFolderView interface and it succeeds, it is not Internet Explorer and we can continue.
Query the obtained IFolderView reference for the IPersistFolder2 interface for the currently displayed folder object.
If we succeeded even there and we got IPersistFolder2 reference, let's get the ITEMIDLIST for the current folder object.
And if we succeeded even with this last step, we have ITEMIDLIST of the currently displayed folder of a Windows Explorer instance (or the same interface implementor) and we can finally check if the obtained ITEMIDLIST equals to the one we parsed for the input path. If so, bring that window to foreground, if not, continue to the next iteration.
And here is a Delphi code. I don't know how much do you need for your Delphi version; this was a bare minimum I've needed for D2009 (manually translated from Windows SDK 10.0.15063.0). It's not a best example; in real code you may prefer wrapping this into a class and have more flexible interface, but that's upon your design preference. And finally, if you have Delphi newer than 2009, you may not need the imported prototypes, if older, you might be missing some:
uses
ActiveX, ShlObj, SHDocVw, ComObj;
{ because of Win32Check }
{$WARN SYMBOL_PLATFORM OFF}
const
IID_IFolderView: TGUID = '{CDE725B0-CCC9-4519-917E-325D72FAB4CE}';
IID_IPersistFolder2: TGUID = '{1AC3D9F0-175C-11D1-95BE-00609797EA4F}';
IID_IServiceProvider: TGUID = '{6D5140C1-7436-11CE-8034-00AA006009FA}';
SID_STopLevelBrowser: TGUID = '{4C96BE40-915C-11CF-99D3-00AA004AE837}';
type
IFolderView = interface(IUnknown)
['{CDE725B0-CCC9-4519-917E-325D72FAB4CE}']
function GetCurrentViewMode(out pViewMode: UINT): HRESULT; stdcall;
function SetCurrentViewMode(ViewMode: UINT): HRESULT; stdcall;
function GetFolder(const riid: TIID; out ppv): HRESULT; stdcall;
function Item(iItemIndex: Integer; out ppidl: PItemIDList): HRESULT; stdcall;
function ItemCount(uFlags: UINT; out pcItems: Integer): HRESULT; stdcall;
function Items(uFlags: UINT; const riid: TIID; out ppv): HRESULT; stdcall;
function GetSelectionMarkedItem(out piItem: Integer): HRESULT; stdcall;
function GetFocusedItem(out piItem: Integer): HRESULT; stdcall;
function GetItemPosition(pidl: PItemIDList; out ppt: TPoint): HRESULT; stdcall;
function GetSpacing(var ppt: TPoint): HRESULT; stdcall;
function GetDefaultSpacing(out ppt: TPoint): HRESULT; stdcall;
function GetAutoArrange: HRESULT; stdcall;
function SelectItem(iItem: Integer; dwFlags: DWORD): HRESULT; stdcall;
function SelectAndPositionItems(cidl: UINT; var apidl: PItemIDList; var apt: TPoint; dwFlags: DWORD): HRESULT; stdcall;
end;
EShObjectNotFolder = class(Exception);
function ILGetSize(pidl: PItemIDList): UINT; stdcall;
external 'shell32.dll' name 'ILGetSize';
function ILIsEqual(pidl1: PItemIDList; pidl2: PItemIDList): BOOL; stdcall;
external 'shell32.dll' name 'ILIsEqual';
function InitVariantFromBuffer(pv: Pointer; cb: UINT; out pvar: OleVariant): HRESULT; stdcall;
external 'propsys.dll' name 'InitVariantFromBuffer';
function CoAllowSetForegroundWindow(pUnk: IUnknown; lpvReserved: Pointer): HRESULT; stdcall;
external 'ole32.dll' name 'CoAllowSetForegroundWindow';
resourcestring
rsObjectNotFolder = 'Object "%s" is not a folder.';
{ this parses the input folder path and creates ITEMIDLIST structure if the given
folder path is a valid absolute path to an existing folder }
function GetFolderIDList(const Folder: string): PItemIDList;
const
SFGAO_STREAM = $00400000;
var
Count: ULONG;
Attributes: ULONG;
ShellFolder: IShellFolder;
begin
OleCheck(SHGetDesktopFolder(ShellFolder));
Attributes := SFGAO_FOLDER or SFGAO_STREAM;
OleCheck(ShellFolder.ParseDisplayName(0, nil, PWideChar(WideString(Folder)), Count, Result, Attributes));
if not ((Attributes and SFGAO_FOLDER = SFGAO_FOLDER) and (Attributes and SFGAO_STREAM <> SFGAO_STREAM)) then
begin
CoTaskMemFree(Result);
raise EShObjectNotFolder.CreateFmt(rsObjectNotFolder, [Folder]);
end;
end;
{ translated from the link mentioned in this comment; D2009 does not allow me to
create an OleVariant of type VT_ARRAY|VT_UI1 which is needed for the Navigate2
method so I've imported and used the InitVariantFromBuffer function here
https://msdn.microsoft.com/en-us/library/windows/desktop/gg314982(v=vs.85).aspx }
procedure OpenNewExplorer(IDList: PItemIDList);
var
Location: OleVariant;
WebBrowser: IWebBrowser2;
begin
OleCheck(CoCreateInstance(CLASS_ShellBrowserWindow, nil, CLSCTX_LOCAL_SERVER, IID_IWebBrowser2, WebBrowser));
OleCheck(CoAllowSetForegroundWindow(WebBrowser, nil));
OleCheck(InitVariantFromBuffer(IDList, ILGetSize(IDList), Location));
try
WebBrowser.Navigate2(Location, Unassigned, Unassigned, Unassigned, Unassigned);
finally
VariantClear(Location);
end;
WebBrowser.Visible := True;
end;
{ translated from the link mentioned in this comment
https://blogs.msdn.microsoft.com/oldnewthing/20040720-00/?p=38393 }
procedure BrowseInExplorer(const Folder: string);
var
I: Integer;
WndIface: IDispatch;
ShellView: IShellView;
FolderView: IFolderView;
SrcFolderID: PItemIDList;
CurFolderID: PItemIDList;
ShellBrowser: IShellBrowser;
ShellWindows: IShellWindows;
WebBrowserApp: IWebBrowserApp;
PersistFolder: IPersistFolder2;
ServiceProvider: IServiceProvider;
begin
SrcFolderID := GetFolderIDList(Folder);
try
OleCheck(CoCreateInstance(CLASS_ShellWindows, nil, CLSCTX_LOCAL_SERVER, IID_IShellWindows, ShellWindows));
{ iterate all Shell windows }
for I := 0 to ShellWindows.Count - 1 do
begin
WndIface := ShellWindows.Item(VarAsType(I, VT_I4));
{ do not use OleCheck here; windows like Internet Explorer do not implement
all the interfaces; it is the way to distinguish Windows Explorer windows
actually; so let's get all the references and if we succeed, check if the
obtained folder equals to the passed one; if so, bring that window to top
and exit this procedure }
if Assigned(WndIface) and
Succeeded(WndIface.QueryInterface(IID_IWebBrowserApp, WebBrowserApp)) and
Succeeded(WebBrowserApp.QueryInterface(IID_IServiceProvider, ServiceProvider)) and
Succeeded(ServiceProvider.QueryService(SID_STopLevelBrowser, IID_IShellBrowser, ShellBrowser)) and
Succeeded(ShellBrowser.QueryActiveShellView(ShellView)) and
Succeeded(ShellView.QueryInterface(IID_IFolderView, FolderView)) and
Succeeded(FolderView.GetFolder(IID_IPersistFolder2, PersistFolder)) and
Succeeded(PersistFolder.GetCurFolder(CurFolderID)) and
ILIsEqual(SrcFolderID, CurFolderID) then
begin
{ restore the window if minimized, try to bring it to front and exit this
procedure }
if IsIconic(WebBrowserApp.HWnd) then
Win32Check(ShowWindow(WebBrowserApp.HWnd, SW_RESTORE));
{$IFNDEF IBelieveThatIWebBrowserAppVisiblePropertyBringsWindowToFront}
Win32Check(SetForegroundWindow(WebBrowserApp.HWnd));
{$ELSE}
OleCheck(CoAllowSetForegroundWindow(WebBrowserApp, nil));
WebBrowserApp.Visible := True;
{$ENDIF}
Exit;
end;
end;
{ the procedure was not exited, hence an existing window was not found, so go
and open the new one }
OpenNewExplorer(SrcFolderID);
finally
CoTaskMemFree(SrcFolderID);
end;
end;
{$WARN SYMBOL_PLATFORM ON}
Possible usage:
BrowseInExplorer('C:\MyFolder');
Using Delphi XE2 update 3 or update 4 on Win7 64 bit.
Calling enumwindows does not work like it used to work in Delphi 6.
In Delphi 6 enumwindows processed windows until the callback function returned False. That is what the documentation says it should do:
"To continue enumeration, the callback function must return TRUE; to stop enumeration, it must return FALSE."
Making a call to enumwindows as follows:
procedure TForm1.Button1Click(Sender: TObject);
begin
EnumWindows(#FindMyWindow,0);
if GLBWindowHandle <> 0 then begin
ShowMessage('found');
end;
end;
Here is the callback function:
function FindMyWindow(hWnd: HWND; lParam: LPARAM): boolean; stdcall;
var TheText : array[0..150] of char;
str : string;
begin
Result := True;
GLBWindowHandle := 0;
if (GetWindowText(hWnd, TheText, 150) <> 0) then
begin
str := TheText;
if str = 'Form1' then
begin
GLBWindowHandle := hWnd;
Result := False;
end
else
result := True;
end;
end;
Just to be clear the callback function is defined in code BEFORE the buttonclick event so it is found by the compiler without needing to be defined in the interface section.
If this is run using Delphi 6 the enumeration of windows stops once the False result is returned and GLBWindowHandle is not zero
If this is run using Delphi XE2 the enumeration continues after the False result is returned and GLBWindowHandle is always zero.
WTF? Anybody have any ideas why the enumeration is not stopping like the documentation states it should and how it used to in Delphi 6?
Cheers!
This declaration is incorrect:
function FindMyWindow(hWnd: HWND; lParam: LPARAM): boolean; stdcall;
It should be:
function FindMyWindow(hWnd: HWND; lParam: LPARAM): BOOL; stdcall;
You have to be careful not to mix up Boolean and BOOL since they are not the same thing. The former is a single byte, the latter is 4 bytes. This mismatch between what EnumWindows expects and what your callback function delivers is enough to cause the behaviour you observe.
In addition, Rob Kennedy contributed this excellent comment:
The compiler can help find this error if you get out of the habit of using the # operator before the function name when you call EnumWindows. If the function signature is compatible, the compiler will let you use it without #. Using # turns it into a generic pointer, and that's compatible with everything, so the error is masked by unnecessary syntax. In short, using # to create function pointers should be considered a code smell.
Discussion
Unfortunately the Windows.pas header translation defines EnumWindows in a most unhelpful manner, like this:
function EnumWindows(lpEnumFunc: TFNWndEnumProc; lParam: LPARAM): BOOL; stdcall;
Now, the problem is in the definition of TFNWndEnumProc. It is defined as:
TFarProc = Pointer;
TFNWndEnumProc = TFarProc;
This means that you have to use the # operator to make a generic pointer, because the function needs a generic pointer. If TFNWndEnumProc were declared like this:
TFNWndEnumProc = function(hWnd: HWND; lParam: LPARAM): BOOL; stdcall;
then the compiler would have been able to find the error.
type
TFNWndEnumProc = function(hWnd: HWND; lParam: LPARAM): BOOL; stdcall;
function EnumWindows(lpEnumFunc: TFNWndEnumProc;
lParam: LPARAM): BOOL; stdcall; external 'user32';
function FindMyWindow(hWnd: HWND; lParam: LPARAM): Boolean; stdcall;
begin
Result := False;
end;
....
EnumWindows(FindMyWindow, 0);
The compiler rejects the call to EnumWindows with the following error:
[DCC Error] Unit1.pas(38): E2010 Incompatible types: 'LongBool' and 'Boolean'
I think I will QC this issue and try my luck at persuading Embarcadero to stop using TFarProc.
Does anyone know a 100% clone of the C/C++ printf for Delphi?
Yes, I know the System.Format function, but it handles things a little different.
For example if you want to format 3 to "003" you need "%03d" in C, but "%.3d" in Delphi.
I have an application written in Delphi which has to be able to format numbers using C format strings, so do you know a snippet/library for that?
Thanks in advance!
You could use the wsprintf() function from Windows.pas. Unfortunately this function is not declared correctly in the Windows.pas so here is a redeclaration:
function wsprintf(Output: PChar; Format: PChar): Integer; cdecl; varargs;
external user32 name {$IFDEF UNICODE}'wsprintfW'{$ELSE}'wsprintfA'{$ENDIF};
procedure TForm1.FormCreate(Sender: TObject);
var
S: String;
begin
SetLength(S, 1024); // wsprintf can work only with max. 1024 characters
SetLength(S, wsprintf(PChar(S), '%s %03d', 'Hallo', 3));
end;
If you want to let the function look more Delphi friendly to the user, you could use the following:
function _FormatC(const Format: string): string; cdecl;
const
StackSlotSize = SizeOf(Pointer);
var
Args: va_list;
Buffer: array[0..1024] of Char;
begin
// va_start(Args, Format)
Args := va_list(PAnsiChar(#Format) + ((SizeOf(Format) + StackSlotSize - 1) and not (StackSlotSize - 1)));
SetString(Result, Buffer, wvsprintf(Buffer, PChar(Format), Args));
end;
const // allows us to use "varargs" in Delphi
FormatC: function(const Format: string): string; cdecl varargs = _FormatC;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(FormatC('%s %03d', 'Hallo', 3));
end;
It's not recommended to use (ws)printf since they are prone to buffer overflow, it would be better to use the safe variants (eg StringCchPrintF). It is already declared in the Jedi Apilib (JwaStrSafe).
Well, I just found this one:
function sprintf(S: PAnsiChar; const Format: PAnsiChar): Integer;
cdecl; varargs; external 'msvcrt.dll';
It simply uses the original sprintf function from msvcrt.dll which can then be used like that:
procedure TForm1.Button1Click(Sender: TObject);
var s: AnsiString;
begin
SetLength(s, 99);
sprintf(PAnsiChar(s), '%d - %d', 1, 2);
ShowMessage(S);
end;
I don't know if this is the best solution because it needs this external dll and you have to set the string's length manually which makes it prone to buffer overflows, but at least it works... Any better ideas?
more clean approach without unnecessary type casting
function sprintf(CharBuf: PChar; const Format: PAnsiChar): Integer;
cdecl; varargs; external 'msvcrt.dll';
procedure TForm1.Button1Click(Sender: TObject);
var CharBuf: PChar;
begin
CharBuf:=StrAlloc (99);
sprintf(CharBuf, 'two numbers %d - %d', 1, 2);
ShowMessage(CharBuf);
StrDispose(CharBuf);
end;
If you happen to cross compile for Windows CE App. use coredll.dll instead of msvcrt.dll