Jump to content

0x8000FFFF

Members
  • Content Count

    25
  • Joined

  • Last visited

  • Days Won

    3

Everything posted by 0x8000FFFF

  1. This can't be done due to unfortunate design of TCookieManager class. The class is pretty much sealed for extension, because it lacks virtual methods. The best you can do is to apply nasty hacks or crate a QP ticket.
  2. 0x8000FFFF

    Delphi Icons with Version Info

    I use ie4uinit.exe -show to refresh icon cache. Source: Refresh Icon Cache Without Rebooting
  3. 0x8000FFFF

    Debug ISAPI on Windows 11

    I use IIS Express to debug 32/64-bit ISAPI modules by specifying iisexpress.exe as host application and /config parameter to point to ApplicationHost.config that configures web site that hosts the module.
  4. To add - DebuggerDisplayAttribute
  5. 0x8000FFFF

    Is a number in a string of numbers??

    \b47\b https://regex101.com/r/FhA9Hx/1
  6. First time I see this phrase. Makes sense.
  7. 0x8000FFFF

    Why empty dynamic arrays = NIL?

    Legacy code, libraries, defensive programming, input sanitization and normalization, data from unknown sources, ... Null-coalescing operator used with strings falls into the same category (s ?? ""). Luckily C# has made some improvements in this area by introducing nullable reference types since version 8.0.
  8. 0x8000FFFF

    Why empty dynamic arrays = NIL?

    I'm quite happy that I don't need any string.IsNullOrEmpty all over the place in my Delphi code as opposed to C#.
  9. 0x8000FFFF

    Why empty dynamic arrays = NIL?

    Isn't that the case for string? When it's empty, it's a pointer to empty, no? An empty string is equal to nil pointer. Try this: var s := ''; Writeln(Format('%p', [Pointer(s)])); One of the differences between arrays and lists is that even empty lists can have pre-allocated capacity. This is often an overlook feature of lists which helps reducing reallocations while populating the list if you know (or can estimate) the count in advance.
  10. 0x8000FFFF

    TPopupMenu with group headers

    Maybe you should disable the item anyway to prevent navigating to it using arrow keys.
  11. 0x8000FFFF

    Anybody changing FileVersion directly in dproj file?

    See also: How to define application version in one place for multiple applications? Delphi Version number central but other info decentral
  12. 0x8000FFFF

    10.4.1+ Custom Managed Records usable?

    We already have if and case statements in Delphi, we don't have expressions though. Expressions are parts of statements. Speaking of Oxygene, don't forget to mention colon operator, lambda expressions, for loop expressions, async & await (.NET only) expressions and more ... See also this Q&A that relates to the topic discussed in this thread - ternary conditional operator, null-coalescing operator (Elvis operator) and Oxygene colon operator: Escape from chain of Assigned() in Delphi It also provides some QP links of feature requests.
  13. 0x8000FFFF

    Return an array from a function??

    There is one fundamental thing missing in your function - copying the field values. The other thing is that you don't need to mess with TVarRec at all. Here's how I would do it: function RecordToArray(DS: TDataSet): TArray<Variant>; var FieldIndex: Integer; begin SetLength(Result, DS.FieldCount); for FieldIndex := 0 to DS.FieldCount - 1 do Result[FieldIndex] := DS.Fields[FieldIndex].Value; end; procedure ArrayToRecord(DS: TDataSet; const Values: TArray<Variant>); var FieldIndex: Integer; begin Assert(DS.FieldCount = Length(Values)); for FieldIndex := 0 to DS.FieldCount - 1 do DS.Fields[FieldIndex].Value := Values[FieldIndex]; end; Another option is to use variant array: function RecordToVarArray(DS: TDataSet): Variant; var FieldIndex: Integer; Data: PVariant; begin Result := VarArrayCreate([0, DS.FieldCount - 1], varVariant); Data := VarArrayLock(Result); try for FieldIndex := 0 to DS.FieldCount - 1 do begin Data^ := DS.Fields[FieldIndex].Value; Inc(Data); // move to next elemnt in resulting array end; finally VarArrayUnlock(Result); end; end; procedure VarArrayToRecord(DS: TDataSet; const Values: Variant); var FieldIndex: Integer; Data: PVariant; begin Assert(VarIsType(Values, varArray or varVariant)); Assert(VarArrayDimCount(Values) = 1); Data := VarArrayLock(Values); try for FieldIndex := 0 to DS.FieldCount - 1 do begin DS.Fields[FieldIndex].Value := Data^; Inc(Data); // move to next elemnt in resulting array end; finally VarArrayUnlock(Values); end; end; // you could then access those value using index: var Values := RecordToVarArray(DS); Writeln(VarToStr(Values[0])); Writeln(VarToStr(Values[1])); ...
  14. 0x8000FFFF

    Delphi and Azure DevOps?

    Jolyon Smith published series of articles in his blog about integration with Azure DevOps. You'll find much useful information there.
  15. 0x8000FFFF

    UnEscape JSON string

    What do you mean, what is the difference between 'the whole JSON string' and 'a certaing value'? Can you name some examples?
  16. 0x8000FFFF

    UnEscape JSON string

    var JSONValue := TJSONObject.ParseJSONValue('"multi\nline"'); Writeln(JSONValue.Value); JSONValue.Free; yields
  17. 0x8000FFFF

    Pos

    Back to the original topic Funnily enough TrimStart and TrimEnd helper methods exist in TStringHelper, but were deprecated in favor of TrimLeft and TrimRight: TStringHelper = record helper for string { ... } function TrimEnd(const TrimChars: array of Char): string; deprecated 'Use TrimRight'; function TrimStart(const TrimChars: array of Char): string; deprecated 'Use TrimLeft'; { ... } end;
  18. 0x8000FFFF

    Pos

    Although deprecated, I especially like stringByReplacingPercentEscapesUsingEncoding a.k.a. urlDecode.
  19. Even if there would be an option to define an "alias", some programmers will never give up using with clause. The would do it because they can. This is excerpt from InputQuery in Vcl.Dialogs.pas: Form := TInputQueryForm.CreateNew(Application); with Form do try ... finally Form.Free; end; Regarding the refactoring tool it would be probably useless (buggy as hell) considering that they still didn't get Code Insight/LSP right.
  20. 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 .*\(
  21. 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?
  22. 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.
  23. 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.
  24. 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.
  25. 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? ...
×