I want to get a files these attributes as integer values.
Try
function FileAge(const FileName: string; out FileDateTime: TDateTime): Boolean;
From SysUtils.
Delphians tend to like the FindFirst approach (the SearchRec structure has some of those), but I'd suggest the Win32 API function GetFileAttributesEx.
From the DSiWin32 freeware library:
function DSiFileTimeToDateTime(fileTime: TFileTime; var dateTime: TDateTime): boolean;
var
sysTime: TSystemTime;
begin
Result := FileTimeToSystemTime(fileTime, sysTime);
if Result then
dateTime := SystemTimeToDateTime(sysTime);
end; { DSiFileTimeToDateTime }
function DSiGetFileTimes(const fileName: string; var creationTime, lastAccessTime,
lastModificationTime: TDateTime): boolean;
var
fileHandle : cardinal;
fsCreationTime : TFileTime;
fsLastAccessTime : TFileTime;
fsLastModificationTime: TFileTime;
begin
Result := false;
fileHandle := CreateFile(PChar(fileName), GENERIC_READ, FILE_SHARE_READ, nil,
OPEN_EXISTING, 0, 0);
if fileHandle <> INVALID_HANDLE_VALUE then try
Result :=
GetFileTime(fileHandle, #fsCreationTime, #fsLastAccessTime,
#fsLastModificationTime) and
DSiFileTimeToDateTime(fsCreationTime, creationTime) and
DSiFileTimeToDateTime(fsLastAccessTime, lastAccessTime) and
DSiFileTimeToDateTime(fsLastModificationTime, lastModificationTime);
finally
CloseHandle(fileHandle);
end;
end; { DSiGetFileTimes }
function GetFileModDate(filename : string) : TDateTime;
var
F : TSearchRec;
begin
FindFirst(filename,faAnyFile,F);
Result := F.TimeStamp;
//if you really wanted an Int, change the return type and use this line:
//Result := F.Time;
FindClose(F);
end;
F.Time has since been Deprecated, Help file says Use F.TimeStamp.
Just to update this due to later versions of Delphi
System.IOUtils do have a TFile record with several functions for getting file age, e.g. GetCreationTime, GetLastAccessTime, GetLastWriteTime
This should work, and it is native Delphi code.
function GetFileModDate(filename : string) : integer;
var
F : TSearchRec;
begin
FindFirst(filename,faAnyFile,F);
Result := F.Time;
//if you wanted a TDateTime, change the return type and use this line:
//Result := FileDateToDatetime(F.Time);
FindClose(F);
end;
You could call the GetFileInformationByHandle winapi function. Aparently JCL has a GetFileLastWrite function you could also use
Related
I'm enumerating the Windows shell with IShellFolder and struggle with getting the FindData structure from the TPropVariant output of IShellItem2.GetProperty so that I can explore its content.
The question is: How do I get FindData from the TPropVariant output in Delphi code? C++ snippets don't help me in this case (that's why I'm posting, because there are several around that I haven't been able translate correctly.)
What I have is:
var
ShellItem2: IShellItem2;
ppropvar: TPropVariant;
HR: HResult;
FindData: TWin32FindData;
FileSize: Int64;
if ShellItem2.GetProperty(PKEY_FindData, ppropvar) = S_OK then
begin
//It's ok, then how do I get FindData?
//Calculate the file size, for instace.
FileSize := FindData.nFileSizeLow or Int64(FindData.nFileSizeHigh) shl 32;
end;
I can't find any formal documentation about how a WIN32_FIND_DATA is stored in a PROPVARIANT. However, based on a code snippet found in this Qt code patch, the last field of the PROPVARIANT holds a pointer to a WIN32_FIND_DATAW, so try something like this:
type
PWin32FindDataW = ^TWin32FindDataW;
PPWin32FindDataW = ^PWin32FindDataW;
var
ShellItem2: IShellItem2;
ppropvar: TPropVariant;
FindData: PWin32FindDataW;
FileSize: UInt64;
begin
...
if ShellItem2.GetProperty(PKEY_FindData, ppropvar) = S_OK then begin
FindData := PPWin32FindDataW(PByte(#ppropvar) + sizeof(ppropvar) - sizeof(Pointer))^;
// alternatively:
// FindData := PWin32FindDataW(ppropvar.caub.pElems);
if FindData <> nil then begin
FileSize := FindData.nFileSizeLow or (UInt64(FindData.nFileSizeHigh) shl 32);
...
end;
PropVariantClear(ppropvar);
end;
...
end;
function GetItemFindData(AItem: IShellItem2; out AFindData: TWin32FindDataW): Boolean;
var
PV: TPropVariant;
begin
Result := False;
PV.vt := VT_EMPTY;
if AItem.GetProperty(PKEY_FindData, PV) = S_OK then
begin
if (PV.vt = VT_UI1 or VT_VECTOR) and (PV.caub.cElems = SizeOf(AFindData)) and Assigned(PV.caub.pElems) then
begin
CopyMemory(#AFindData, PV.caub.pElems, SizeOf(AFindData));
Result := True;
end;
PropVariantClear(PV);
end;
end;
I have some code which uses EnumFontFamiliesEX to determine whether a particular font (using its "facename") is installed. The code was working fine in 32-bit. When I compile and run it as 64-bit, it kept throwing an exception in the callback routine.
I have now gotten it to work under both BUT only if instead of passing the function FindFontbyFaceName's result as the 4th parameter to EnumFontFamiliesEX, I pass a local (or global) variable - MYresult in this case. (And then set result from it). I don't understand what is going on? Can anyone explain or point me to a better way. (I'm not so much interested in the mechanics of the fonts, as the basic callback mechanics).
// single font find callback
function FindFontFace( {$IFDEF CPUX86} lpelf: PLogFont; {$ENDIF}
{$IFDEF CPUX64} lpelf: PEnumLogFontEx; {$ENDIF}
lpntm: PNewTextMetricEx;
AFontType: DWORD; var Aresult: lparam): integer ; stdcall;
begin
result := 0; // 1 shot only please - not interested in any variations in style etc
if (lpelf <> nil) then
Aresult := -1 // TRUE
else
Aresult := 0;
end;
function FindFontbyFaceName(ACanvas: TCanvas; const AFacename: string): boolean;
var
lf: TLogFont;
Myresult: boolean;
begin
MYresult := false;
FillChar(lf, SizeOf(lf), 0);
StrLCopy(lf.lfFaceName, PChar(AFacename), 32);
lf.lfCharSet := DEFAULT_CHARSET;
// this works in both 32 and 64 bit
EnumFontFamiliesEX(ACanvas.Handle, lf, #FindFontFace, lparam(#MYresult), 0);
result := MYresult;
// this works in 32 bit but throws exception in callback in 64 bit
// EnumFontFamiliesEX(ACanvas.Handle, lf, #FindFontFace, lparam(#result), 0);
end;
function FindFont(const AFacename: string): boolean;
var
AImage: TImage;
begin
AImage := Timage.Create(nil);
try
result := FindFontbyFaceName(AImage.Canvas, Afacename);
finally
Aimage.Free;
end;
end;
Your callback function is not declared correctly. You are declaring the last parameter as a var LPARAM, which is wrong. The lParam parameter is passed by value, not by reference. When calling EnumFontFamiliesEx() you are passing a pointer to a Boolean as the lParam value.
Your callback is trying to write sizeof(LPARAM) number of bytes to a memory address that only has SizeOf(Boolean) bytes available (and why are you trying to write a -1 to a Boolean?). So you are overwriting memory. When using a pointer to a local variable as the lParam, you are likely just overwriting memory on the calling function's call stack that does not really matter, so you don't see a crash.
You need to either:
remove the var and typecast the lParam parameter to a PBoolean:
function FindFontFace( lpelf: PLogFont;
lpntm: PTextMetric;
FontType: DWORD;
lParam: LPARAM): Integer ; stdcall;
begin
PBoolean(lParam)^ := True;
Result := 0; // 1 shot only please - not interested in any variations in style etc
end;
Or:
function FindFontFace( lpelf: PLogFont;
lpntm: PTextMetric;
FontType: DWORD;
lParam: PBoolean): Integer ; stdcall;
begin
lParam^ := True;
Result := 0; // 1 shot only please - not interested in any variations in style etc
end;
leave the var but change the parameter type to Boolean instead of LPARAM:
function FindFontFace( var lpelf: TLogFont;
var lpntm: TTextMetric;
FontType: DWORD;
var lParam: Boolean): Integer ; stdcall;
begin
lParam := True;
Result := 0; // 1 shot only please - not interested in any variations in style etc
end;
Either approach will allow you to pass #Result as the lParam to EnumFontFamiliesEx() in both 32bit and 64bit:
function FindFontbyFaceName(ACanvas: TCanvas; const AFacename: string): Boolean;
var
lf: TLogFont;
begin
Result := False;
FillChar(lf, SizeOf(lf), 0);
StrLCopy(lf.lfFaceName, PChar(AFacename), 32);
lf.lfCharSet := DEFAULT_CHARSET;
EnumFontFamiliesEX(ACanvas.Handle, lf, #FindFontFace, LPARAM(#Result), 0);
end;
On a side note, creating a TImage just to have a canvas to enumerate with is wasteful. You don't need it at all:
function FindFontFace( lpelf: PLogFont;
lpntm: PTextMetric;
FontType: DWORD;
lParam: LPARAM): integer ; stdcall;
begin
PBoolean(lParam)^ := True;
Result := 0; // 1 shot only please - not interested in any variations in style etc
end;
function FindFont(const AFacename: string): Boolean;
var
lf: TLogFont;
DC: HDC;
begin
Result := False;
FillChar(lf, SizeOf(lf), 0);
StrLCopy(lf.lfFaceName, PChar(AFacename), 32);
lf.lfCharSet := DEFAULT_CHARSET;
DC := GetDC(0);
EnumFontFamiliesEx(DC, lf, #FindFontFace, LPARAM(#Result), 0);
ReleaseDC(0, DC);
end;
That being said, you can simplify the code if you use the TScreen.Fonts property instead of calling EnumFontFamiliesEx() directly:
function FindFont(const AFacename: string): Boolean;
begin
Result := (Screen.Fonts.IndexOf(AFacename) <> -1);
end;
I would like to have a single neat (close and self contained) function (let's call it GetDesktopHandle) that returns a handle to the Desktop window. I use the code below. But it only works in the DeskHandle is a global var.
How to get rid of this global variable? If I make it local I get an AV in getDesktopWnd when I try to DeskHandle := hChild
VAR DeskHandle : HWND;
function GetDesktopHandle: HWND;
function getDesktopWnd (Handle: HWND; NotUsed: Longint): bool; stdcall; { Callback function }
VAR hChild : HWND;
begin
if handle <> 0 then
begin
hChild := FindWindowEx(handle, 0, 'SHELLDLL_DefView', nil);
if hChild <> 0 then
begin
hChild := FindWindowEx(hChild, 0, 'SysListView32', nil);
if hChild <> 0
then DeskHandle := hChild;
end;
end;
Result:= TRUE;
end;
begin
DeskHandle := 0;
EnumWindows(#getDesktopWnd, 0);
Result:= DeskHandle;
end;
The main question is: can I write this code as a single function or AT LEAST, can I get rid of the external/global var?
Possible solution:
The documentation says that the second parameter is only a IN parameter.
lParam [in]
Type: LPARAM
An application-defined value to be passed to the callback function.
https://msdn.microsoft.com/en-us/library/windows/desktop/ms633497%28v=vs.85%29.aspx
Would it be wrong to use it to pass the result back?
Local functions cannot be used as callbacks. If you hadn't used the # operator to pass your function, the compiler would have told you that. (Using the operator turns the argument into an ordinary untyped pointer, so the compiler can't check anymore.)
You'll have to make your callback be a standalone function.
To pass data between the callback and the caller, use the second parameter, which you've currently named NotUsed. For example, you could pass a pointer to a handle variable, and then the callback could dereference the pointer to return a result.
type
TMyData = record
Handle: HWND;
Pid: DWORD;
Caption: String;
ClassName: String;
end;
PMyData = ^TMyData;
function GetWindowClass(const Handle: HWND): String;
begin
SetLength(Result, MAX_PATH);
SetLength(Result, GetClassName(Handle, PChar(Result), Length(Result)));
end;
function GetWindowCaption(const Handle: HWND): String;
begin
SetLength(Result, MAX_PATH);
SetLength(Result, GetWindowText(Handle, PChar(Result), Length(Result)));
end;
function EnumChildWindowsProc(Handle: THandle; MyData: PMyData): BOOL; stdcall;
var
ClassName: String;
Caption: String;
Pid: DWORD;
begin
ClassName := GetWindowClass(Handle);
Caption := GetWindowCaption(Handle);
Result := (ClassName = 'SysListView32') and (Caption = 'FolderView');
if Result then
begin
MyData.Handle := Handle;
GetWindowThreadProcessId(Handle, MyData.Pid);
MyData.Caption := Caption;
MyData.ClassName := ClassName;
end;
// To continue enumeration, the callback function must return TRUE;
// to stop enumeration, it must return FALSE
Result := not Result;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
MyData: TMyData;
begin
ZeroMemory(#MyData, SizeOf(MyData));
EnumChildWindows(GetDesktopWindow, #EnumChildWindowsProc, NativeInt(#MyData));
if MyData.Handle > 0 then
begin
ShowMessageFmt('Found Window in Pid %d', [MyData.Pid]);
end
else begin
ShowMessage('Window not found!');
end;
end;
Guys I got a source from a friend that is suppose to help me learn RE a lot but I got error
Error:identifier not found "TResourceStream"
"Bool"
"TMemoryStream"
"TResourceInfo"
"try"
And
Fatal: Syntax error, ";" expected but " identifier MS" found
Please help I need to compile this.
Excuse me please I know nothing yet, about programming.
Here is the source
function EnumResourceNames(hModule: HMODULE; // EXE handle returned from LoadLibrary/Ex
lpType: PChar; // resource type (eg: RT_RCDATA)
lpEnumFunc: ENUMRESNAMEPROC; // callback function address
lParam: Integer // long integer (eg: pointer to an object)
): BOOL; stdcall;
function CB_EnumDfmNameProc(hModule: THandle; lpszType, lpszName: PChar;
lParam: Integer): Boolean; stdcall;
var
ms: TMemoryStream;
rs: TResourceStream;
Buffer: array of Byte;
begin
with TResourceInfo(lParam) do
begin
rs := TResourceStream.Create(TResourceInfo(lParam).Module,
lpszname, lpszType); // load resource in memory
try
ms := TMemoryStream.Create;
try
try
SetLength(Buffer, 4);
rs.Read(Buffer[0], SizeOf(Buffer)); // read the first 4 bytes
if string(Buffer) = 'TPF0' then // is it a DFM resource?
begin
rs.Seek(0, 0);
ObjectBinaryToText(rs, ms); // decode DFM
ms.Seek(0, 0);
AddDfm(StrPas(lpszName), ms); // add it to our own list
end;
except
raise;
end;
finally
ms.Free;
end;
finally
rs.free;
end;
end;
Result := True;
end;
procedure TResourceInfo.EnumDfmNames;
begin
if FModule > 0 then // if an EXE file has been loaded
EnumResourceNames(FModule, RT_RCDATA, // go and search RCDATA resources
#CB_EnumDfmNameProc, Integer(Self));
end;
So I just got an answer to my question about getting the Skype Chatbox handle.
I am now trying to create a simple function, that digs for a handle. Here is how I am hoping to be able to use it:
MyHWND := DigForHandle(['Notepad','Edit'],['Untitled - Notepad','']);
Params:
1) Array of String: Holds the Class Hierachy.
2) Array of String: Holds the Window Caption Hierachy.
As you see, the 2nd entry in the 2nd parameter is empty, since the Edit Class does not have a Window Caption.
Would it be possible to create such function? :)
Try this
uses
Windows, Messages, TlHelp32, SysUtils;
type
PGetWindowParam = ^TGetWindowParam;
TGetWindowParam = record
ProcID: DWORD;
WindowCaption: string;
Result: HWND;
end;
function DigForHandle(const ProcName, Caption: string; const Hierachy: array of string): HWND;
function FindPID(const ExeFileName: string): DWORD;
implementation
function FindPID(const ExeFileName: string): DWORD;
var
ContinueLoop: BOOL;
ProcessEntry32: TProcessEntry32;
SnapshotHandle: THandle;
TempExeFileName: string;
begin
Result := 0;
SnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if SnapshotHandle <> 0 then
begin
FillChar(ProcessEntry32, SizeOf(ProcessEntry32), 0);
ProcessEntry32.dwSize := Sizeof(ProcessEntry32);
ContinueLoop := Process32First(SnapshotHandle, ProcessEntry32);
while ContinueLoop do
begin
TempExeFileName := ExtractFileName(ProcessEntry32.szExeFile);
if SameText(TempExeFileName, ExeFileName) then
begin
Result := ProcessEntry32.th32ProcessID;
Break;
end;
ContinueLoop := Process32Next(SnapshotHandle, ProcessEntry32);
end;
CloseHandle(SnapshotHandle);
end;
end;
function GetWindow(Wnd: HWND; P: LParam): BOOL; stdcall;
var
Param: PGetWindowParam;
ProcID: DWORD;
WindowTitle: array[0..256] of Char;
begin
Result := True; // assume it doesn't match; keep searching
Param := PGetWindowParam(P);
ProcID := 0;
GetWindowThreadProcessID(Wnd, #ProcID);
if ProcID <> Param^.ProcID then
Exit;
FillChar(WindowTitle, SizeOf(WindowTitle), 0);
if SendMessage(Wnd, WM_GETTEXT, SizeOf(WindowTitle) - SizeOf(Char), LPARAM(#WindowTitle[0])) <= 0 then
Exit;
if AnsiSameStr(WindowTitle, Param^.WindowCaption) then
begin
Param^.Result := Wnd;
Result := False;
end;
end;
function DigForHandle(const ProcName, Caption: string; const Hierachy: array of string): HWND;
var
Param: TGetWindowParam;
I: Integer;
ParentWnd: HWND;
begin
Result := 0;
FillChar(Param, SizeOf(Param), 0);
Param.ProcID := FindPID(ProcName);
if Param.ProcID = 0 then
Exit;
Param.Result := 0;
Param.WindowCaption := Caption;
EnumWindows(#GetWindow, LPARAM(#Param));
if Param.Result = 0 then
Exit;
I := 0;
ParentWnd := Param.Result;
while (ParentWnd <> 0) and (I < Length(Hierachy)) do
begin
Param.Result := 0;
Param.WindowCaption := Hierachy[I];
EnumChildWindows(ParentWnd, #GetWindow, LPARAM(#Param));
if Param.Result = 0 then
Break;
ParentWnd := Param.Result;
Inc(I);
end;
if I >= Length(Hierachy) then
Result := Param.Result;
end;
When I thought about it, I realized that it was actually rather simple - the code I had though, was "confusing" for me, which was why I asked a question here. After trying it out, I found that doing it this way, its a lot easier to read, and not as complicated (IMO).
Function DigForHandle(ClassHierachy, TextHierachy : Array of String):HWND;
Var
Handle : HWND;
I : Integer;
PClass,PText : PChar;
Begin
Result := 0;
I := 0;
while (I <= Length(ClassHierachy)-1) do
begin
PClass := PChar(ClassHierachy[I]);
PText := PChar(TextHierachy[I]);
if PClass = '' then PClass := Nil;
if PText = '' then PText := Nil;
Result := FindWindowEx(Result,0,PClass,PText);
Inc(I);
end;
End;