Implementation of FNV - delphi

I am trying to implement FNV hash from http://isthe.com/chongo/tech/comp/fnv/
I converted the PowerBasic's inline asm on that page into Delphi.
function ReadFileToMem(sPath:string):Pointer;
var
hFile: THandle;
pBuffer: Pointer;
dSize: DWORD;
dRead: DWORD;
begin
hFile := CreateFile(PChar(sPath), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
if hFile <> 0 then
dSize := GetFileSize(hFile, nil);
if dSize <> 0 then
begin
SetFilePointer(hFile, 0, nil, FILE_BEGIN);
GetMem(Result, dSize);
ReadFile(hFile, Result^, dSize, dRead, nil);
if dRead = 0 then
MessageBox(0, PChar('Error reading file.'), PChar('Read Error'), MB_ICONEXCLAMATION)
end;
CloseHandle(hFile);
end;
function GetPointerSize(lpBuffer: Pointer): Cardinal; // Function by ErazerZ
begin
if lpBuffer = nil then
Result := Cardinal(-1)
else
Result := Cardinal(Pointer(Cardinal(lpBuffer) -4)^) and $7FFFFFFC -4;
end;
FUNCTION FNV32( dwOffset : Pointer; dwLen : DWORD; offset_basis : DWORD) : DWORD ;
asm
mov esi, dwOffset //;esi = ptr to buffer
mov ecx, dwLen //;ecx = length of buffer (counter)
mov eax, offset_basis //;set to 2166136261 for FNV-1
mov edi, 16777619//&h01000193 //;FNV_32_PRIME = 16777619
xor ebx, ebx //;ebx = 0
#nextbyte:
mul edi //;eax = eax * FNV_32_PRIME
mov bl, [esi] //;bl = byte from esi
xor eax, ebx //;al = al xor bl
inc esi //;esi = esi + 1 (buffer pos)
dec ecx //;ecx = ecx - 1 (counter)
jnz #nextbyte //;if ecx is 0, jmp to NextByte
mov #result, eax //;else, function = eax
end;
procedure TForm1.Button1Click(Sender: TObject);
var
pFile : Pointer;
hFile : Cardinal;
begin
//Profiler1['Test'].Start;
pFile := ReadFileToMem(fn);
hFile := FNV32(pFile,GetPointerSize(pFile),2166136261);
//Profiler1['Test'].Stop;
//OutputDebugString(pchar(Profiler1['Test'].AsText[tiAll]));
OutputDebugString(pchar(inttostr(hFile)));
end;
If a size of given file is more that 200KB, the output is random (hash) number. Am I missing something?

Your asm code is somewhat buggy, IMHO. It will crash your application, as it is written.
You need to preseve esi/edi/ebx registers
parameters are passed in eax,ecx,edx registers
result is the eax register
Correct way to do it could be (not tested, just written here there):
function fnv32(dwOffset : Pointer; dwLen : DWORD; offset_basis: DWORD) : DWORD ;
asm // eax=dwOffset ecx=dwLen edx=offset_basis -> result in eax
push esi
push edi
mov esi,eax
mov eax,edx
or ecx,ecx
je #z
mov edi,16777619
xor edx,edx
#1:
mul edi
mov dl,[esi]
xor eax,edx
inc esi
dec ecx
jnz #1
#z:
pop edi
pop esi
end;
So to read and hash any file, in a pure Delphi way (don't use Windows API like you did):
function fnv32file(const aFileName: TFileName): DWORD;
begin
with TMemoryStream.Create do
try
LoadFromFile(aFileName);
result := fnv32(Memory,Size,0);
finally
Free;
end;
end;
A pure pascal version won't be much slower IMHO (the bottleneck is definitively reading the data from the hard drive):
function fnv32(dwOffset : PByteArray; dwLen : DWORD; offset_basis: DWORD): DWORD ;
var i: integer;
begin
result := offset_basis;
for i := 0 to dwLen-1 do
result := (result*16777619) xor DWORD(dwOffset^[i]);
end;

Where should I start ...
1) CreateFile returns INVALID_HANDLE_VALUE on failure, not 0.
2) SetFilePointer is not necessary.
3) What if you have to hash 16 GB file?
4) You are not releasing allocated memory - FreeMem(pFile).
5) GetPointerSize is a total hack. You could just return file size from ReadFileToMem.
The following code is a rewrite of your approach. It still loads complete file into the memory but is implemented "the Delphi way".
function ReadFileToMem(const sPath: string; var buffer: TMemoryStream): boolean;
var
fileStr: TFileStream;
begin
Result := false;
try
fileStr := TFileStream.Create(sPath, fmOpenRead);
try
buffer.Size := 0;
buffer.CopyFrom(fileStr, 0);
finally FreeAndNil(fileStr); end;
Result := true;
except
on E: EFOpenError do
ShowMessage('Error reading file. ' + E.Message);
end;
end;
function FNV32(dwOffset: pointer; dwLen: cardinal; offset_basis: cardinal): cardinal;
asm
mov esi, dwOffset //;esi = ptr to buffer
mov ecx, dwLen //;ecx = length of buffer (counter)
mov eax, offset_basis //;set to 2166136261 for FNV-1
mov edi, 16777619//&h01000193 //;FNV_32_PRIME = 16777619
xor ebx, ebx //;ebx = 0
#nextbyte:
mul edi //;eax = eax * FNV_32_PRIME
mov bl, [esi] //;bl = byte from esi
xor eax, ebx //;al = al xor bl
inc esi //;esi = esi + 1 (buffer pos)
dec ecx //;ecx = ecx - 1 (counter)
jnz #nextbyte //;if ecx is 0, jmp to NextByte
mov #result, eax //;else, function = eax
end;
procedure TForm16.Button1Click(Sender: TObject);
var
hFile : cardinal;
memBuf: TMemoryStream;
begin
memBuf := TMemoryStream.Create;
try
if ReadFileToMem('SomeFile', memBuf) then begin
hFile := FNV32(memBuf.Memory, memBuf.Size, 2166136261);
ShowMessageFmt('Hash = %d', [hFile]);
end;
finally FreeAndNil(memBuf); end;
end;

Enjoy
function fnv(dwOffset : Pointer; dwLen : NativeUInt; offset_basis: NativeUInt) : NativeUInt ;
//
// http://find.fnvhash.com/ - FNV Hash Calculator Online
// http://www.isthe.com/chongo/tech/comp/fnv/
//
// The offset_basis for FNV-1 is dependent on n, the size of the hash:
// 32 bit offset_basis = 2166136261
// 64 bit offset_basis = 14695981039346656037
//
{$IF Defined(CPUX86)}
asm
push ebp
push edi
push ebx // statement must preserve the EDI, ESI, ESP, EBP, and EBX registers
mov ebp, edx
mov edx, ecx // but can freely modify the EAX, ECX, and EDX registers
mov ecx, eax
mov eax, edx
mov edi, 01000193h
xor ebx, ebx
##nexta:
mov bl, byte ptr [ecx]
xor eax, ebx
mul edi
inc ecx
dec ebp
jnz ##nexta
pop ebx
pop edi
pop ebp
end;
{$ELSEIF Defined(CPUX64)}
asm
mov rax, R8
mov r8, rdx
mov r9, 100000001b3h
xor r10, r10
##nexta:
mov r10b, byte ptr [rcx]
xor rax, r10
mul r9
inc rcx
dec r8
jnz ##nexta
end;
{$IFEND}

Related

Detect virtualized environment with Delphi 64-bit?

// 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;

E2107 Operand size mismatch

I use this functions since D2007 I got it online, don't remember where.
But now in XE7 it return a compilation error:
"E2107 Operand size mismatch"
function FastCharPos(const aSource : string; const C: Char; StartPos : Integer) : Integer;
var
L : Integer;
begin
//If this assert failed, it is because you passed 0 for StartPos, lowest value is 1 !!
Assert(StartPos > 0);
Result := 0;
L := Length(aSource);
if L = 0 then exit;
if StartPos > L then exit;
Dec(StartPos);
asm
PUSH EDI //Preserve this register
mov EDI, aSource //Point EDI at aSource
add EDI, StartPos
mov ECX, L //Make a note of how many chars to search through
sub ECX, StartPos
mov AL, C //and which char we want :Error -"E2107 Operand size mismatch"
#Loop:
cmp Al, [EDI] //compare it against the SourceString
jz #Found
inc EDI
dec ECX
jnz #Loop
jmp #NotFound
#Found:
sub EDI, aSource //EDI has been incremented, so EDI-OrigAdress = Char pos !
inc EDI
mov Result, EDI
#NotFound:
POP EDI
end;
end;
function FastCharPosNoCase(const aSource : string; C: Char; StartPos : Integer) : Integer;
var
L : Integer;
begin
Result := 0;
L := Length(aSource);
if L = 0 then exit;
if StartPos > L then exit;
Dec(StartPos);
if StartPos < 0 then StartPos := 0;
asm
PUSH EDI //Preserve this register
PUSH EBX
mov EDX, GUpcaseLUT
mov EDI, aSource //Point EDI at aSource
add EDI, StartPos
mov ECX, L //Make a note of how many chars to search through
sub ECX, StartPos
xor EBX, EBX
mov BL, C //:Error -"E2107 Operand size mismatch"
mov AL, [EDX+EBX]
#Loop:
mov BL, [EDI]
inc EDI
cmp Al, [EDX+EBX]
jz #Found
dec ECX
jnz #Loop
jmp #NotFound
#Found:
sub EDI, aSource //EDI has been incremented, so EDI-OrigAdress = Char pos !
mov Result, EDI
#NotFound:
POP EBX
POP EDI
end;
end;
What do I need to update these two functions to XE7 win32?
What must I do?
Thanks.
This code was written for pre Unicode Delphi where Char is an alias for AnsiChar, the 8 bit character type. In Delphi 2009 and later, Char is an alias for WideChar the 16 bit character type.
The reason for the error message is that the code is intended to operate on 8 bit character elements, but you are providing 16 bit operands. The operator expects 8 bit operands, but you supplied 16 bit operands.
Change Char to AnsiChar to make this code compile and behave as intended on all versions of Delphi.
Having said that, I suggest you stop using this code. Instead use Pos. As a rule, it is preferable to use built-in library functions.
You should stop using old assembler version for string routines and use the use built-in library functions.
If you want to move on in a hurry you can reimplement you functions like this:
function FastCharPos(const aSource: string; const C: Char; StartPos: Integer): Integer; inline;
begin
Result := Pos(C, aSource, StartPos);
end;
function FastCharPosNoCase(const aSource: string; C: Char; StartPos: Integer): Integer; inline;
begin
Result := Pos(AnsiUppercase(C), AnsiUppercase(aSource), StartPos);
end;

UserProperties.Add in outlook2007 gets Invalid Function error

I'm working with Delphi2010 .
When I run the code with Outlook 2003 SP3, I get no errors but on another pc with outlook2007 i get an error 'Invalid Function error'.
const
olMailItem = 0;
olFolderInbox = $00000006;
var
Outlook: OleVariant;
oNameSpace: OleVariant;
oFolder: Olevariant;
oMailItem: Variant;
oUserProperty: Olevariant;
begin
try
Outlook := GetActiveOleObject('Outlook.Application');
except
Outlook := CreateOleObject('Outlook.Application');
end;
oNameSpace := Outlook.GetNamespace('MAPI') ;
oFolder:= oNameSpace.GetDefaultFolder(olFolderInbox);
oMailItem := Outlook.CreateItem(olMailItem);
...
oUserProperty:= oMailItem.UserProperties.Add('RetrieveCode', 1); //--> get error on Outlook2007
oUserProperty.Value:=ARetrieveCode;
...
end;
When I use redemption I get the same error for Outlook2007
Can someone point the right direction to solve this problem?
I catch the error with eurekalog:
; ComObj (Line=0 - Offset=0)
; --------------------------
00538469 mov eax, dword ptr [EOleSysError]
0053846E call ComObj
00538473 mov esi, eax
00538475 cmp dword ptr [ebp-$04], +$00
00538479 jz ComObj
0053847B push dword ptr [ebp-$04]
0053847E mov eax, esi
00538480 jmp System
00538485 jmp ComObj
00538487 mov eax, esi
00538489 call System ; <-- EXCEPTION
0053848E xor eax, eax
00538490 pop edx
00538491 pop ecx
00538492 pop ecx
00538493 mov fs:[eax], edx
00538496 push $005384B0 ; '^[‹å]Â.'
0053849B lea eax, [ebp-$10]
0053849E mov edx, $00000003 ; ''...
005384A3 call System
005384A8 ret
I have change my code from late-bound to early-bound to check if I get the same error.
I imported the library to OutLook_TLB.pas and add the Outlook_TLB in the uses of the unit.
uses
...,
Outlook_TLB;
function SendOutLookMail ...
var
...
MyOutlook: Outlook_TLB.OutlookApplication;
MyMailItem: Outlook_TLB.MailItem;
MyUserProperty: Outlook_TLB.UserProperty;
begin
...
MyOutlook:= Outlook_TLB.CoOutlookApplication.Create;
MyMailItem:= MyOutlook.CreateItem(olMailItem)as MailItem;
MyUserProperty:= MyMailItem.UserProperties.Add('RetrieveCode', 1, EmptyParam, EmptyParam) as UserProperty;
MyUserProperty.Value:= ARetrieveCode;
MyMailItem.Recipients.Add(AFrom);
MyMailItem.To_:= ATo;
MyMailItem.Subject := ASubject+' early/late-bound';
MyMailItem.Body := ABody;
MyMailItem.Send;
end;
When I run the code, I don't have any error on a pc with Outlook2007.
So an early bound to the object fixed my problem.

What does DUnit2's CallerAddr function do, and how do I convert it to 64 bits?

I am trying to get DUnit2 working under 64 bits, but I am stumped to what this method does, let alone how to convert it to 64 bits. Pure Pascal would better, but since it refers to the stack (ebp), it might not be possible.
function CallerAddr: Pointer; assembler;
const
CallerIP = $4;
asm
mov eax, ebp
call IsBadPointer
test eax,eax
jne ##Error
mov eax, [ebp].CallerIP
sub eax, 5 // 5 bytes for call
push eax
call IsBadPointer
test eax,eax
pop eax
je ##Finish
##Error:
xor eax, eax
##Finish:
end;
function RtlCaptureStackBackTrace(FramesToSkip: ULONG; FramesToCapture: ULONG;
out BackTrace: Pointer; BackTraceHash: PULONG): USHORT; stdcall;
external 'kernel32.dll' name 'RtlCaptureStackBackTrace' delayed;
function CallerAddr: Pointer;
begin
// Skip 2 Frames, one for the return of CallerAddr and one for the
// return of RtlCaptureStackBackTrace
if RtlCaptureStackBackTrace(2, 1, Result, nil) > 0 then
begin
if not IsBadPointer(Result) then
Result := Pointer(NativeInt(Result) - 5)
else
Result := nil;
end
else
begin
Result := nil;
end;
end;
function CallerAddr: Pointer; assembler;
const
CallerIP = $4;
asm
mov rax, rcx ;For int.. XMM0 for float
call IsBadPointer
test rax,rax
jne ##Error
mov rax, [rcx].CallerIP
sub rax, 5 // 5 bytes for call
push rax
call IsBadPointer
test rax,rax
pop rax
je ##Finish
##Error:
xor rax, rax
##Finish:
end;

Is there a DivMod that is *not* Limited to Words (<=65535)?

In Delphi, the declaration of the DivMod function is
procedure DivMod(Dividend: Cardinal; Divisor: Word;
var Result, Remainder: Word);
Thus, the divisor, result, and remainder cannot be grater than 65535, a rather severe limitation. Why is this? Why couldn't the delcaration be
procedure DivMod(Dividend: Cardinal; Divisor: Cardinal;
var Result, Remainder: Cardinal);
The procedure is implemented using assembly, and is therefore probably extremely fast. Would it not be possible for the code
PUSH EBX
MOV EBX,EDX
MOV EDX,EAX
SHR EDX,16
DIV BX
MOV EBX,Remainder
MOV [ECX],AX
MOV [EBX],DX
POP EBX
to be adapted to cardinals? How much slower is the naïve attempt
procedure DivModInt(const Dividend: integer; const Divisor: integer; out result: integer; out remainder: integer);
begin
result := Dividend div Divisor;
remainder := Dividend mod Divisor;
end;
that is not (?) limited to 16-bit integers?
Such a procedure is possible. I have not tested the code enough, but I think it's OK:
procedure DivMod32(Dividend, Divisor: Cardinal; var Quotient, Remainder: Cardinal);
asm
PUSH EBX
MOV EBX,EDX
XOR EDX,EDX
DIV EBX
MOV [ECX],EAX
MOV EBX,Remainder
MOV [EBX],EDX
POP EBX
end;
Updated:
even more efficient:
function DivMod32(Dividend, Divisor: Cardinal; var Remainder: Cardinal): Cardinal;
asm
PUSH EBX
MOV EBX,EDX
XOR EDX,EDX
DIV EBX
MOV [ECX],EDX
POP EBX
end;
Updated 2:
You can see the assembly code generated by Delphi compiler in the Disassembly (or CPU) window. Eg, the procedure
procedure DivMod32(const Dividend: Cardinal; const Divisor: Cardinal;
out result: Cardinal; out remainder: Cardinal);
begin
result := Dividend div Divisor;
remainder := Dividend mod Divisor;
end;
generates code
Unit1.pas.28: begin
0046CC94 55 push ebp
0046CC95 8BEC mov ebp,esp
0046CC97 53 push ebx
0046CC98 56 push esi
0046CC99 8BF2 mov esi,edx
0046CC9B 8BD8 mov ebx,eax
Unit1.pas.29: result := Dividend div Divisor;
0046CC9D 8BC3 mov eax,ebx
0046CC9F 33D2 xor edx,edx
0046CCA1 F7F6 div esi
0046CCA3 8901 mov [ecx],eax
Unit1.pas.30: remainder := Dividend mod Divisor;
0046CCA5 8BC3 mov eax,ebx
0046CCA7 33D2 xor edx,edx
0046CCA9 F7F6 div esi
0046CCAB 8B4508 mov eax,[ebp+$08]
0046CCAE 8910 mov [eax],edx
Unit1.pas.31: end;
0046CCB0 5E pop esi
0046CCB1 5B pop ebx
0046CCB2 5D pop ebp
0046CCB3 C20400 ret $0004
This code is linear (contains no jumps) and modern processors (with long instruction pipeline) are very efficient in executing linear code. So though my DivMode32 implementation is about 3 times shorter, 60% is a reasonable estimate.

Resources