Hi people is there a way i can access a pointer to a structure member directly from in line assembler i tried this
procedure test(eu:PImageDosHeader);assembler;
asm
push eu._lfanew
end;
It won't compile but if i use this
procedure test(eu:Pointer);
var
xx:TImageDosHeader;
begin
xx:=TImageDosHeader(eu^);
asm
push xx._lfanew
end;
end;
It works great.Any idea how can i access a structure trough a pointer in inline asm? is a matter of optimizing the code
Yet another workaround:
procedure test(eu:PImageDosHeader);
asm
push eu.TImageDosHeader._lfanew
end;
The following works:
type
PMyStruct = ^TMyStruct;
TMyStruct = record
A, B: cardinal;
end;
procedure ShowCard(Card: cardinal);
begin
ShowMessage(IntToHex(Card, 8));
end;
procedure test(Struct: PMyStruct);
asm
push ebx // We must not alter ebx
mov ebx, eax // eax is Struct; save in ebx
mov eax, TMyStruct(ebx).A
call ShowCard
mov eax, TMyStruct(ebx).B
call ShowCard
pop ebx // Restore ebx
end;
procedure TForm6.FormCreate(Sender: TObject);
var
MyStruct: TMyStruct;
begin
MyStruct.A := $22222222;
MyStruct.B := $44444444;
test(#MyStruct);
end;
I would write it like this:
procedure test(const eu: TImageDosHeader);
asm
push TImageDosHeader([EAX])._lfanew
end;
The pertinent documentation is here.
Related
// VMware detection as described by Elias Bachaalany
function IsInsideVMware: Boolean;
begin
Result := True;
try
asm
push edx;
push ecx;
push ebx;
mov eax, 'VMXh';
mov ebx, 0;
mov ecx, 10;
mov edx, 'VX';
in eax, dx;
cmp ebx, 'VMXh';
setz [Result];
pop ebx;
pop ecx;
pop edx;
end;
except
Result := False;
end;
end;
function IsRunningUnderHyperV: BOOL; stdcall;
var
VMBranding: array[0..12] of AnsiChar;
begin
asm
mov eax, $40000000;
cpuid;
mov dword ptr [VMBranding+0], ebx; // Get the VM branding string
mov dword ptr [VMBranding+4], ecx;
mov dword ptr [VMBranding+8], edx;
end;
VMBranding[12] := #0;
Result := CompareText(String(VMBranding), 'Microsoft Hv') = 0;
end;
How can this be done for 64-bit Delphi application?
If I try to compile it as 64-bit I get message "Unsupported language feature: ASM" and "Operand size mismatch". I know that you need to separate asm code from pascal code and registers are different but have no idea how to do it?
At end, I have used this solution for 32/64-bit.
var
LFlag: Cardinal;
//================================= VMWare =====================================
procedure TryVMWare;
{$IFDEF CPUX86}
asm
push eax
push ebx
push ecx
push edx
mov eax, 'VMXh'
mov ecx, 0Ah
mov dx, 'VX'
in eax, dx
mov LFlag, ebx
pop edx
pop ecx
pop ebx
pop eax
end;
{$ENDIF CPUX86}
{$IFDEF CPUX64}
asm
push rax
push rbx
push rcx
push rdx
mov eax, 'VMXh'
mov ecx, 0Ah
mov dx, 'VX'
in eax, dx
mov LFlag, ebx
pop rdx
pop rcx
pop rbx
pop rax
end;
{$ENDIF CPUX64}
function IsInsideVMware: Boolean;
begin
LFlag := 0;
try
TryVMWare;
except
end;
Result := LFlag = $564D5868;
end;
As for detecting other VM brands in 64-bit I have used code from:
https://github.com/JBontes/FastCode/blob/master/FastcodeCPUID.pas
Code is updated to run and compile as x64 bit and detect virtual machines brands.
The JEDI JclSysInfo.GetCpuInfo() function gets just about everything you'd ever want to know about the CPU, and returns the physical device's characteristics regardless of whether you're in a VM or on the root OS. The easiest way to detect most VMs is to get the CPUID string:
function GetVMBranding: String;
var
VMBranding: array[0..12] of AnsiChar;
begin
asm
mov eax, $40000000;
cpuid;
mov dword ptr [VMBranding+0], ebx; // Get the VM branding string
mov dword ptr [VMBranding+4], ecx;
mov dword ptr [VMBranding+8], edx;
end;
VMBranding[12] := #0;
Result := String(VMBranding);
end;
Then compare it to known strings (a list can be found at https://en.wikipedia.org/wiki/CPUID#:~:text=In%20the%20x86%20architecture%2C%20the,and%20SL%2Denhanced%20486%20processors) However, there are a couple of important caveats:
The CPUID query will return the Hyper-V signature if Hyper-V is installed, whether or not you're running on the root OS or in a VM. This is because once Hyper-V is installed, its hypervisor is managing threads even for the root OS. I have not found a way yet to detect actually running inside a Hyper-V VM.
VirtualBox and WINE require separate methods of detection. WINE adds some functions to NTDLL.DLL, so looking for those functions is a reliable way to detect WINE. For VirtualBox, you have to look for its service in the list of running processes.
function CheckWine: Boolean;
var
hnd: THandle;
wine_get_version: function : pchar; {$IFDEF Win32} stdcall; {$ENDIF}
wine_unix2fn: procedure (p1:pointer; p2:pointer); {$IFDEF Win32} stdcall; {$ENDIF}
begin
Result := False;
hnd := LoadLibrary('ntdll.dll');
if hnd > 32 then begin
wine_get_version := GetProcAddress(hnd, 'wine_get_version');
wine_unix2fn := GetProcAddress(hnd, 'wine_nt_to_unix_file_name');
if assigned(wine_get_version) or assigned(wine_unix2fn) then
Result := True;
FreeLibrary(hnd);
end;
end;
//uses WinApi.TlHelp32
function CheckVirtualBox: Boolean;
var
handle: THandle;
procinfo: ProcessEntry32;
begin
Result := False;
handle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
procinfo.dwSize := sizeof(PROCESSENTRY32);
while(Process32Next(handle, procinfo)) do begin
if (POS('VBoxService.exe', procinfo.szExeFile) > 0) then begin
Result := True;
Break;
end;
end;
CloseHandle(handle);
end;
I present you a bug in the Delphi 5 compiler. I know there's not going to be any fix for it; but a workaround would be super
program Project1;
uses
Dialogs, SysUtils;
{$R *.RES}
type
IFoo = interface
['{D68DA49A-F870-433D-9343-4964BFECFF27}']
procedure Grob(a: Integer; b: Integer);
end;
TFoo = class(TInterfacedObject, IFoo)
public
procedure Grob(a: Integer; b: Integer); virtual;
end;
procedure TFoo.Grob(a: Integer; b: Integer);
begin
end;
function DoStuff(): Integer;
var
foo: IFoo;
begin
foo := TFoo.Create;
try
Result := 1;
Exit;
finally
foo.Grob(0, 0);
end;
Result := 2;
end;
var
n: Integer;
begin
n := DoStuff;
if n <> 0 then
ShowMessage('Failed: '+IntToStr(n))
else
ShowMessage('Passed: '+IntToStr(n));
end.
The real guts is the function DoStuff which should return one:
function DoStuff(): Integer;
var
foo: IFoo;
begin
foo := TFoo.Create;
try
Result := 1;
Exit;
finally
foo.Grob(0, 0);
end;
Result := 2;
end;
The function should return one. Instead it returns the address of the interfaced object:
The assembly
The code actually does start to set the result to one:
Project1.dpr.30: Result := 1;
mov ebx,$00000001 ; place return value 1 in EBX
Project1.dpr.31: Exit;
call #TryFinallyExit ; call the finally block
jmp DoStuff + $6E
and as the function is about to return, it does copy EBX into EAX in order to return it:
mov eax,ebx ;EBX into EAX for return
But finally block (calling the interfaced method) is the problem. It blows away the return value stored in EBX:
We arrive here from the call #TryFinallyExit
Project1.dpr.33: foo.Grob(0, 0);
xor ecx,ecx
xor edx,edx
mov eax,[ebp-$04]
mov ebx,[eax] <----- overwriting ebx with interface address
call dword ptr [ebx+$0c]
ret
After the "call" to the finally block, it returns to a jump, which sends it to:
Project1.dpr.36: Result := 2;
...
xor eax,eax
pop edx
pop ecx
pop ecx
mov fs:[eax],edx
push $00442e1f
lea eax,[ebp-$04]
call #IntfClear
ret
...
mov eax,ebx <----- places overwritten EBX into EAX for return
Project1.dpr.37: end;
pop ebx
pop ecx
pop ebp
ret
The return value rather than being one, or two, is the address of the interface pointer.
I know none of you have Delphi 5. And even if you did,
"What would you like me to say?"
I know the difficulty. What i actually need is some sort of workaround.
As you observed, the compiler is storing the result into EBX, but then overwriting it before it subsequently copies EBX into EAX to return the result to the caller.
The compiler should be doing one of the following:
Using a different register to store the result value temporarily, so that its use of EBX does not destroy the result value, or
Not using EBX in the call to Grob, or
Storing the result value in something more persistent than a register, like on the stack.
Obviously options 1 and 2 are not readily available to you, but the latter is the workaround that you need to implement in this example – use a local variable to hold your intended Result value until you are ready to return it:
function DoStuff(): Integer;
var
foo: IFoo;
MyResult: Integer;
begin
foo := TFoo.Create;
try
try
MyResult := 1;
Exit;
finally
foo.Grob(0, 0);
end;
MyResult := 2;
finally
Result := MyResult;
end;
end;
I'm so new to Delphi 7, also in this forum and I've questions.
I have successfully converted an url string to hex using Jorlen Young's function StrToHex - Advanced Encryption Standard (AES) Interface Unit v1.3!.
But, when I implement his function EncryptString, then I got error at the very bottom of my code: Encrypt := EncryptString('www.website.com'); with the following messsage:
[Hint] Unit1.pas(xx): Variable 'st' is declared but never used in 'EncryptString'
[Error] Unit1.pas(xx): Not enough actual parameters
[Fatal Error] Project1.dpr(5): Could not compile used unit 'Unit1.pas'
Could you give me some tips in how to implement the "Key" and "KeyBit" option into my syntax: Encrypt := EncryptString('www.website.com'); ?
I would appreciate any help.
...here is my code :
.....................
.....................
type
TKeyBit = (kb128, kb192, kb256);
.....................
.....................
procedure IdMappedPortTCP1Execute(AThread: TIdMappedPortThread);
private
{ Private declarations }
public
{ Public declarations }
end;
implementation
function StrToHex(Const str: Ansistring): Ansistring;
asm
push ebx
push esi
push edi
test eax,eax
jz ##Exit
mov esi,edx
mov edi,eax
mov edx,[eax-4]
test edx,edx
je ##Exit {Length(S) = 0}
mov ecx,edx
Push ecx
shl edx,1
mov eax,esi
{$IFDEF VER210}
movzx ecx, word ptr [edi-12]
{$ENDIF}
call System.#LStrSetLength
mov eax,esi
Call UniqueString
Pop ecx
##SetHex:
xor edx,edx
mov dl, [edi]
mov ebx,edx
shr edx,4
mov dl,byte ptr[edx+##HexChar]
mov [eax],dl
and ebx,$0F
mov dl,byte ptr[ebx+##HexChar]
inc eax
mov [eax],dl
inc edi
inc eax
loop ##SetHex
##Exit:
pop edi
pop esi
pop ebx
ret
##HexChar: db '0123456789ABCDEF'
end;
function EncryptString(Value: AnsiString; Key: AnsiString; KeyBit: TKeyBit = kb128): AnsiString;
var
{$IFDEF VER210}
SS,DS: TMemoryStream;
{$ELSE}
SS, DS: TStringStream;
{$ENDIF}
Size: Int64;
AESKey128: TAESKey128;
AESKey192: TAESKey192;
AESKey256: TAESKey256;
st: AnsiString;
begin
Result := '';
{$IFDEF VER210}
ss := TMemoryStream.Create;
SS.WriteBuffer(PAnsiChar(Value)^,Length(Value));
DS := TMemoryStream.Create;
{$ELSE}
SS := TStringStream.Create(Value);
DS := TStringStream.Create('');
{$ENDIF}
try
Size := SS.Size;
DS.WriteBuffer(Size, SizeOf(Size));
if KeyBit = kb128 then
begin
FillChar(AESKey128, SizeOf(AESKey128), 0 );
Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
EncryptAESStreamECB(SS, 0, AESKey128, DS);
end;
if KeyBit = kb192 then
begin
FillChar(AESKey192, SizeOf(AESKey192), 0 );
Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
EncryptAESStreamECB(SS, 0, AESKey192, DS);
end;
if KeyBit = kb256 then
begin
FillChar(AESKey256, SizeOf(AESKey256), 0 );
Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
EncryptAESStreamECB(SS, 0, AESKey256, DS);
end;
{$IFDEF VER210}
SetLength(st,Ds.Size);
DS.Position := 0;
DS.ReadBuffer(PAnsiChar(st)^,DS.Size);
Result := StrToHex(st);
{$ELSE}
Result := StrToHex(DS.DataString);
{$ENDIF}
finally
SS.Free;
DS.Free;
end;
end;
procedure TForm1.IdMappedPortTCP1Execute(AThread: TIdMappedPortThread);
var Payload, Encrypt:String;
begin
Encrypt := EncryptString('www.website.com');
if Pos('CONNECT',AThread.NetData)<>0 then
begin
if host.Text = 'Operator' then
begin
Athread.OutboundClient.Write(Athread.NetData+#13#10);
Payload := 'GET http://'+Encrypt+'/ HTTP/1.1'+#13#10;
Athread.NetData:= Athread.NetData+Payload;
end;
end;
end.
Cheers,
RzV
EncryptString has 2 required and one optional parameter. You need at least to provide the key.
please i've this GCC inline assembler piece of code
int src = 0;
dword n;
__asm(
"sar %%cl,%%edx"
: "=d" (n) // saves in eax,edx
: "c" (src), "d" (n) // the inputs
);
and my delphi attempt is :
asm
mov ecx, &src
mov edx, &n
sar cl,edx
mov eax,edx
end;
please is that correct ?
Inline assembler does not work the same way in Delphi as it does in GCC. For starters, you don't have the same kind of macro and template support in Delphi, so if you want to use a declare-once general purpose assembler routine, you have to declare it as a function:
function ShiftArithmeticRight(aShift: Byte; aValue: LongInt): LongInt;
{$IFDEF WIN64}
asm
sar edx,cl
mov eax,edx
end;
{$ELSE}
{$IFDEF CPU386}
asm
mov cl,al
sar edx,cl
mov eax,edx
end;
{$ELSE}
begin
if aValue < 0 then
Result := not (not aValue shr aShift)
else
Result := aValue shr aShift;
end;
{$ENDIF}
{$ENDIF}
In Delphi, inline assembler has to be implemented at the spot where it is used, and it is only supported in 32-bit. In such asm blocks you can use the EAX,ECX,EDX freely, plus any identifiers in the surrounding code. For instance:
var
lValue: LongInt;
lShift: Byte;
begin
// Enter pascal code here
asm
mov cl,lShift
sar lValue,cl
end;
// Enter pascal code here
end;
I'm trying to develop some code to make generic calls to methods by it's name.
For example, some one from web send me a text as 'TTest.MethodTest.Param1.Param2', and I find the class and call it method by it's name with the parameters.
Ok, I did this, I got some code from Andreas Hausladen did little adjusts to work where I need. But, the implementation of ExecuteAsyncCall, was create to cdecl functions I need to change it's code to work with pascal convention methods.
Here is the code sample, if some one would like to test.
Some one can help me ? I'm studying to solve this but it's complicated to me.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
published
{ Public declarations }
procedure Test(AString: string; AInteger: Integer); cdecl;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function CopyVarRec(const Data: TVarRec): TVarRec;
begin
if (Data.VPointer <> nil) and
(Data.VType in [vtString, vtAnsiString, vtWideString,
{$IFDEF UNICODE}vtUnicodeString,{$ENDIF} vtExtended,
vtCurrency, vtInt64, vtVariant, vtInterface]) then
begin
Result.VType := Data.VType;
Result.VPointer := nil;
{ Copy and redirect TVarRec data to prevent conflicts with other threads,
especially the calling thread. Otherwise reference counted types could
be freed while this asynchron function is still executed. }
case Result.VType of
vtAnsiString: AnsiString(Result.VAnsiString) := AnsiString(Data.VAnsiString);
vtWideString: WideString(Result.VWideString) := WideString(Data.VWideString);
{$IFDEF UNICODE}
vtUnicodeString: UnicodeString(Result.VUnicodeString) := UnicodeString(data.VUnicodeString);
{$ENDIF UNICODE}
vtInterface : IInterface(Result.VInterface) := IInterface(Data.VInterface);
vtString : begin New(Result.VString); Result.VString^ := Data.VString^; end;
vtExtended : begin New(Result.VExtended); Result.VExtended^ := Data.VExtended^; end;
vtCurrency : begin New(Result.VCurrency); Result.VCurrency^ := Data.VCurrency^; end;
vtInt64 : begin New(Result.VInt64); Result.VInt64^ := Data.VInt64^; end;
vtVariant : begin New(Result.VVariant); Result.VVariant^ := Data.VVariant^; end;
end;
end
else
Result := Data;
end;
function ExecuteAsyncCall(AProc: Pointer; MethodData: TObject; const AArgs: array of const): Integer;
var
I: Integer;
V: ^TVarRec;
ByteCount: Integer;
FArgs: array of TVarRec;
FProc: function: Integer register;
begin
FProc := AProc;
SetLength(FArgs, 1 + Length(AArgs));
// insert "Self"
FArgs[0].VType := vtObject;
FArgs[0].VObject := MethodData;
for I := 0 to High(AArgs) do
FArgs[I + 1] := CopyVarRec(AArgs[I]);
ByteCount := Length(FArgs) * SizeOf(Integer) + $40;
{ Create a zero filled buffer for functions that want more arguments than
specified. }
asm
xor eax, eax
mov ecx, $40 / 8
##FillBuf:
push eax
push eax
// push eax
dec ecx
jnz ##FillBuf
end;
for I := High(FArgs) downto 0 do // cdecl => right to left
begin
V := #FArgs[I];
case V.VType of
vtInteger: // [const] Arg: Integer
asm
mov eax, V
push [eax].TVarRec.VInteger
end;
vtBoolean, // [const] Arg: Boolean
vtChar: // [const] Arg: AnsiChar
asm
mov eax, V
xor edx, edx
mov dl, [eax].TVarRec.VBoolean
push edx
end;
vtWideChar: // [const] Arg: WideChar
asm
mov eax, V
xor edx, edx
mov dx, [eax].TVarRec.VWideChar
push edx
end;
vtExtended: // [const] Arg: Extended
asm
add [ByteCount], 8 // two additional DWORDs
mov eax, V
mov edx, [eax].TVarRec.VExtended
movzx eax, WORD PTR [edx + 8]
push eax
push DWORD PTR [edx + 4]
push DWORD PTR [edx]
end;
vtCurrency, // [const] Arg: Currency
vtInt64: // [const] Arg: Int64
asm
add [ByteCount], 4 // an additional DWORD
mov eax, V
mov edx, [eax].TVarRec.VCurrency
push DWORD PTR [edx + 4]
push DWORD PTR [edx]
end;
vtString, // [const] Arg: ShortString
vtPointer, // [const] Arg: Pointer
vtPChar, // [const] Arg: PChar
vtObject, // [const] Arg: TObject
vtClass, // [const] Arg: TClass
vtAnsiString, // [const] Arg: AnsiString
{$IFDEF UNICODE}
vtUnicodeString, // [const] Arg: UnicodeString
{$ENDIF UNICODE}
vtPWideChar, // [const] Arg: PWideChar
vtVariant, // const Arg: Variant
vtInterface, // [const]: IInterface
vtWideString: // [const] Arg: WideString
asm
mov eax, V
push [eax].TVarRec.VPointer
end;
end;
end;
Result := FProc;
asm // cdecl => we must clean up
add esp, [ByteCount]
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ExecuteAsyncCall(Self.MethodAddress('Test'), Self, ['Test ', 1])
end;
procedure TForm1.Test(AString: string; AInteger: Integer);
begin
ShowMessage(AString + IntToStr(AInteger));
end;
end.
Att.
Obs: I'm working on Delphi 2007
The pascal calling convention passes parameters from left to right, whereas cdecl passes them right to left. To account for that difference, simply reverse the order that the parameters get pushed onto the stack:
for I := High(FArgs) downto 0 do // cdecl => right to left
for I := 0 to High(FArgs) do // pascal => left to right
Next, the Self parameter of a method gets passed last instead of first in the pascal convention. The net effect is that in both conventions, Self is the last parameter pushed onto the stack. You can add it to the end of your FArgs array, but if this were my code, I'd just push it manually after the main argument loop (which would also allow omitting the second argument array entirely):
asm
push [MethodData]
end;
Finally, in the pascal convention, the receiver cleans up the stack, whereas in cdecl, the caller cleans it up. Remove this code:
asm // cdecl => we must clean up
add esp, [ByteCount]
end;
// pascal => do nothing
The code also makes an allowance for calling functions with fewer parameters than the target function expects. It allocates a 40-byte buffer and fills it with zeros. That won't work with a pascal function, though. A pascal function always pops the same number of parameters from the stack, so if you provide the wrong number of parameters when you call it, you'll end up trashing the stack when the function returns. Remove the assembler block below the comment:
{ Create a zero filled buffer for functions that want more arguments than
specified. }
asm
...
end;
There's nothing you can do to check whether you've received the correct number of parameters. All you can do is make sure the stack pointer upon return from the function is the same as it was before you started pushing parameters.
I agree but I think that Self have to be pushed last:
http://docwiki.embarcadero.com/RADStudio/en/Program_Control
// insert "Self"
for I := 0 to High(AArgs) do
FArgs[I] := CopyVarRec(AArgs[I]);
FArgs[High(AArgs)+1].VType := vtObject;
FArgs[High(AArgs)+1].VObject := MethodData;
But I don't believe this code can be used and it'll crash:
1) all parameters of all methods must be variants
2) wrong number of parameters
3) wrong type (or order) of parameters
I think you have to find other solution.