How can I use Delphi to test if a Directory is writeable? - windows

Currently I use this function, based on JCL code, which works fine:
function IsDirectoryWriteable(const AName: string): Boolean;
var
FileName: PWideChar;
H: THandle;
begin
FileName := PWideChar(IncludeTrailingPathDelimiter(AName) + 'chk.tmp');
H := CreateFile(FileName, GENERIC_READ or GENERIC_WRITE, 0, nil,
CREATE_NEW, FILE_ATTRIBUTE_TEMPORARY or FILE_FLAG_DELETE_ON_CLOSE, 0);
Result := H <> INVALID_HANDLE_VALUE;
DeleteFile(FileName);
end;
Is there anything I could improve with the flags?
Can the test be done without actually creating a file?
Or is this functionality even already available in one of the RTL or Jedi libraries?

Actually writing to the directory is the simpliest way to determine if the directory is writable. There are too many security options available to check individually, and even then you might miss something.
You also need to close the opened handle before calling DeleteFile(). Which you do not need to call anyway since you are using the FILE_FLAG_DELETE_ON_CLOSE flag.
BTW, there is a small bug in your code. You are creating a temporary String and assigning it to a PWideChar, but the String goes out of scope, freeing the memory, before the PWideChar is actually used. Your FileName variable should be a String instead of a PWideChar. Do the type-cast when calling CreateFile(), not before.
Try this:
function IsDirectoryWriteable(const AName: string): Boolean;
var
FileName: String;
H: THandle;
begin
FileName := IncludeTrailingPathDelimiter(AName) + 'chk.tmp';
H := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE, 0, nil,
CREATE_NEW, FILE_ATTRIBUTE_TEMPORARY or FILE_FLAG_DELETE_ON_CLOSE, 0);
Result := H <> INVALID_HANDLE_VALUE;
if Result then CloseHandle(H);
end;

Here is my version using GetTempFileName which will attempt to create a unique temp file in the target directory:
function IsDirecoryWriteable(const AName: string): Boolean;
var
TempFileName: array[0..MAX_PATH] of Char;
begin
{ attempt to create a temp file in the directory }
Result := GetTempFileName(PChar(AName), '$', 0, TempFileName) <> 0;
if Result then
{ clean up }
Result := DeleteFile(TempFileName);
end;

Andreas...
Using the security APIs to get the effective rights for a file/directory is a PIA mess and just not reliable. (I dumped all of my code for doing so in favor of just checking to see if I could write a file in the dir.)
C.f., http://www.ureader.com/msg/16591730.aspx
(I have other refs., but I'm a new user and can post only one link. Just follow along with the URLS given in the link above.)

Surely all you need to do is verify your Access Rights to the Directory. What is wrong with this:
function IsDirectoryWriteable(aName : String);
var
FileObject : TJwSecureFileObject;
DesiredAccess: ACCESS_MASK;
begin
DesiredAccess := FILE_GENERIC_WRITE;
FileObject := TJwSecureFileObject.Create(aName);
try
result := FileObject.AccessCheck(DesiredAccess);
finally
FileObject.Free;
end;
end;

Related

Delphi: how can i get list of running applications with starting path?

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.

Retrieve the default associated file types of an application?

The function ShellFindExecutable allows finding the program which is associated with a specific file type:
function ShellFindExecutable(const FileName, DefaultDir: string): string;
var
Res: HINST;
Buffer: array [0..MAX_PATH-1] of Char;
I: Integer;
begin
ResetMemory(Buffer, SizeOf(Buffer));
Res := FindExecutable(PChar(FileName), PCharOrNil(DefaultDir), Buffer);
if Res > 32 then
begin
// FindExecutable replaces #32 with #0
for I := Low(Buffer) to High(Buffer) - 1 do
if Buffer[I] = #0 then
Buffer[I] := #32;
Buffer[High(Buffer)] := #0;
Result := Trim(Buffer);
end
else
Result := '';
end;
For example:
DefProgram := ShellFindExecutable('R:\test.txt', '');
// DefProgram: C:\Program Files (x86)\Notepad++\notepad++.exe
But how can I find the file type(s)/extension(s) for which a specific existing program is the default associated application?
Delphi 10.1 Berlin
Windows 7 x64
I don't believe that there is an API function specifically to do that. You will need to iterate through each registered extension, for instance by enumerating keys in HKCR, and check which executable is associated with the open verb.
Rather than using FindAssociation I suspect that IQueryAssociations will be more efficient and robust.
Furthermore what you claim about FindAssociation replacing spaces with nulls is simply not true. You can replace the body of your if statement with Result := Buffer.

How can I read 64-bit registry key from a 32-bit process?

I've been using the value of key MachineGuid from HKEY_LOCAL_MACHINE\Software\Microsoft\Cryptography to uniquely identify hosts, but from 32-bit processes running on 64-bit computers, the value appears to be missing. I guess it's searching under Wow6432Node, where it is indeed missing. According to this you should be able to get to the right key by adding a flag, but below code still doesn't appear to do the job. What am I missing?
const
KEY_WOW64_64KEY=$0100;
var
r:HKEY;
s:string;
i,l:integer;
begin
//use cryptography machineguid, keep a local copy of this in initialization?
l:=40;
if RegOpenKeyEx(HKEY_LOCAL_MACHINE,PChar('Software\Microsoft\Cryptography'),
0,KEY_QUERY_VALUE,r)=ERROR_SUCCESS then
begin
SetLength(s,l);
if RegQueryValue(r,'MachineGuid',PChar(s),l)=ERROR_SUCCESS then
begin
SetLength(s,l);
RegCloseKey(r);
end
else
begin
//try from-32-to-64
RegCloseKey(r);
if RegOpenKeyEx(HKEY_LOCAL_MACHINE,PChar('Software\Microsoft\Cryptography'),
0,KEY_QUERY_VALUE or KEY_WOW64_64KEY,r)=ERROR_SUCCESS then
begin
l:=40;
if RegQueryValue(r,'MachineGuid',PChar(s),l)=ERROR_SUCCESS then
SetLength(s,l)
else
l:=0;
RegCloseKey(r);
end;
end;
end;
I would suggest you use the IsWow64Process() function to know when you are a 32-process running on a 64-bit OS, and then only apply the KEY_WOW64_64KEY flags in that specific condition. If the app is a 32-bit process on a 32-bit OS, or a 64-bit process on a 64-bit OS, the flags is not needed.
For example:
const
KEY_WOW64_64KEY = $0100;
var
key: HKEY;
str: string;
len: DWORD;
flag: REGSAM;
wow64: BOOL;
begin
flag := 0;
wow64 := 0;
IsWow64Process(GetCurrentProcess(), #wow64);
if wow64 <> 0 then flag := KEY_WOW64_64KEY;
if RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Cryptography', 0, KEY_QUERY_VALUE or flag, key) = ERROR_SUCCESS then
try
SetLength(str, 40);
len := Length(str) * SizeOf(Char);
if RegQueryValueEx(key, 'MachineGuid', nil, nil, PByte(Pointer(s)), #len) <> ERROR_SUCCESS then len := 0;
SetLength(str, len div SizeOf(Char));
finally
RegCloseKey(key);
end;
end;
Your code is needlessly complex, largely because you are not taking advantage of the built-in TRegistry class which shields you from all the complexities of the low-level registry API. For example, consider the following code:
type
TRegistryView = (rvDefault, rvRegistry64, rvRegistry32);
function RegistryViewAccessFlag(View: TRegistryView): LongWord;
begin
case View of
rvDefault:
Result := 0;
rvRegistry64:
Result := KEY_WOW64_64KEY;
rvRegistry32:
Result := KEY_WOW64_32KEY;
end;
end;
function ReadRegStr(const Root: HKEY; const Key, Name: string;
const View: TRegistryView=rvDefault): string;
var
Registry: TRegistry;
begin
Registry := TRegistry.Create(KEY_READ or RegistryViewAccessFlag(View));
try
Registry.RootKey := Root;
if not Registry.OpenKey(Key) then
raise ERegistryException.CreateFmt('Key not found: %s', [Key]);
if not Registry.ValueExists(Name) then
raise ERegistryException.CreateFmt('Name not found: %s\%s', [Key, Name]);
Result := Registry.ReadString(Name);//will raise exception in case of failure
finally
Registry.Free;
end;
end;
The function ReadRegStr will return the string value named Name from the key Key relative to the root key Root. If there is an error, for example if the key or name do not exists, or if the value is of the wrong type, then an exception will be raised.
The View parameter is an enumeration that makes it simple for you to access native, 32-bit or 64-bit views of the registry. Note that native means native to the process that is running. So it will be the 32-bit view for a 32-bit process and the 64-bit view for a 64-bit process. This enumeration mirrors the equivalent definition in .net.
In my use of this registry key I went a step further. If the value didn't exist I created it: not in HKEY_LOCAL_MACHINE, that would require elevation, but in HKEY_CURRENT_USER. Anyone seeing the introduced key there is unlikely to realise that it's a dummy.
function GetComputerGUID: String;
var
Reg: TRegistry;
oGuid: TGUID;
sGuid: String;
begin
Result := '';
// Attempt to retrieve the real key
Reg := TRegistry.Create(KEY_READ OR KEY_WOW64_64KEY);
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Cryptography') and Reg.ValueExists('MachineGuid') then
Result := Reg.ReadString('MachineGuid');
Reg.CloseKey;
finally
Reg.Free;
end;
// If retrieval fails, look for the surrogate
if Result = '' then begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('SOFTWARE\Microsoft\Cryptography', True) then begin
if Reg.ValueExists('MachineGuid') then
Result := Reg.ReadString('MachineGuid')
else begin
// If the surrogate doesn't exist, create it
if CreateGUID(oGUID) = 0 then begin
sGuid := Lowercase(GUIDToString(oGUID));
Reg.WriteString('MachineGuid', Copy(sGuid, 2, Length(sGUID) - 2));
Result := Reg.ReadString('MachineGuid');
end;
end;
end;
Reg.CloseKey;
finally
Reg.Free;
end;
end;
if Result = '' then
raise Exception.Create('Unable to access registry value in GetComputerGUID');
end;
That's a good point from #Remy Lebeau - TeamB though; I should mod the above code appropriately.
Call reg.exe using this path
C:\Windows\sysnative\reg.exe
For example:
C:\Windows\sysnative\reg.exe QUERY "HKLM\SOFTWARE\JavaSoft\JDK" /v CurrentVersion
source: https://stackoverflow.com/a/25103599

Inno Setup image download

I'm working with Inno Setup Compiler (Pascal Scripting).
My form has an image object (TBitmapImage) and I'd like to supply a dynamic image obtained from the web URL. Is it possible to silently download an image (or other type of file) in Inno Setup scripting?
I would write a small Win32 program that downloads a file from the Internet, such as
program dwnld;
uses
SysUtils, Windows, WinInet;
const
PARAM_USER_AGENT = 1;
PARAM_URL = 2;
PARAM_FILE_NAME = 3;
function DownloadFile(const UserAgent, URL, FileName: string): boolean;
const
BUF_SIZE = 4096;
var
hInet, hURL: HINTERNET;
f: file;
buf: PByte;
amtc: cardinal;
amti: integer;
begin
result := false;
hInet := InternetOpen(PChar(UserAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
try
hURL := InternetOpenUrl(hInet, PChar(URL), nil, 0, 0, 0);
try
GetMem(buf, BUF_SIZE);
try
FileMode := fmOpenWrite;
AssignFile(f, FileName);
try
Rewrite(f, 1);
repeat
InternetReadFile(hURL, buf, BUF_SIZE, amtc);
BlockWrite(f, buf^, amtc, amti);
until amtc = 0;
result := true;
finally
CloseFile(f);
end;
finally
FreeMem(buf);
end;
finally
InternetCloseHandle(hURL);
end;
finally
InternetCloseHandle(hInet);
end;
end;
begin
ExitCode := 0;
if ParamCount < 3 then
begin
MessageBox(0,
PChar(Format('%s: This program requires three command-line arguments.',
[ExtractFileName(ParamStr(0))])),
PChar(ExtractFileName(ParamStr(0))),
MB_ICONERROR);
Exit;
end;
if FileExists(ParamStr(PARAM_FILE_NAME)) then
DeleteFile(PChar(ParamStr(PARAM_FILE_NAME)));
if DownloadFile(ParamStr(PARAM_USER_AGENT), ParamStr(PARAM_URL),
ParamStr(PARAM_FILE_NAME)) then
ExitCode := 1;
end.
This program takes three command-line arguments: the UserAgent to be sent to the web server (can be anything, such as "MyApp Setup Utility"), the URL of the file on the Internet, and the file name of the file that is being created. Don't forget to enclose the arguments inside quotation marks ("). The exit code of the program is 0 if the download failed, and 1 if the download succeeded.
Then, in your Inno Setup script, you can do
[Files]
Source: "dwnld.exe"; DestDir: "{app}"; Flags: dontcopy
[Code]
function InitializeSetup: boolean;
var
ResultCode: integer;
begin
ExtractTemporaryFile('dwnld.exe');
if Exec(ExpandConstant('{tmp}\dwnld.exe'),
ExpandConstant('"{AppName} Setup Utility" "http://privat.rejbrand.se/sample.bmp" "{tmp}\bg.bmp"'),
'', SW_SHOWNORMAL, ewWaitUntilTerminated, ResultCode) then
if ResultCode = 1 then
(* Now you can do something with the file ExpandConstant('{tmp}\bg.bmp') *);
end;
Unfortunately, however, I know of no means by which you can change the WizardImageFile during runtime...
It's actually possible to download almost anything from the web using InnoTools Downloader.
Inno setup doesnt have any inbuilt functions for this, however, you can perform this action using batch files that do the job for you.
1) download a command line URL resource downloader like -
http://www.chami.com/free/url2file_wincon.html
Some tips on how to use it -
http://www.chami.com/tips/windows/062598W.html
2) Package it in your installer
3) create a batch file that calls url2file.exe and fetches your image into the app directory
4) Call this batch file in the initialize setup command of Inno Setup installer script.
5) Use that image wherever you want!
ps - If you are using the image in the setup, check if differed image loading is allowed or not.. i am not sure about that.
Let me know if you have any other questions

Why do I get an "Invalid handle" error using GetFileSizeEx() with files marked read-only?

When I use the Windows API call GetFileSizeEx() from my Delphi 6 app on a read-only file, I get an O/S error code 6 ("Invalid file handle"). If I remove the read-only attribute from the file, the error disappears. Why am I getting that error and is there a way to use that call or a similar one with read-only files?
Here's the relevant code:
function GetFileSizeEx(hFile: THandle; var FileSize: Int64): BOOL; stdcall; external 'kernel32.dll' name 'GetFileSizeEx';
function easyGetFileSize(theFileHandle: THandle): Int64;
begin
if not GetFileSizeEx(theFileHandle, Result) then
RaiseLastOSError;
end;
-- roschler
Did you check the result of opening the file to get the file handle? Obviously if the file failed to open, you're calling GetFileSizeEx with an invalid handle. You'll need to open the file in a read-only mode.
Maybe something like this?
function GetFileSize_(CONST sFilename: string): Int64; { NOT TESTED }
VAR aHandle: THandle;
begin
aHandle:= CreateFile(PChar(sFilename), GENERIC_READ, FILE_SHARE_READ, NIL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if aHandle = INVALID_HANDLE_VALUE
then Result:= -1
else
begin
GetFileSizeEx(aHandle, Result);
FileClose(aHandle);
end;
end;

Resources