KodeZwerg

Sorry to ask such a beginners questions, but I am unfamilar with that method. If i want to reduce filesize I do use Executable Packer like U.P.X.. So my questions would be: Beginning with wich Delphi Version does your approach to reduce filesize at linking work? When you say "add that to used units" do you mean all (my own units like "Unit1.pas" plus original RTL sources like "Windows.pas") ? My next question would be, if i need to add that to all RTL units, how do i compile them? (i never tweaked original units yet) I did tried that: Open existing project Open used units to add the {$IFDEF RELEASE} variant At a undefined point, my IDE crash during edit those originals (i did tried with Delphi 5 and Delphi 2010) Exists a instruction for dummies like me?

uses ActiveX, Shlobj, IOUtils; function TestFileExists( Filename: String ): Boolean; begin Result := FileExists( Filename ); end; type TParseDisplayName = function(pszPath: PWideChar; pbc: IBindCtx; var pidl: PItemIDList; sfgaoIn: ULong; var psfgaoOut: ULong): HResult; stdcall; var SHParseDisplayName: TParseDisplayName; SHELL32DLLHandle : THandle; function TestPIDL( Filename: String ): PItemIdList; var PIDL: PItemIdList; Attrs: DWORD; begin Result := nil; try CoInitialize(nil); if ( SHParseDisplayName( PChar( Filename ), nil, PIDL, 0, Attrs ) = S_OK ) then if Assigned( PIDL ) then Result := PIDL; finally CoUnInitialize(); end; end; function TestCreateFile( Filename: String ): Boolean; var hFile : THandle; begin Result := False; hFile := CreateFile(PChar( Filename ), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); if hFile <> INVALID_HANDLE_VALUE then begin Result := True; CloseHandle(hFile); end; end; function TestGetFileAtrributes( Filename: String ): Boolean; var i: Cardinal; begin Result := False; i := GetFileAttributes( PChar( Filename ) ); if i <> INVALID_FILE_ATTRIBUTES then begin Result := True; end; end; function TestFileAge( Filename: String ): Boolean; var DT: TDateTime; begin Result := False; if FileAge( Filename, DT ) then begin Result := True; end; end; function TestFileGetAttr( Filename: String ): Boolean; begin Result := False; if FileGetAttr( Filename ) <> 0 then begin Result := True; end; end; function TestTFile( Filename: String ): Boolean; begin Result := False; if TFile.Exists( Filename ) then begin Result := True; end; end; function TestFindFirst( Filename: String ): Boolean; var sr: TSearchRec; begin Result := False; if FindFirst( Filename, faAnyFile, sr ) = 0 then begin Result := True; end; FindClose(sr); end; procedure TForm1.btnDoJobClick(Sender: TObject); var Start, Stop, Frequency: Int64; Filename: String; i: Integer; Max: Integer; begin Filename := edFilename.Text; try Max := StrToInt( edLoops.Text ); except Max := 1000; edLoops.Text := IntToStr( Max ); end; Memo1.Clear; (* if FileExists( Filename ) then Memo1.Lines.Add( 'File located/cached, begin testing.' ) else begin Memo1.Lines.Add( 'File not found. Test canceled.' ); Exit; end; *) Memo1.Lines.Add( 'Begin Test #1: FileExists (' + IntToStr( Max ) + ' repeats)' ); QueryPerformanceFrequency(Frequency); QueryPerformanceCounter(Start); for i := 0 to Max do if TestFileExists( Filename ) then else begin Memo1.Lines.Add( 'File not found. Test canceled.' ); Break; end; QueryPerformanceCounter(Stop); Memo1.Lines.Add( 'Results for ' + IntToStr( Max ) + ' repeats: ' + FormatFloat('0.00', ( Stop - Start ) * 1000 / Frequency) + ' Milliseconds' ); Memo1.Lines.Add( 'Begin Test #2: PIDL (' + IntToStr( Max ) + ' repeats)' ); QueryPerformanceFrequency(Frequency); QueryPerformanceCounter(Start); for i := 0 to Max do if ( TestPIDL( Filename ) <> nil ) then else begin Memo1.Lines.Add( 'File not found. Test canceled.' ); Break; end; QueryPerformanceCounter(Stop); Memo1.Lines.Add( 'Results for ' + IntToStr( Max ) + ' repeats: ' + FormatFloat('0.00', ( Stop - Start ) * 1000 / Frequency) + ' Milliseconds' ); Memo1.Lines.Add( 'Begin Test #3: CreateFile (' + IntToStr( Max ) + ' repeats)' ); QueryPerformanceFrequency(Frequency); QueryPerformanceCounter(Start); for i := 0 to Max do if TestCreateFile( Filename ) then else begin Memo1.Lines.Add( 'File not found. Test canceled.' ); Break; end; QueryPerformanceCounter(Stop); Memo1.Lines.Add( 'Results for ' + IntToStr( Max ) + ' repeats: ' + FormatFloat('0.00', ( Stop - Start ) * 1000 / Frequency) + ' Milliseconds' ); Memo1.Lines.Add( 'Begin Test #4: GetFileAtrributes (' + IntToStr( Max ) + ' repeats)' ); QueryPerformanceFrequency(Frequency); QueryPerformanceCounter(Start); for i := 0 to Max do if TestGetFileAtrributes( Filename ) then else begin Memo1.Lines.Add( 'File not found. Test canceled.' ); Break; end; QueryPerformanceCounter(Stop); Memo1.Lines.Add( 'Results for ' + IntToStr( Max ) + ' repeats: ' + FormatFloat('0.00', ( Stop - Start ) * 1000 / Frequency) + ' Milliseconds' ); Memo1.Lines.Add( 'Begin Test #5: FileAge (' + IntToStr( Max ) + ' repeats)' ); QueryPerformanceFrequency(Frequency); QueryPerformanceCounter(Start); for i := 0 to Max do if TestFileAge( Filename ) then else begin Memo1.Lines.Add( 'File not found. Test canceled.' ); Break; end; QueryPerformanceCounter(Stop); Memo1.Lines.Add( 'Results for ' + IntToStr( Max ) + ' repeats: ' + FormatFloat('0.00', ( Stop - Start ) * 1000 / Frequency) + ' Milliseconds' ); Memo1.Lines.Add( 'Begin Test #6: FileGetAttr (' + IntToStr( Max ) + ' repeats)' ); QueryPerformanceFrequency(Frequency); QueryPerformanceCounter(Start); for i := 0 to Max do if TestFileGetAttr( Filename ) then else begin Memo1.Lines.Add( 'File not found. Test canceled.' ); Break; end; QueryPerformanceCounter(Stop); Memo1.Lines.Add( 'Results for ' + IntToStr( Max ) + ' repeats: ' + FormatFloat('0.00', ( Stop - Start ) * 1000 / Frequency) + ' Milliseconds' ); Memo1.Lines.Add( 'Begin Test #7: TFile (' + IntToStr( Max ) + ' repeats)' ); QueryPerformanceFrequency(Frequency); QueryPerformanceCounter(Start); for i := 0 to Max do if TestTFile( Filename ) then else begin Memo1.Lines.Add( 'File not found. Test canceled.' ); Break; end; QueryPerformanceCounter(Stop); Memo1.Lines.Add( 'Results for ' + IntToStr( Max ) + ' repeats: ' + FormatFloat('0.00', ( Stop - Start ) * 1000 / Frequency) + ' Milliseconds' ); Memo1.Lines.Add( 'Begin Test #8: FindFirst (' + IntToStr( Max ) + ' repeats)' ); QueryPerformanceFrequency(Frequency); QueryPerformanceCounter(Start); for i := 0 to Max do if TestFindFirst( Filename ) then else begin Memo1.Lines.Add( 'File not found. Test canceled.' ); Break; end; QueryPerformanceCounter(Stop); Memo1.Lines.Add( 'Results for ' + IntToStr( Max ) + ' repeats: ' + FormatFloat('0.00', ( Stop - Start ) * 1000 / Frequency) + ' Milliseconds' ); Memo1.Lines.Add( '' ); Memo1.Lines.Add( 'Job Done.' ); end; I build a small quick bencher, to me GetFileAttributes() is the winner and PItemIdList is by far biggest looser (if i implemented correct way.....) FindFile.7z

Hello again, you could also try with PIDL, i really dont know whats faster, FileAge() or something like that: (not optimized and just for local files...) function SHGetIDListFromPath(Path: TFileName; var ShellFolder: IShellFolder): PItemIDList; var TempPath, NextDir: TFileName; SlashPos: Integer; Folder, subFolder: IShellFolder; PIDL, PIDLbase: PItemIDList; ParseStruct: TStrRet; ParseNAme: String; EList: IEnumIDList; DidGet: Cardinal; ScanParam: Integer; begin SHGetDesktopFolder(Folder); SHGetSpecialFolderLocation(0, CSIDL_DRIVES, PIDLbase); OLECheck(Folder.BindToObject(PIDLbase, nil, IID_IShellFolder, Pointer(SubFolder))); TempPath:=Path; NextDir:=''; while Length(TempPath)>0 do begin SlashPos:=Pos('\', TempPath); if SlashPos > 0 then begin if Pos(':', TempPath) > 0 then NextDir:=Copy(TempPath, 1, 3) else NextDir:=SlashDirName(NextDir)+Copy(TempPath, 1, SlashPos-1); TempPath:=Copy(TempPath, SlashPos+1, Length(TempPath)); end else begin if NextDir='' then NextDir:=TempPath else NextDir:=SlashDirName(NextDir)+TempPath; TempPath:=''; end; PIDL:=PidlBase; ScanParam:=SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN; if (NextDir=Path) and (not DirectoryExists(Path)) then ScanParam:=ScanParam or SHCONTF_NONFOLDERS; if S_OK=SubFolder.EnumObjects(0, ScanParam, EList) then while S_OK=EList.Next(1, pidl, DidGet) do begin OLECheck(SubFolder.GetDisplayNameOf(PIDL, SHGDN_FORPARSING, ParseStruct)); case ParseStruct.uType of STRRET_CSTR: ParseName:=ParseStruct.cStr; STRRET_WSTR: ParseName:=WideCharToString(ParseStruct.pOleStr); STRRET_OFFSET: Parsename:=PChar(DWORD(Pidl)+ParseStruct.uOffset); end; if UpperCase(Parsename)=UpperCase(NextDir) then Break; end else begin Folder:=nil; Result:=nil; Exit; end; if DidGet=0 then begin Folder:=nil; Result:=nil; Exit; end; PIDLBase:=PIDL; Folder:=subFolder; if not FileExists(NextDir) then OLECheck(Folder.BindToObject(Pidl, nil, IID_IShellFolder, Pointer(SubFolder))); end; ShellFolder:=Folder; if ShellFolder=nil then Result:=nil else Result:=PIDL; end; I welcome to see some quality Benchmark Results.

On Windows i use FileAge(), fastest method i know, hope it helps.

Hello, i am interested in having one of my Apps just run once. I searched web for solutions that help me. David Heffernan wrote here a really good example that covers my needs. (have just one app running with ability to send commandline to loaded process) My Application has trayicon status and wont come up with that code. Can someone help me to extend its code that also trayicon will be restored, that would be great! (i do use Delphi2010 if it matters)

Another update has been made. I found a small bug and fixed it by porting the "ShowWindow()" into Forms Source and replacing with Vcl commands. Now it demonstrate how to setup custom parameters to do some specific things. Enjoy.

To all that liked Davids approach as I did -> I did updated above attachement, it should be final now ( I hope ). If someone with more experience could take a look on, that would be really nice! Thanks for reading. @Nathan Wild to me not ( I do not have that ), others might find it useful, thanks for suggestion it.

@David Heffernan: I show you where i did a mistake, now all works fluffy :-] and thank you for correcting my used words! // if IsIconic( Window ) then // <<<-- that was my mistake :-/ ShowWindow( Window, SW_SHOW ); Thanks again to pointing it out! If someone need, in attachment is a full working Binary and Source example ( Delphi 5 ) Should be compatible to all, just adjust the Namespace. This demo show Davids excellent work added with Notification Area's Icon support ( the WinApi way ) Updated source for more fun. Added popup menu for notification icon Renamed everything to its real stuff Added small descriptions to Source From my point of view it is final now. OneApp.7z

Points a - c are checked Point d is my misery, If application is anywhere on screen it will show with Code from David properly. If application is minimized to taskbar it will show with Code from David properly. (Thankyou David for this good piece of code!) If application is in systemtray, nothing happen there at all. I will create a small Demo-Application that show my problem better (in fact this would be a 1;1 copy from Davids Post on StackOverflow) Thankyou for help!

This should be SetLength(Result, Length(S) * SizeOf( AnsiChar ) ); program Project1; {$APPTYPE CONSOLE} {$R *.res} uses System.SysUtils; function MyStringToMyCharArray( const S: String ): TCharArray; begin SetLength(Result, Length(S) * SizeOf( AnsiChar ) ); if Length( S ) > 0 then begin StrPLCopy( PChar( Result ), S, Length( Result ) ); end; end; var S: String; C: TCharArray; I: Integer; begin try { TODO -oUser -cConsole Main : Insert code here } S := 'My Test String'; C := MyStringToMyCharArray( S ); for i := 0 to Length( C ) -1 do write( c[ i ] ); writeln; readln; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; end.

*removed, error*

You can checkout https://github.com/KodeZwerg/versionselector to see how different delphi versions work with registry. All legit stuff from early up to Tokyo 10.2.3 is supported.

Does the code not work?

Okay. uses TypInfo, ToolIntf, Exptintf; ... procedure GetComponentNames(lst: TStrings); var i, k: Integer; CRef: TClass; strName: ShortString; begin lst.Clear; for i := 0 to ToolServices.GetModuleCount-1 do begin for k := 0 to ToolServices.GetComponentCount(i)-1 do begin CRef := TClass(GetClass(ToolServices.GetComponentName(i, k))); while CRef <> nil do begin strName := CRef.ClassName; if lst.IndexOf(strName) = -1 then lst.Add(strName); if str <> 'TComponent' then CRef := CRef.ClassParent else CRef := nil; end; end; end; end;

uses ToolsApi; {....} var a, i: Integer; begin with (BorlandIDEServices as IOTAPackageServices) do begin for a := 0 to GetPackageCount - 1 do begin for i := 0 to GetComponentCount(a) - 1 do begin {get each component name with GetComponentName(a, i);} // DoSomething end; end; end; end; Something like that?

Hi there, i made a small unit to handle Ini Files on Windows Systems. A Full Demo is included, build with D2010, should be compatible to any Version, may need other "Uses" Namespace. Whats the point? It read or write from/to Ini file. Will automatic use "X:\Users\LoginName\AppData\Local\ExeName\" as folder to save to. Foldername has a override feature. ATM one problem occur when you use my try of implementing a crypt method, writing to file is good but decryption i made somewhere something wrong. Have fun with it. IniHelper.7z

From point of now it does not support duplicates nor comments. It wont beautify target .ini. It just work 🙂 In attachment is a Build where i started make a Class of it, Only String and Integer are supported by now. AES128 encryption has been added. IniHelper.7z

Hi there, i know a few ways to play with files but never really compared them. classical way with FindFirst() FindNext(), easy handling but slow if searching with '*.*' mask 🙂 PIDL if you know how to deal with em, my opinion very fast but a bit harder to play with. and IOUtils offer TPath, where i have less experience. Wich way should a modern application go if Windows is target? And if speed would be an aspect, what you think might be fastest? as proto code without any code at all // function that retrive a list with matching filenames "FileMask" function FindFiles( const StartPath: String = ''; const FileMask: String = '*.*'; const SubFolder: Boolean = False ): TStrings; var AStrings: TStrings; begin AStrings := TStrings.Create(); try AStrings := CollectData( StartPath, FileMask, SubFolder ); finally Result := AStrings; AStrings.Free; end; end;

I also followed your advice with TStringList, now internal and externals are of Type TStringDynArray. Still a little messy, but works like i needed.

Great, my own tried where not that successful. With your help i am able to change function so split my filemask in several calls like you showed, my hero, thankyou.

i try to be as specific as i can be from Embarcadero sample, all i need/call is { For files use GetFiles method } if not ( IncludeDirectories = True ) and ( IncludeFiles = True ) then LList := TDirectory.GetFiles(initPath, FileMask, LSearchOption); so i have a initpath like "C:\", i have a filemask like "*.dll", i have option to have subfolders included. so far it works like it should. now i wanted to integrate a second mask, when i replace with your method, no subfolders are included anymore, only rootfolder will be utilized. that why i posted my logical construct.

From point of logic, to check if i understood correct: use two kind of lists internal, one to hold only foldernames and one only for filenames init on creation both lists with current data do loop folderlist to add things to filelist with your mentioned TFilterPredicate method (thankyou!) when all done give filelist back as result

Is there a way to tweak above example so it accept as filemask somethink like "*.dll;*.exe" ? Or is running twice only option? Thank you for reading.

Hello Sir, i just watched Screenshots on given link and read text, i bet i missed it, so heres my question: does your fake got property "flat" to play with?

Hello, i did not find much information about this function but i would like to use it (or does delphi bring own dialog with that ability?) Here is wrapper i use: uses ShlObj; ... function PickIconDialog( IconHandle: HWND; var Filename: string; var IconIndex: Integer ): Boolean; var tmp : String; idx: Integer; begin Result := False; tmp := Filename; idx := IconIndex; if ( PickIconDlg( IconHandle, PWideChar( tmp ), 1023, idx ) <> 0 ) then begin Filename := String( tmp ); IconIndex := idx; Result := True; end; end; This is how i call it: procedure TfrmMain.btnGetIconClick(Sender: TObject); var IconFile: String; IconIndex: LongInt; begin IconFile := ''; IconIndex := 0; try IconIndex := StrToInt( edIconIndex.Text ); except IconIndex := 0; end; if ( PickIconDialog( Handle, IconFile, IconIndex ) = True ) then begin edIconLocation.Text := IconFile; try edIconIndex.Text := IntToStr( IconIndex ); except edIconIndex.Text := '0'; end; Image1.Picture.Icon.Handle := ExtractIcon( hInstance, PWideChar( IconFile ), Cardinal( IconIndex ) ); end; end; What happen is, i get correct Icon displayed but... Iconfilename often is invisible. Other edit fields are invisible overwritten with Value of Iconfilename, Most of time, every field that has no value on start will be invisible overwritten. (ATM i do by workaround, i fill every field before operation with any data) Do i use it wrong? Does better ways exists to have such dialog?