Jump to content


  • Content Count

  • Joined

  • Last visited

  • Days Won


0x8000FFFF last won the day on April 9

0x8000FFFF had the most liked content!

Community Reputation

5 Neutral

Technical Information

  • Delphi-Version
    Delphi 10.3 Rio

Recent Profile Visitors

41 profile views
  1. 0x8000FFFF

    List of usable RegEx for source code

    You can combine two expressions into one, though. If I were you I'd at least use \s+ instead of spaces and \s*\( instead of .*\(
  2. 0x8000FFFF

    Parse PIDL from Name located on portable device

    I wasn't able to identify the culprit, so I had to implement my own method for parsing PIDLs from names. There were two challenges involved: Split the name (path) of shell item into parts. Resolve relative PIDL of each part. Splitting the name by path delimiter isn't as easy as it may seem - especially when one needs to deal with ::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\\\?\usb#vid_2717&pid_ff40#062539717d28#{6ac27878-a6fa-4155-ba85-f98f491d4f33}. I created simple enumerator for that. To get relative PIDL of each part the parsing method uses IShellFolder.ParseDisplayName. If that fails (e.g. SID-{20001,,31611420672}) it uses IShellFolder::EnumObjects to find the part either by display name or parsing name. Here's the complete code: unit ShellUtils; interface uses System.SysUtils, System.Win.ComObj, Winapi.Windows, Winapi.ActiveX, Winapi.ShlObj, Winapi.ShLwApi; type TNamePartsEnumerator = record private FName: PChar; FStart: PChar; FEnd: PChar; function GetCurrent: string; function GetEnumerated: string; function GetTail: string; public constructor Create(Name: PChar); function GetEnumerator: TNamePartsEnumerator; function MoveNext: Boolean; procedure Reset; property Current: string read GetCurrent; property Enumerated: string read GetEnumerated; property Tail: string read GetTail; end; TParseResult = record private FError: string; FOleError: HRESULT; FPIDL: PItemIDList; public procedure RaiseException; property Error: string read FError; property OleError: HRESULT read FOleError; property PIDL: PItemIDList read FPIDL; end; function ParseDisplayName(const Name: string): PItemIDList; function TryParseDisplayName(const Name: string; out ParseResult: TParseResult): Boolean; overload; function TryParseDisplayName(const Name: string; out PIDL: PItemIDList): Boolean; overload; implementation { TNamePartsEnumerator } {$POINTERMATH ON} constructor TNamePartsEnumerator.Create(Name: PChar); begin FName := Name; Reset; end; function TNamePartsEnumerator.GetCurrent: string; begin if Assigned(FStart) then SetString(Result, FStart, FEnd - FStart) else Result := string.Empty; end; function TNamePartsEnumerator.GetEnumerated: string; begin SetString(Result, FName, FEnd - FName); end; function TNamePartsEnumerator.GetEnumerator: TNamePartsEnumerator; begin Result := Self; end; function TNamePartsEnumerator.GetTail: string; begin Result := FEnd; end; function TNamePartsEnumerator.MoveNext: Boolean; var NewStart: PChar; begin if (not Assigned(FEnd)) or (FEnd^ = #0) then Exit(False); if Assigned(FStart) then NewStart := FEnd + 1 else NewStart := FEnd; // special cases: \\?\ and \\.\ if (NewStart^ = '\') and ((NewStart + 1)^ = '\') and (((NewStart + 2)^ = '?') or ((NewStart + 2)^ = '.')) and ((NewStart + 1)^ = '\') then FEnd := NewStart + 4 else begin // skip consecutive path delimiters while NewStart^ = '\' do Inc(NewStart); FEnd := NewStart; if FEnd^ = #0 then Exit(False); end; FStart := NewStart; while (FEnd^ <> #0) and (FEnd^ <> '\') do FEnd := CharNext(FEnd); Result := True; end; procedure TNamePartsEnumerator.Reset; begin FStart := nil; FEnd := FName; end; {$POINTERMATH OFF} { TParseResult } procedure TParseResult.RaiseException; begin if not FError.IsEmpty then raise Exception.Create(FError); OleCheck(FOleError); end; function GetDisplayName(const Folder: IShellFolder; PIDL: PItemIDList; SHGDNFlags: DWORD): string; var StrRet: TStrRet; DisplayName: PChar; begin if Succeeded(Folder.GetDisplayNameOf(PIDL, SHGDNFlags, StrRet)) and Succeeded(StrRetToStr(@StrRet, PIDL, DisplayName)) then begin Result := DisplayName; CoTaskMemFree(DisplayName); end else Result := ''; end; function ParseDisplayName(const Name: string): PItemIDList; var ParseResult: TParseResult; begin if not TryParseDisplayName(Name, ParseResult) then ParseResult.RaiseException; Result := ParseResult.PIDL; end; function TryParseDisplayName(const Name: string; out ParseResult: TParseResult): Boolean; const SHCONTF_INCLUDESUPERHIDDEN = $10000; var Folder, Subfolder: IShellFolder; Enumerator: TNamePartsEnumerator; RelativePIDL, CombinedPIDL: PItemIDList; EnumIDList: IEnumIDList; Part: string; begin Result := False; ParseResult := Default(TParseResult); // take short path, if possible if Succeeded(SHParseDisplayName(PChar(Name), nil, ParseResult.FPIDL, 0, PDWORD(nil)^)) then begin Result := True; Exit; end; ParseResult.FOleError := SHGetDesktopFolder(Folder); if not Succeeded(ParseResult.FOleError) then Exit; ParseResult.FOleError := SHGetIDListFromObject(Folder, ParseResult.FPIDL); if not Succeeded(ParseResult.FOleError) then Exit; try Enumerator := TNamePartsEnumerator.Create(PChar(Name)); while Enumerator.MoveNext do begin Part := Enumerator.Current; if not Succeeded(Folder.ParseDisplayName(0, nil, PChar(Part), PULONG(nil)^, RelativePIDL, PULONG(nil)^)) then begin RelativePIDL := nil; ParseResult.FOleError := Folder.EnumObjects(0, SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN or SHCONTF_NONFOLDERS or SHCONTF_STORAGE or SHCONTF_INCLUDESUPERHIDDEN, EnumIDList); if not Succeeded(ParseResult.FOleError) then Exit; while EnumIDList.Next(1, RelativePIDL, PULONG(nil)^) = S_OK do begin if SameFileName(Part, GetDisplayName(Folder, RelativePIDL, SHGDN_INFOLDER or SHGDN_FORPARSING)) or SameFileName(Part, GetDisplayName(Folder, RelativePIDL, SHGDN_INFOLDER or SHGDN_FORADDRESSBAR)) then Break; CoTaskMemFree(RelativePIDL); RelativePIDL := nil; end; end; if not Assigned(RelativePIDL) then begin ParseResult.FError := 'Can''t find ' + Enumerator.Enumerated; Exit; end; try CombinedPIDL := ILCombine(ParseResult.FPIDL, RelativePIDL); CoTaskMemFree(ParseResult.FPIDL); ParseResult.FPIDL := CombinedPIDL; if not Enumerator.Tail.IsEmpty then begin ParseResult.FOleError := Folder.BindToObject(RelativePIDL, nil, IShellFolder, Subfolder); if not Succeeded(ParseResult.FOleError) then Exit; Folder := Subfolder; end; finally CoTaskMemFree(RelativePIDL); end; end; Result := True; finally // release intermediate PIDL in case of failure if (not Result) and Assigned(ParseResult.FPIDL) then begin CoTaskMemFree(ParseResult.FPIDL); ParseResult.FPIDL := nil; end; end; end; function TryParseDisplayName(const Name: string; out PIDL: PItemIDList): Boolean; var ParseResult: TParseResult; begin Result := TryParseDisplayName(Name, ParseResult); PIDL := ParseResult.PIDL; end; end. For the names like ::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\\\?\usb#vid_2717&pid_ff40#062539717d28#{6ac27878-a6fa-4155-ba85-f98f491d4f33}\SID-{20001,,31611420672}\{703540AE-0000-0000-0000-000000000000}\{0AE02E9E-0000-0000-0000-000000000000} it falls back to EnumObjects only for SID-{20001,,31611420672} part. This method can also parse display names like This PC\Redmi 6\SD card\DCIM\Camera, because it looks up items by display name. That is also what Raymond Chen suggested in his comment under How to use SHCreateItemFromParsingName with names from the shell namespace keeping in mind that display names are ambiguous. Another thing to point out is that looking up the item by display name via EnumObjects is inefficient and it can eventually be slow.
  3. 0x8000FFFF

    List of usable RegEx for source code

    Yes, I did, keeping in mind that RegEx provides only false sense of safety. RegEx can be used as an additional tool to well-established tools - static analysis and unit tests.
  4. 0x8000FFFF

    List of usable RegEx for source code

    I'd rather say that it's impossible to write RegEx that will reliably catch issues listed in the original post. New Delphi LSP may provide improvements in this area.
  5. 0x8000FFFF

    List of usable RegEx for source code

    RegEx isn't the right tool for this job. Consider using static analysis. Are there any static code analysis tools for Delphi/Pascal? Which program analysis tools for Delphi support continuous integration systems? ...
  6. There are at least 4 APIs ta parse names as PIDL or IShellItem in Shell Namespace: SHParseDisplayName SHCreateItemFromParsingName IShellFolder.ParseDisplayName ILCreateFromPath (SHILCreateFromPath) They all work fine for regular file system items, but fail to parse names to files and folders an portable devices. I obtain these names by letting the user to select a file in TVirtualExplorerEasyListview control and calling SHGetNameFromIDList with selected (absolute) PIDL and SIGDN_DESKTOPABSOLUTEPARSING. I store the name as string because the application comes back to it later (possibly after the application was closed and opened again) to process the file. At that point I need to parse PIDL from Name and bind it to IStream object to read the content of the file. It makes me sad that I can't restore PIDL from parsing names of some items. The typical parsing name is ::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\\\?\usb#vid_2717&pid_ff40#062539717d28#{6ac27878-a6fa-4155-ba85-f98f491d4f33}\SID-{20001,,31611420672}\{703540AE-0000-0000-0000-000000000000}\{0AE02E9E-0000-0000-0000-000000000000} which consists of these parts: ::{20D04FE0-3AEA-1069-A2D8-08002B30309D} This PC \\?\usb#vid_2717&pid_ff40#062539717d28#{6ac27878-a6fa-4155-ba85-f98f491d4f33} Redmi 6 (device name) SID-{20001,,31611420672} SD card {703540AE-0000-0000-0000-000000000000} DCIM {0AE02E9E-0000-0000-0000-000000000000} Camera I came across this thread which mentions that there's something broken in Windows 10 ver. 1703 (Creators Update). It also pointed my attention to the part that starts with SID-. When I replace this part with its display name (SD card), the parsing APIs start to work. I created this sample (commandline) application to test the parsing APIs: program Parse; {$APPTYPE CONSOLE} {$R *.res} uses System.SysUtils, System.Win.ComObj, Winapi.Windows, Winapi.ActiveX, Winapi.ShlObj; type TParseFunc = function(const Name: string): PItemIDList; function GetBindCtx: IBindCtx; begin Result := nil; end; function ParseUsingSHParseDisplayName(const Name: string): PItemIDList; begin OLECheck(SHParseDisplayName(PChar(Name), GetBindCtx, Result, 0, PULONG(nil)^)); end; function ParseUsingSHCreateItemFromParsingName(const Name: string): PItemIDList; var ShellItem: IShellItem; begin OleCheck(SHCreateItemFromParsingName(PChar(Name), GetBindCtx, IShellItem, ShellItem)); OleCheck(SHGetIDListFromObject(ShellItem, Result)); end; function ParseUsingDesktopParseDisplayName(const Name: string): PItemIDList; var Desktop: IShellFolder; begin OleCheck(SHGetDesktopFolder(Desktop)); OleCheck(Desktop.ParseDisplayName(0, GetBindCtx, PChar(Name), PULONG(nil)^, Result, PULONG(nil)^)); end; function ParseUsingILCreateFromPath(const Name: string): PItemIDList; begin Result := ILCreateFromPath(PChar(Name)); if not Assigned(Result) then RaiseLastOSError; end; procedure TestParse(const MethodName, Name: string; Parse: TParseFunc); var PIDL: PItemIDList; PName: PWideChar; begin Writeln(MethodName); try PIDL := Parse(Name); try if Succeeded(SHGetNameFromIDList(PIDL, Integer(SIGDN_DESKTOPABSOLUTEEDITING), PName)) then begin Writeln('Display name: ', PName); CoTaskMemFree(PName); end; if Succeeded(SHGetNameFromIDList(PIDL, Integer(SIGDN_DESKTOPABSOLUTEPARSING), PName)) then begin Writeln('Parsing name: ', PName); CoTaskMemFree(PName); end; finally CoTaskMemFree(PIDL); end; except on E: Exception do Writeln('[', E.ClassName, '] ', E.Message); end; Writeln; end; procedure Main; var Name: string; begin Name := ParamStr(1); Writeln('Name: ', Name); TestParse('SHParseDisplayName', Name, ParseUsingSHParseDisplayName); TestParse('SHCreateItemFromParsingName', Name, ParseUsingSHCreateItemFromParsingName); TestParse('Desktop.ParseDisplayName', Name, ParseUsingDesktopParseDisplayName); TestParse('ILCreateFromPath', Name, ParseUsingILCreateFromPath); end; begin CoInitialize(nil); Main; CoUninitialize; end. This is what I got with various names on input: Parse.exe Parse.exe C:\ Parse.exe "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\\\?\usb#vid_2717&pid_ff40#062539717d28#{6ac27878-a6fa-4155-ba85-f98f491d4f33}" Parse.exe "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\\\?\usb#vid_2717&pid_ff40#062539717d28#{6ac27878-a6fa-4155-ba85-f98f491d4f33}\SID-{20001,,31611420672}" Parse.exe "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\\\?\usb#vid_2717&pid_ff40#062539717d28#{6ac27878-a6fa-4155-ba85-f98f491d4f33}\SD card" At this point if I use folder name (DCIM\Camera) or GUID ({703540AE-0000-0000-0000-000000000000}\{0AE02E9E-0000-0000-0000-000000000000}) from original parsing name beyond SD card, all of that will work. There is also Internal storage at the same level as SD card, which has name for parsing SID-{10001,,25710370816}. Parsing APIs fail to parse this name either. I have also tried other devices with the same results. I don't have pre-1703 Windows 10 or older Windows system at hand to try that, but I want my application to work on any Windows 7+ platform. Can anybody explain what is going on here or point me to some relevant resources?