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.
Related
I want to search for a file on all disks on the system. I already know how to search on a single disk from this question: How to Search a File through all the SubDirectories in Delphi
I use it as
function TMyForm.FileSearch(const dirName: string);
...
FileSearch('C:');
What I do not know how to do is use it to find files on all available drive letters, C, D, E etc. How can I find a list of those available drive letters?
You can just get a list of available drives, and loop through them calling your function.
In recent versions of Delphi you can use IOUtils.TDirectory.GetLogicalDrives to retrieve a list of all drive letters easily.
uses
System.Types, System.IOUtils;
var
Drives: TStringDynArray;
Drive: string
begin
Drives := TDirectory.GetLogicalDrives;
for s in Drives do
FileSearch(s);
end;
For older versions of Delphi that don't contain IOUtils, you can use the WinAPI function GetLogicalDriveStrings. It's considerably more complicated to use, but here's some code that wraps it for you. (You'll need Windows, SysUtils, and Types in your uses clause.)
function GetLogicalDrives: TStringDynArray;
var
Buff: String;
BuffLen: Integer;
ptr: PChar;
Ret: Integer;
nDrives: Integer;
begin
BuffLen := 20; // Allow for A:\#0B:\#0C:\#0D:\#0#0 initially
SetLength(Buff, BuffLen);
Ret := GetLogicalDriveStrings(BuffLen, PChar(Buff));
if Ret > BuffLen then
begin
// Not enough memory allocated. Result has buffer size needed.
// Allocate more space and ask again for list.
BuffLen := Ret;
SetLength(Buff, BuffLen);
Ret := GetLogicalDriveStrings(BuffLen, PChar(Buff));
end;
// If we've failed at this point, there's nothing we can do. Calling code
// should call GetLastError() to find out why it failed.
if Ret = 0 then
Exit;
SetLength(Result, 26); // There can't be more than 26 drives (A..Z). We'll adjust later.
nDrives := -1;
ptr := PChar(Buff);
while StrLen(ptr) > 0 do
begin
Inc(nDrives);
Result[nDrives] := String(ptr);
ptr := StrEnd(ptr);
Inc(ptr);
end;
SetLength(Result, nDrives + 1);
end;
I have tried the following code (and varients) without any sucess, nor can I find any examples of how to call these Windows Functions from Delphi out there. Any clues would be very gratefully received.
The CryptProtectMemory does appear to produce some possibly encrypted result, but the unprotect does not change that result at all.I suspect I have done something charactisticly stupid, but I havent found it all day...
function WinMemEnc(PlnTxt: String): String;
var
Enc: Pointer;
j: Integer;
EncSze: Cardinal;
ws: String;
const
CRYPTPROTECTMEMORY_SAME_PROCESS: Cardinal = 0;
EncryptionBlockSize: Integer = 8;
begin
if Length(PlnTxt) mod EncryptionBlockSize = 0 then
j := Length(PlnTxt)
else
j := ((Length(PlnTxt) div 8) + 1) * 8;
ws := StringofChar(' ', j);
Move(PlnTxt[1], ws[1], j);
Enc := Pointer(ws);
EncSze := j * 2;
if CryptProtectMemory(Enc, EncSze, CRYPTPROTECTMEMORY_SAME_PROCESS) then
begin
Setlength(Result, j);
Move(Enc, Result[1], EncSze);
end;
end;
function WinMemDcr(EncInp: String): String;
var
Enc: Pointer;
j: Integer;
EncSze: Cardinal;
ws: String;
const
CRYPTPROTECTMEMORY_SAME_PROCESS: Cardinal = 0;
begin
j := Length(EncInp);
EncSze := j * 2;
ws := EncInp;
Enc := Pointer(ws);
if CryptUnprotectMemory(Enc, EncSze, CRYPTPROTECTMEMORY_SAME_PROCESS) then
begin
Setlength(Result, j);
Move(Enc, Result[1], EncSze);
end;
end;
You have set EncryptionBlockSize := 8; while in my library CRYPTPROTECTMEMORY_BLOCK_SIZE = 16.
You also mistakenly move only half of the input string to ws, because j holds the length of the string while Move() moves Count number of bytes. A Unicode Char is 2 bytes.
As said in the comments, encryption/decryption works on bytes and storing an encryption in a string is a potential disaster.
So here's my suggestion for a encryption/decryption of a string with encrypted storage in TBytes.
function MemEncrypt(const StrInp: String): TBytes;
begin
Result := TEncoding.Unicode.GetBytes(StrInp);
if Length(Result) mod CRYPTPROTECTMEMORY_BLOCK_SIZE <> 0 then
SetLength(Result, ((Length(Result) div CRYPTPROTECTMEMORY_BLOCK_SIZE) + 1) * CRYPTPROTECTMEMORY_BLOCK_SIZE);
if not CryptProtectMemory(Result, Length(Result), CRYPTPROTECTMEMORY_SAME_PROCESS) then
raise Exception.Create('Error Message: '+IntToStr(GetLastError));
end;
function MemDecrypt(const EncInp: TBytes): String;
var
EncTmp: TBytes;
begin
EncTmp := Copy(EncInp);
if CryptUnprotectMemory(EncTmp, Length(EncTmp), CRYPTPROTECTMEMORY_SAME_PROCESS) then
result := TEncoding.Unicode.GetString(EncTmp)
else
raise Exception.Create('Error Message: '+IntToStr(GetLastError));
end;
In the decryption a copy of the input TBytes is made to preserve the encrypted data.
And finally a test procedure:
procedure TForm13.Button2Click(Sender: TObject);
const
Txt = '1234567890123456789012345678901';
var
s: string;
b: TBytes;
begin
s := Txt;
Memo1.Lines.Add(s);
b := MemEncrypt(Txt);
s := MemDecrypt(b);
Memo1.Lines.Add(s);
end;
Without testing it (purely from the looks of your code), I believe the problem lies in the MOVE statement:
Move(Enc, Result[1], EncSze);
You are moving data from the location of the pointer - not from the data that the pointer is pointing to.
You should use
Move(Enc^, Result[1], EncSze);
to move data from the location that is POINTED TO by the pointer, and not from the pointer itself.
To clarify: The Enc variable is - say - located at address $12345678 and the data you are manipulating is located at address $99999999
This means that at address $12345678 is located 4 bytes ($99 $99 $99 and $99). And at address $99999999 is located the data you are manipulating.
The statement
Move(Enc, Result[1], EncSze);
thus moves EncSize bytes from the address $12345678 to the 1st character of the string variable Result. This you do not want, as it will only move 4 bytes of $99 and then whatever follows at address $1234567C and on.
To move data from the address $99999999 you need to tell the compiler, that you want to move data from the location POINTED TO by the pointer, and not from the POINTER itself:
Move(Enc^, Result[1], EncSze);
But other that that, I agree with David. You should stop using strings as storage for non-string data. It'll bite you in the a** at some point. Use a byte array (TBytes) instead.
As in topic, is it possible? And, I want to display them on one page of installer if parameter (e.g. parameter passed to exe file) is set to true.
I know how to display some page:
if dev then
PageWersjePlikow :=
CreateOutputMsgMemoPage(
1, 'Wersje plików zawarte w instalatorze',
'Lista plików niewidoczna dla klienta',
'Pliki:', 'TU WPISAĆ WERSJE PLIKÓW');
I have some ideas, but every idea is based on .txt file built while compiling exe installer and then read from it...
Use GetVersionNumbers or GetVersionNumbersString support functions.
The GetVersionNumbersString returns version in format Major.Minor.Rev.Build.
If you need a different format, you need to use GetVersionNumbers and format the version components, the way you need (like Major.Minor.Rev):
function MyGetVersionNumbersString(
const Filename: String; var Version: String): Boolean;
var
MS, LS: Cardinal;
Major, Minor, Rev, Build: Cardinal;
begin
Result := GetVersionNumbers(Filename, MS, LS);
if Result then
begin
Major := MS shr 16;
Minor := MS and $FFFF;
Rev := LS shr 16;
Build := LS and $FFFF;
Version := Format('%d.%d.%d', [Major, Minor, Rev]);
end
end;
Thank you! I have found solution for checking cmd parameter:
function GetParam: Boolean;
var
param: string;
i: integer;
begin
Result := False;
for i:= 0 to ParamCount do
begin
param := ParamStr(i);
if (param = '-p') then
begin
Result := True;
break;
end;
end;
end;
With my function I can just run my installer with '-p' parameter and it will show my page containing information which I want :-)
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
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;