I need to writing a Delphi program which will monitor a folder for changes (add, update, rename and removal of files).
I have seen suggestions to use theTShellChangeNotifier. Is this the correct solution for this problem? How should I use it?
This question might help. mghie's answer shows how to properly use ReadDirectoryChangesW.
I think this article will help you: Monitoring System Shell Changes using Delphi
Basically it analyzes the TShellChangeNotifier, discards it and then goes for a TSHChangeNotify which is basically a wrapper for the SHChangeNotify windows api function.
i suggest using madShell
RegisterShellEvent(ShellEvent, pathToMonitor, false, [seItemCreated, seItemRenamed]);
//
procedure Tform.ShellEvent(event: TShellEventType; const obj1, obj2: IShellObj; drive: char; value: cardinal);
var
filename: string;
isReady: boolean;
begin
if (event = seItemCreated) then
filename := obj1.Path
else if (event = seItemRenamed) then
filename := obj2.Path
else
exit;
// try to open to ensure it's read for reading
repeat
try
TfileStream.Create(filename, fmOpenRead + fmShareExclusive).Free;
isReady := true;
except
isReady := false;
sleep(250);
end;
until (isReady) or (not FileExists(filename));
OutputDebugString(pChar('ShellEvent: ' + filename));
end;
Related
Using Delphi (windows app) i want to get list of other applications running currently. Here How to check if a process is running using Delphi? i've found great tutorial about geting filenames/names of running application, however it gives names only process name (for example NOTEPAD.EXE). I've used naturally part with
UpperCase(ExtractFileName(FProcessEntry32.szExeFile))
and
UpperCase(ExtractFilePath(FProcessEntry32.szExeFile))
and just
UpperCase(FProcessEntry32.szExeFile)
but obviously FProcessEntry32.szExeFile does not have a path to file/process
Is there a simply way of getting list with paths? Here's How to get the list of running processes including full file path? solution with JclSysInfo library, but i cant use it in place of work in project.
I looked at what I could in Google and what I found usually concerned just the application that is running or the application that is active, but I can't just find a list of all running applications. Maybe i'm missing something obvious?
I'm not looking for any complex procedures, I'm not much interested in process parrent, or if there is no access to the process path, I don't have it and don't bother.
Any simple hint?
OK, due to helpfull comment from #TLama i've combined topics above to take name and path of process:
function processExists(exeFileName: string): Boolean;
var
ContinueLoopP, ContinueLoopM: BOOL;
FSnapshotHandle1, FSnapshotHandle2: THandle;
FProcessEntry32: TProcessEntry32;
FMODULEENTRY32: TMODULEENTRY32;
begin
FSnapshotHandle1 := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
FMODULEENTRY32.dwSize := SizeOf(FMODULEENTRY32);
ContinueLoopP := Process32First(FSnapshotHandle1, FProcessEntry32);
ContinueLoopM := Module32First(FSnapshotHandle2, FMODULEENTRY32);
Result := False;
while Integer(ContinueLoopP) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
Result := True;
ShowMessage(FMODULEENTRY32.szExePath + FProcessEntry32.szExeFile);
ContinueLoopP := Process32Next(FSnapshotHandle1, FProcessEntry32);
ContinueLoopM := Module32Next(FSnapshotHandle2, FMODULEENTRY32);
end;
CloseHandle(FSnapshotHandle1);
CloseHandle(FSnapshotHandle2);
end;
But still FProcessEntry32.szExeFile returns empty string. What i'm doing wrong? Thank You in advance.
I cannot write comment (low score), so I need to write as "answer". Try this code,
using FProcessEntry32.th32ProcessID as parameter:
Function QueryFullProcessImageNameW(hProcess:THandle; dwFlags:Cardinal; lpExeName:PWideChar; Var lpdwSize:Cardinal) : Boolean; StdCall; External 'Kernel32.dll' Name 'QueryFullProcessImageNameW';
Function GetFullPath(Pid:Cardinal) : UnicodeString;
Var rLength:Cardinal;
Handle:THandle;
Begin Result:='';
Handle:=OpenProcess(PROCESS_QUERY_INFORMATION, False, Pid);
If Handle = INVALID_HANDLE_VALUE Then Exit;
rLength:=256; // allocation buffer
SetLength(Result, rLength+1); // for trailing space
If Not QueryFullProcessImageNameW(Handle, 0, #Result[1],rLength) Then Result:='' Else SetLength(Result, rLength);
End;
This is a simple way I think. If you want to get the loaded DLL's full name, use
FMODULEENTRY32.hModule with GetModuleFileNameW function.
What I am trying to do is to crate a folder for my application, and to make sure each time a user enters this folder, it's grouped, like this:
except that the disks would be replaced by some folders/files.
so basically I'm trying to achieve exactly what "Group by" function does:
and I have to do this in my application with c/c++ code or a bat. I'm guessing this needs to be done in the registry, but I cannot find where. any idea?
thanks.
You must understand that changing of Explorer view mode with registry is dirty hack. So USE ON YOUR OWN RISK. TESTED ON WINDOWS 7 ONLY.
procedure SetFolderGroupBy(AParentWnd: HWND; const AFolder: UnicodeString; const AColumn: TPropertyKey; AAscending: Boolean);
var
Desktop: IShellFolder;
Attr: DWORD;
Eaten: DWORD;
IDList: PItemIDList;
Bag: IPropertyBag;
Direction: DWORD;
begin
OleCheck(SHGetDesktopFolder(Desktop));
try
Attr := 0;
OleCheck(Desktop.ParseDisplayName(AParentWnd, nil, PWideChar(AFolder), Eaten, IDList, Attr));
try
OleCheck(SHGetViewStatePropertyBag(IDList, 'Shell', SHGVSPB_FOLDERNODEFAULTS, IPropertyBag, Bag));
try
OleCheck(Bag.Write('SniffedFolderType', 'Generic'));
finally
Bag := nil;
end;
OleCheck(SHGetViewStatePropertyBag_(IDList, 'Shell\{5C4F28B5-F869-4E84-8E60-F11DB97C5CC7}', SHGVSPB_FOLDERNODEFAULTS, IPropertyBag, Bag));
try
if AAscending then Direction := SORT_ASCENDING
else Direction := DWORD(SORT_DESCENDING);
OleCheck(Bag.Write('GroupByDirection', Direction));
OleCheck(Bag.Write('GroupByKey:FMTID', GUIDToString(AColumn.fmtid)));
OleCheck(Bag.Write('GroupByKey:PID', AColumn.pid));
OleCheck(Bag.Write('GroupView', DWORD(-1)));
finally
Bag := nil;
end;
finally
CoTaskMemFree(IDList);
end;
finally
Desktop := nil;
end;
end;
Say I have got a program that hogs the processor and/or hard disk to the point that it makes it nearly impossible to do anything else on that computer. Now I don't want to kill that program because what it does is useful (it's a batch job that really is that CPU or disk heavy, e.g. it could ZIP a few gigabytes of data files) but for a short time I need to do something else on that computer. Is there any way an external program could do to freeze that performance killer for a while?
It's like the old DOS option to switch between programs without actually having multitasking.
Assume that the hypothetical program in question is a 3rd party product for which I don't have the source code and there is no way to tell it to pause.
I know I can change the program's priority class e.g. in TaskManager but that's not enough, I want to freeze it.
I am talking about Windows XP as the OS and would like to program a solution with Delphi. I have got all rights on the machine, so I could start something as administrator, replace files and I could also install a service if that is necessary.
You can freeze it with Process Explorer: Right-click on your program and select Suspend.
Here is some sample code for programmatic freezing from http://www.c-plusplus.de/forum/viewtopic-var-p-is-1460293.html, edited and omitted error checking for brevity:
#include <windows.h>
_NtSuspendProcess NtSuspendProcess =
(_NtSuspendProcess) GetProcAddress( GetModuleHandle( "ntdll" ),
"NtSuspendProcess" );
HANDLE ProcessHandle = OpenProcess( PROCESS_ALL_ACCESS, FALSE, pid);
NtSuspendProcess( ProcessHandle );
If you want to do it programatically you can use the approach described here.
What is does, is enumerating all the threads in a process and then suspending them. There is no SuspendProcess API, so this is a simulation of such a call.
Beware that this can potentionally have some bad side effects. It depend on the process and how it is written.
I don't know of any other way to do it in the Win32/64 API world. If you go lower to the kernel land and use the NT* APIs you have "NtSuspendProcess" API available. But this is undocumented so it can change with any version of windows or even with any service pack (not very likely though).
The declaration of "NtSuspendProcess" can be found in the JEDI ports of the windows APIs.
You can use my ProcessInfo component to suspend all threads belonging to the process. The approach is similar to what Runner explained to you. The code would be something like this:
var
Process : TProcessItem;
AThread: TThreadItem;
begin
Process := ProcessInfo1.RunningProcesses.FindByName('notepad.exe');
if Assigned(Process) then
begin
for AThread in Process.Threads do
AThread.SuspendThread;
end;
end;
You can download source code of ProcessInfo form here
function OpenThread(dwDesiredAccess: DWORD; InheritHandle: Boolean; dwThreadID: DWORD): THandle; stdcall; external 'kernel32.dll';
function ResumeProcess(PID: DWORD):Boolean;
var
tid, snap: THandle;
TE32: TThreadEntry32;
begin
Result := False;
snap := CreateToolHelp32SnapShot(TH32CS_SNAPTHREAD, 0);
TE32.dwSize := SizeOf(TThreadEntry32);
Thread32First(snap, TE32);
repeat
if TE32.th32OwnerProcessID = PID then begin
tid := OpenThread($0002, FALSE, TE32.th32ThreadID);
ResumeThread(tid);
Result := TRUE;
CloseHandle(tid);
end;
until Thread32Next(snap, TE32) = false;
CloseHandle(snap);
end;
function SuspendProcess(PID: DWORD): Boolean;
var
tid, snap: THandle;
TE32: TThreadEntry32;
begin
Result := False;
snap := CreateToolHelp32SnapShot(TH32CS_SNAPTHREAD, 0);
TE32.dwSize := SizeOf(TThreadEntry32);
Thread32First(snap, TE32);
repeat
if TE32.th32OwnerProcessID = PID then begin
tid := OpenThread($0002, FALSE, TE32.th32ThreadID);
SuspendThread(tid);
Result := TRUE;
CloseHandle(tid);
end;
until Thread32Next(snap, TE32) = false;
CloseHandle(snap);
end;
Hope this helps
I want to download a file from Internet and InternetReadFile seem a good and easy solution at the first glance. Actually, too good to be true. Indeed, digging a bit I have started to see that actually there are a lot of issues with it. People are complaining about all kinds of problems when using this code.
Problems could appear because:
the application freezes temporarily until the HTTP server responds
the application freezes temporarily because the Internet connections breaks
the application locks up because the HTTP server never responds
the InternetOpen (I just discovered this recently) MUST be called only once during application life time
I could not find a complete example about how to use it properly and robustly. Does anybody have an idea about how to implement it in a separate thread and with a time out? There is another SIMPLE way to robustly download a file from Internet. Though I don't want to complicate my life with very large libraries like Jedi or even Indy.
function GetFileHTTP (const fileURL, FileName: String): boolean;
CONST
BufferSize = 1024;
VAR
hSession, hURL: HInternet;
Buffer: array[1..BufferSize] of Byte;
BufferLen: DWORD;
f: File;
sAppName: string;
begin
// result := false;
sAppName := ExtractFileName(Application.ExeName) ;
hSession := InternetOpen(PChar(sAppName), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0) ; { be aware that InternetOpen need only be called once in your application!!!!!!!!!!!!!! }
TRY
hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, 0, 0) ;
TRY
AssignFile(f, FileName) ;
Rewrite(f, 1) ;
REPEAT
InternetReadFile(hURL, #Buffer, SizeOf(Buffer), BufferLen);
BlockWrite(f, Buffer, BufferLen)
UNTIL BufferLen = 0;
CloseFile(f) ;
Result:= True;
FINALLY
InternetCloseHandle(hURL)
end
FINALLY
InternetCloseHandle(hSession)
END;
END;
Edit:
This functions checks if Internet connection is available. It seems to work on Win98 also.
{ Are we connected to the Internet? }
function IsConnectedToInternet: Boolean; { Call SHELL32.DLL for Win < Win98 otherwise call URL.dll }
var InetIsOffline: function(dwFlags: DWORD): BOOL; stdcall;
begin
Result:= FALSE;
if IsApiFunctionAvailable('URL.DLL', 'InetIsOffline', #InetIsOffline)
then Result:= NOT InetIsOffLine(0)
else
if IsApiFunctionAvailable('SHELL32.DLL', 'InetIsOffline', #InetIsOffline)
then Result:= NOT InetIsOffLine(0)
end;
I am using Delphi 7. Many thanks.
Edit:
Losing customers because the application hangs at the first start up is the perfect recipe for losing money.
Writing your code to be Microsoft platform dependent is bad. You never know if the customer has the IE version x.x installed.
Installing stuff into a user's computer is like playing with guns. It will backfire.
(see more about this here: http://thesunstroke.blogspot.com/2010/06/programmig-like-there-is-no-ms-windows.html)
I basically do the same as you do. For me it works fairly flawlessly.
The only differences between my code and your code is I have an INTERNET_FLAG_RELOAD parameter to force a download from the file and not the cache. You can try that and see if it works better:
hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, INTERNET_FLAG_RELOAD, 0) ;
Also check for an internet connection before downloading. Do this:
dwConnectionTypes := INTERNET_CONNECTION_MODEM
+ INTERNET_CONNECTION_LAN
+ INTERNET_CONNECTION_PROXY;
InternetConnected := InternetGetConnectedState(#dwConnectionTypes, 0);
if InternetConnected then ...
Here's some sample code that uses Indy. This code is for Delphi 2010 (with Indy 10?), but the code for Delphi 7 would be similar. I've used Indy for years with D7 and have been very happy with it. I think in D7 we use Indy 9. Check if you need to download a new version...
You can use OnWork and OnWorkBegin to add a progress meter if you need to.
This code I excerpted from a bigger piece, editing it a bit. I did not try compiling it, but it will give you a good starting place.
function Download( const aSourceURL: String;
const aDestFileName: String;
out aDownloadResult: TDownloadResult;
out aErrm: String): boolean;
var
Stream: TMemoryStream;
IDAntiFreeze: TIDAntiFreeze;
begin
aDownloadResult := DROther;
Result := FALSE;
fIDHTTP := TIDHTTP.Create;
fIDHTTP.HandleRedirects := TRUE;
fIDHTTP.AllowCookies := FALSE;
fIDHTTP.Request.UserAgent := 'Mozilla/4.0';
fIDHTTP.Request.Connection := 'Keep-Alive';
fIDHTTP.Request.ProxyConnection := 'Keep-Alive';
fIDHTTP.Request.CacheControl := 'no-cache';
IDAntiFreeze := TIDAntiFreeze.Create;
Stream := TMemoryStream.Create;
try
try
fIDHTTP.Get(aSourceURL, Stream);
if FileExists(aDestFileName) then
DeleteFile(PWideChar(aDestFileName));
Stream.SaveToFile(aDestFileName);
Result := TRUE;
aDownloadResult :=drSuccess;
except
On E: Exception do
begin
Result := FALSE;
aErrm := E.Message + ' (' + IntToStr(fIDHTTP.ResponseCode) + ')';
end;
end;
finally
Stream.Free;
IDAntiFreeze.Free;
fIDHTTP.Free;
end;
end; { Download }
My personal favorite is using the WebHttpRequest component from importing the "Microsoft WinHTTP Services" type library: http://yoy.be/item.asp?i142
var
w:IWebHttpRequest;
f:TFileStream;
os:TOleStream;
begin
w:=CoWebHttpRequest.Create;
w.Open('GET',SourceURL,false);
w.Send(EmptyParam);
os:=TOleStream.Create(IUnknown(w.ResponseStream) as IStream);
f:=TFileStream.Create(DestinationFilePath,fmCreate);
os.Position:=0;
f.CopyFrom(os,os.Size);
f.Free;
os.Free;
w:=nil;
end;
I recommend Synapse. It's small, stable and easy-to-use (no need of any external libraries).
Example from httpsend.pas
function HttpGetText(const URL: string; const Response: TStrings): Boolean;
var
HTTP: THTTPSend;
begin
HTTP := THTTPSend.Create;
try
Result := HTTP.HTTPMethod('GET', URL);
if Result then
Response.LoadFromStream(HTTP.Document);
finally
HTTP.Free;
end;
end;
Instead of fiddling with the WinAPI, the ExtActns unit provides just what you need for downloading to a file.
procedure TMainForm.DownloadFile(URL: string; Dest: string);
var
dl: TDownloadURL;
begin
dl := TDownloadURL.Create(self);
try
dl.URL := URL;
dl.FileName := Dest;
dl.ExecuteTarget(nil); //this downloads the file
dl.Free;
except
dl.Free;
end;
end;
Under the hood, it uses URLDownloadToFile from the URLMon library - which is part of IE, and therefore part of Windows.
TDownloadURL doesn't handle any timeout for you - it doesn't look like such a thing is supported in URLMon at all, although there could be some default timeout that causes the call to fail - but you could use the OnProgress event on TDownloadURL to get notified when something happens, and then do something in another thread if it's been too long since the last callback.
Solved using improved version of the above code.
(it still does not solve all issues - MS does not actually implemented full support for server time out)
The connection does not timeout while downloading file from internet
Anyone knows other way to get a directoy's size, than calculate it's size by counting file with file? I'm interested on some win32 API function. I've google it about this, but i didn't found relevant information so i'm asking here.
PS: I know how to calculate a directory size by using findfirst and findnext and sum all file's size.
Getting the size of one directory is a pretty big problem, mostly because it's something you can't define. Examples of problems:
Some filesystems, including NTFS and most filesystems on Linux support the notion of "hard links". That is, the very same file may show up in multiple places. Soft links (reparse points) pose the same problem.
Windows allows mounting of file systems to directories. Example: "C:\DriveD" might be the same thing as "D:\".
Do you want the file size on disk or the actual size of the file?
Do you care about actual DIRECTORY entries? They also take up space!
What do you do with files you don't have access to? Or directories you don't have permission to browse? Do you count those?
Taking all this into account means the only possible implementation is a recursive implementation. You can write your own or hope you find a ready-written one, but the end performance would be the same.
I don't think there's an API for this. I don't think Windows knows the answer. i.e. it would have to recursively search the tree and summarize each folder, using the technique that Marcelo indicated.
If there were such an API call available, then other things would use it too and Windows would be able to immediately tell you folder sizes.
I already had a function to list files of a folder (and subfolders) and one to read the file size. So, I only wrote a small procedure that puts these two together.
ListFilesOf
function ListFilesOf(CONST aFolder, FileType: string; CONST ReturnFullPath, DigSubdirectories: Boolean): TTSL;
{ If DigSubdirectories is false, it will return only the top level files,
else it will return also the files in subdirectories of subdirectories.
If FullPath is true the returned files will have full path.
FileType can be something like '*.*' or '*.exe;*.bin'
Will show also the Hidden/System files.
Source Marco Cantu Delphi 2010 HandBook
// Works with UNC paths}
VAR
i: Integer;
s: string;
SubFolders, filesList: TStringDynArray;
MaskArray: TStringDynArray;
Predicate: TDirectory.TFilterPredicate;
procedure ListFiles(CONST aFolder: string);
VAR strFile: string;
begin
Predicate:=
function(const Path: string; const SearchRec: TSearchRec): Boolean
VAR Mask: string;
begin
for Mask in MaskArray DO
if System.Masks.MatchesMask(SearchRec.Name, Mask)
then EXIT(TRUE);
EXIT(FALSE);
end;
filesList:= TDirectory.GetFiles (aFolder, Predicate);
for strFile in filesList DO
if strFile<> '' { Bug undeva: imi intoarce doua intrari empty ('') }
then Result.Add(strFile);
end;
begin
{ I need this in order to prevent the EPathTooLongException (reported by some users) }
if aFolder.Length >= MAXPATH then
begin
MesajError('Path is longer than '+ IntToStr(MAXPATH)+ ' characters!');
EXIT(NIL);
end;
if NOT System.IOUtils.TDirectory.Exists (aFolder)
then RAISE Exception.Create('Folder does not exist! '+ CRLF+ aFolder);
Result:= TTSL.Create;
{ Split FileType in subcomponents }
MaskArray:= System.StrUtils.SplitString(FileType, ';');
{ Search the parent folder }
ListFiles(aFolder);
{ Search in all subfolders }
if DigSubdirectories then
begin
SubFolders:= TDirectory.GetDirectories(aFolder, TSearchOption.soAllDirectories, NIL);
for s in SubFolders DO
if cIO.DirectoryExists(s) { This solves the problem caused by broken 'Symbolic Link' folders }
then ListFiles(s);
end;
{ Remove full path }
if NOT ReturnFullPath then
for i:= 0 to Result.Count-1 DO
Result[i]:= TPath.GetFileName(Result[i]);
end;
GetFileSize
{ Works with >4GB files
Source: http://stackoverflow.com/questions/1642220/getting-size-of-a-file-in-delphi-2010-or-later }
function GetFileSize(const aFilename: String): Int64;
VAR
info: TWin32FileAttributeData;
begin
if GetFileAttributesEx(PWideChar(aFileName), GetFileExInfoStandard, #info)
then Result:= Int64(info.nFileSizeLow) or Int64(info.nFileSizeHigh shl 32)
else Result:= -1;
end;
Finally:
function GetFolderSize(aFolder: string; FileType: string= '*.*'; DigSubdirectories: Boolean= TRUE): Int64;
VAR
i: Integer;
TSL: TTSL;
begin
Result:= 0;
TSL:= ListFilesOf(aFolder, FileType, TRUE, DigSubdirectories);
TRY
for i:= 0 to TSL.Count-1 DO
Result:= Result+ GetFileSize(TSL[i]);
FINALLY
FreeAndNil(TSL);
END;
end;
Note that:
1. You can only count the size of some file types in a folder. For example in a folder containing BMP and JPEG files, if you want/need, you can only obtain the folder size only for BMP files.
2. Multiple filetypes are supported, like this: '.bmp;.png'.
3. You can choose if you want to read or not rea the size of the sub-folders.
Further improvements: You can massively reduce the size of the code by eliminating the GetFolderSize and moving the GetFileSize directly into ListFilesOf.
Guaranteed to work on Delphi XE7.
If you already know how to do another level, just use recursion to get every level. As your function traverses the current directory, if it comes across subdirectory, call the function recursively to get the size of that subdirectory.
You can use FindFile component. It will recursive the directories for you.
http://www.delphiarea.com/products/delphi-components/findfile/
Many of the previous examples of recurring find first and find next implementations do not consider the larger file capacities. Those examples do not produce correct results. A recursion routine that accommodates larger file capacities is available.
{*-----------------------------------------------------------------------------
Procedure: GetDirSize
Author: archman
Date: 21-May-2015
#Param dir: string; subdir: Boolean
#Return Int64
-----------------------------------------------------------------------------}
function TBCSDirSizeC.GetDirSize(dir: string; subdir: Boolean): Int64;
var
rec: TSearchRec;
found: Integer;
begin
Result := 0;
if dir[Length(dir)] <> '\' then
dir := dir + '\';
found := FindFirst(dir + '*.*', faAnyFile, rec);
while found = 0 do
begin
Inc(Result, rec.Size);
if (rec.Attr and faDirectory > 0) and (rec.Name[1] <> '.') and
(subdir = True) then
Inc(Result, GetDirSize(dir + rec.Name, True));
found := FindNext(rec);
end;
System.SysUtils.FindClose(rec);
end;
Please visit the link below for a complete explanation of the process.
http://bcsjava.com/blg/wordpress/2015/06/05/bcs-directory-size-delphi-xe8/