programmerdelphi2k

my tip: Avoid the excessive usage of "SetLenght()", try define a conditicional for it, like: each 100...n items, use SetLenght()! that way, if exists 1000 object, then you'll have 10 SetLength()

After +10 minutes waiting, I had that stop it...!!! -- verify the "Range check error" I think that your approach of "excluding" the undesirable directories, should be done during the search of the files, and not in a previous or later step, because, in this way, you are doing a search in 2 or more steps, that is, first you are searching everything, then you will delete everything that is not desirable... So, you should do this exclusion of undesirables during the main search, avoiding a second or third action! I think your logic here is wrong! Since the owner of the post needs to find c:\*.*, your search is being carried out in all directories, and, only at the end, you are excluding "C:\Windows" from the directory, which further increases the task! Here on my PC, your search started at 3:26 pm, and I "STOP IT" 3:37 pm, and none resulted on listbox yet, using your latest "FindEx" update, CPU using 15~20% all the time! ... below, before your last FindEx update...

Here a more simple way using "TDirectory.GETFILES(...)", but it was slow than my function above ( +20 seconds ) procedure TForm1.Button2Click(Sender: TObject); var LRootPath : string; LPatternSrc : string; LExcludeFolder: string; LFoundFiles : TArray<string>; LTickCounter : UInt64; begin { NOTE: The "GetFiles" function will only return a value if there is at least one file within the search directory! Otherwise, nothing will be returned. So, there must be at least one file inside a directory for the search to show any result. This is a consequence of the "GetFiles" function of the "TDirectory" record. } LRootPath := 'C:\'; // where start? LPatternSrc := '*.*'; // what see? LExcludeFolder := '\Windows'; // any "object" like this, will be "excluded from search" // LTickCounter := GetTickCount64; // try // GetFiles raise a exception if any error on syntax! LFoundFiles := TDirectory.GetFiles(LRootPath, LPatternSrc, TSearchOption.soAllDirectories, { } function(const Path: string; const SearchRec: TSearchRec): boolean { } begin { } result := not Path.Contains(LExcludeFolder); // unfortunatelly, ALL object will be compared! = more time consumed end); // LTickCounter := GetTickCount64 - LTickCounter; // ListBox1.Items.Clear; ListBox1.Items.AddStrings(LFoundFiles); // ShowMessage(Format('Time: %dms', [LTickCounter])); except on E: Exception do ShowMessage(E.Message); end; end;

@Ian Branch what propose this? can explains me?

I think you may be wrong, because as @dummzeuch said, my proposal above is precisely "ignore access to the indicated directory, in this case "Windows". This way, when receiving the name of the directory called "Windows", the function simply move to the next one, so it won't even be accessed! But as I said at the beginning, there are many libraries and functions ready to be used in Delphi! One of them is in the "System.IOUtils.pas" unit, that is, TDirectory, among others!

said so much, and nothing!

you DONT need use "ShowMessage", it was just a sample! you can use a form, a dialog, another message, etc.. what you need!

I dont know if understood, but you can: in iOS only use: LNotification.HasAction := true; LNotification.AlertAction := 'ButtonNameXXXX'; // ButtonNameXXXX would be "a button in your form" form, then, it would be "clicked" or using "NotificationCenter1ReceiveLocalNotification(Sender: TObject; ANotification: TNotification);" event, then, when user click on notification you can to do something like: procedure TForm1.NotificationCenter1ReceiveLocalNotification(Sender: TObject; ANotification: TNotification); begin if ANotification.Title = 'Hello there' then ShowMessage('Thanks for your click baby'); end; would be that?

sorry, my english is not so good 😂

I think that is not problem too... the big question "would be"? where the "exception" (using the pSample in any function above "addBuffer, SetSampleTime, SetSampleDuration, WriteSample") would generated, exactly? my question is about that in MS links dont show if an "exception" would be generated (exactly), but just say the "result would be <> 0", then, if I has the "pSample" = ok, what happens if "I cannot set the Time, Duration" for example, but I can "write a new sample without this 2 values?" for example. The new sample would be invalid or it will use default values? if not invalid then write it would be ok not? using your "CheckFail()" I think that is the same, because you are executing "CheckFail" after "CheckFail", then, if the 1 fail, what happens to others? you see? the same than my "vars = xxxxxx".... now, if none "exception" is "generated by this functions ("addBuffer, SetSampleTime, SetSampleDuration, WriteSample") then, you choice what is better for you, because your "CheckFail" only raise the exception AFTER "HR=FALSE", or be, you raise the exception, not the "function" itself, you see?

// when using "Recursive function, like this try dont use visual components like ListBox or any other" type TMyArrToStoreTheResulted = array of string; TMyPatternToSearch = array of string; TMyFoldersToSkip = array of string; function MyFoldersToSkip(AFoldersToSkip: TMyFoldersToSkip; ACurrentFolderOnSearch: string): boolean; begin result := false; // if ACurrentFolderOnSearch.IsEmpty then { or (length(AFoldersToSkip) = 0) if not verifyed before on MyFindFilePattern() } exit; // for var F in AFoldersToSkip do if (F = ACurrentFolderOnSearch) then exit(true); end; procedure MyFindFilePattern(AFolderRoot: string; APatternToSearch: TMyPatternToSearch; AFoldersToSkip: TMyFoldersToSkip; var AArrToStoreTheResulted: TMyArrToStoreTheResulted); var LSearchRecord : TSearchRec; LIsDirectory : boolean; LContinue : boolean; LLookFolderToSkip: boolean; begin LLookFolderToSkip := (length(AFoldersToSkip) > 0); // to avoid verify all time... // for var i: integer := 0 to high(APatternToSearch) do begin AFolderRoot := IncludeTrailingPathDelimiter(AFolderRoot); // LContinue := FindFirst(AFolderRoot + APatternToSearch[i], faAnyFile, LSearchRecord) = 0; // if LContinue then try while LContinue do begin LIsDirectory := ((LSearchRecord.Attr and faDirectory) = faDirectory); // if not((LSearchRecord.Name = '.') or (LSearchRecord.Name = '..')) then begin if LIsDirectory then begin if not(LLookFolderToSkip and MyFoldersToSkip(AFoldersToSkip, LSearchRecord.Name)) then MyFindFilePattern(AFolderRoot + LSearchRecord.Name, APatternToSearch, AFoldersToSkip, AArrToStoreTheResulted); end else AArrToStoreTheResulted := AArrToStoreTheResulted + [AFolderRoot + LSearchRecord.Name]; end; // LContinue := FindNext(LSearchRecord) = 0; end; finally FindClose(LSearchRecord); end; end; end; procedure TForm1.Button1Click(Sender: TObject); var LMyResult : TMyArrToStoreTheResulted; // of course, more elements, more memory it's necessary! then, dont abuse! LTickCount: UInt64; begin LTickCount := GetTickCount64; // // MyFindFilePattern('c:\', ['*.*'], [], LMyResult); MyFindFilePattern('D:\Downloads', ['*.*'], ['DontLookThisFolder'], LMyResult); // LTickCount := GetTickCount64 - LTickCount; // ListBox1.Items.AddStrings(LMyResult); // ListBox1.Items.Add('Items: ' + ListBox1.Items.Count.ToString + ', Time total: ' + LTickCount.ToString); // { for var i: integer := 0 to high(LMyResult) do ListBox1.Items.Add(LMyResult[i]); // or for var ElementX in LMyResult do ListBox1.Items.Add(ElementX); } end;

I was just asking you if that way would work for you, you know? well, "MFCreateSample(pSample)" = "Initially the sample does not contain any media buffers". then after this line, it will. "SetSampleTime" and "SetSampleDuration" just define the time values, "WriteSample(fstreamIndex, pSample)", just set the index of new Sample, then, I think that it will works, because the "pSample" already filled above by MFCreateSample()! and if "NOT (MFCreateSample(pSample) = S_OK) then nothing will be done below... or you can raise a exception if you desire... if (MFCreateSample(pSample) = S_OK) then // S_OK = 0 //... else raise Exception.Create('TBitmapEncoderWMF.WriteOneFrame failed'); if (hrSampleBuffer or hrSampleTime or hrSampleDuration or hrWriteSample) = S_OK = if (0 or 0 or 0 or 0) = 0 ... any thing non 0 = false I have downloaded you sample and I did the changes above and it worked. https://learn.microsoft.com/en-us/windows/win32/api/mfapi/nf-mfapi-mfcreatesample https://learn.microsoft.com/en-us/windows/win32/api/mfobjects/nf-mfobjects-imfsample-setsampletime https://learn.microsoft.com/en-us/windows/win32/api/mfobjects/nf-mfobjects-imfsample-setsampleduration https://learn.microsoft.com/en-us/windows/win32/api/mfobjects/nf-mfobjects-imfsample-addbuffer https://learn.microsoft.com/en-us/windows/win32/api/mfreadwrite/nf-mfreadwrite-imfsinkwriter-writesample

@Renate Schaaf is it not possible just this way? or pSample.XXXXX( XXXXX ) can break next line = exception, for example? if (MFCreateSample(pSample) = S_OK) then // S_OK = 0 begin hrSampleBuffer := pSample.AddBuffer(pSampleBuffer); hrSampleTime := pSample.SetSampleTime(fWriteStart); hrSampleDuration := pSample.SetSampleDuration(fSampleDuration); hrWriteSample := pSinkWriter.WriteSample(fstreamIndex, pSample); // if (hrSampleBuffer or hrSampleTime or hrSampleDuration or hrWriteSample) = S_OK then // or just -> (hrWriteSample = S_OK) then begin inc(fWriteStart, fSampleDuration); fVideoTime := fWriteStart div 10000; inc(fFrameCount); end else raise Exception.Create('TBitmapEncoderWMF.WriteOneFrame failed'); end;

where is this object (class/interface/record) created ? in the same unit or where? this returns really a "TReplayChangeSpawnInterval", or what other type?

the key-words is: "instances-of-classes" when you define the structure of a class, in fact, you are just defining a "layout" of future objects that will be created in memory. To take advantage of this structure, you need to create the object in memory. Or simply "instantiate the object"! For this reason, it is not possible to perform any actions on the object without first creating it!

@Willicious try this sample about class Scope that I did a long time ago... Class_Scope_Visibility.7z

@Willicious I think your dissatisfaction is leading you to discuss a rhetoric that has existed as long as programming has existed! As for your dissatisfaction with your class, I think it only proves that it is not consistent and has been wrongly constructed, and possibly being misunderstood by you! Better rethink your code! As for using everything anywhere, then give up on object-oriented programming languages, or close to it. Better go back to "Basic for MSX"... lots of bits and bytes, no predefined structure, go forward or backward as you wish! And at the end, save your code on cassette tapes! If you want, try to post your code here or in some repository that, surely, someone will be able to give you a hand!

FMX.Controls.pas, line 1180 (RAD11.3) -> property Style: TFmxObject read GetStyle; then, yes! a infinity looping if "(Idx<0)" 🙂

for sure! if A contains B, and B contains C... what happens here? read A... find B... read B.... find C... read C... and go back to B... and go on.... until the end and go back to A... etc...

for sure, BUT when you dont "declare" the objects/var/procedure/etc.. you DONT BE! right? then, for this, you NEED declare all that you need use!

I said that "dont abuse"... c:\ have a zillions objects... using my code it works for sure! using "c:\" , [ '*.*', '*.txt' ] = duplicating many results because a ".TXT" is contained in a "*.*"

if the performance and reliability leaves you in doubt, or the code hurts your eyes, or , then redo it! How about using "arrays" to store your procedures to invoke them later? just 1 "IF" using "type" to better control! implementation {$R *.dfm} type TProcHeader = procedure(aDoc, aCdn, aRequestCorrelation, aMessageText: string); TMyEnum = (meEXPREG, meEXPACC, meEXPERR, meEXPREL, meEXPREF, meEXPREQ, meEXPINF, meEXPCLA, meEXPCON, meEXPAME, meEXPIRJ, meEXPARJ, meEXPHRT); TMyArrProcs = array [TMyEnum] of TProcHeader; // it will contains: how many elements was defined on TMyEnum ! procedure DecodeExportReg(aDoc, aCdn, aRequestCorrelation, aMessageText: string); begin ShowMessage('DecodeExportReg'); // only if "meEXPREG" was used on array end; procedure DecodeExportAcc(vDoc, aCdn, aRequestCorrelation, aMessageText: string); begin ShowMessage('DecodeExportAcc'); // only if "meEXPACC" was used on array end; procedure DecodeExportHRT(vDoc, aCdn, aRequestCorrelation, aMessageText: string); begin ShowMessage('DecodeExportHrt'); // only if "meEXPHRT" was used on array end; // the "core" procedure MyExecuteMyProcs(AArrProcs: TMyArrProcs; AEnum: TArray<TMyEnum>; aDoc, aCdn, ACorrelation, AMsg: string); begin for var E in AEnum do if (@AArrProcs[E] <> nil) then {just 1 "IF"} AArrProcs[E](aDoc, aCdn, ACorrelation, AMsg); end; procedure TForm1.Button1Click(Sender: TObject); var LArrProcs: TMyArrProcs; begin LArrProcs := Default (TMyArrProcs); // Important: force "nil" for all, to avoid random "value"!!! // // ---------------------------------------- // try uncomment each one for test it! // ---------------------------------------- // LArrProcs[meEXPREG] := DecodeExportReg; // LArrProcs[meEXPACC] := DecodeExportAcc; // ... // LArrProcs[meEXPHRT] := DecodeExportHRT; // // LArrProcs[meEXPREQ] := nil; // // LArrProcs[meEXPREG]('doc', 'cdn', 'correlation', 'msgtext'); // executing directly the proc! // // how test it: // // MyExecuteMyProcs(LArrProcs, [meEXPREG, meEXPACC], 'doc', 'cdn', 'correlation', 'msgtext'); // 2 uncommented // MyExecuteMyProcs(LArrProcs, [meEXPACC], 'doc', 'cdn', 'correlation', 'msgtext'); // uncomment "meEXPREG", later "meEXPACC" // MyExecuteMyProcs(LArrProcs, [meEXPHRT], 'doc', 'cdn', 'correlation', 'msgtext'); // ... // MyExecuteMyProcs(LArrProcs, [], 'doc', 'cdn', 'correlation', 'msgtext'); // uncomment all or not! // // all uncommented, you define "enum" order to execute, dont worry same that no defined on LArrProcs! MyExecuteMyProcs(LArrProcs, [meEXPREG, meEXPINF, meEXPCLA, meEXPCON, meEXPHRT, meEXPACC], 'doc', 'cdn', 'correlation', 'msgtext'); end;

@robertjohns First, YOU DONT need quote the old post all time, ok! just "quote" the line in question ... not all!!! Second, I think that "ITEMS" should have it, because is a TStrings used in many classes, like: TListBox, TMemo, TStringList, etc.. any way, try this //ListBox1.Items.AddStrings(LMyResult); // for var i: integer := 0 to high(LMyResult) do // high(xxxx) = ( length(xxxx) -1 ) ListBox1.Items.Add(LMyResult[i]); // or for var ElementX in LMyResult do ListBox1.Items.Add(ElementX);

@robertjohns first, try read all files/dirs would can be "very slowly" and "consume so much memory", etc... for that exists functions and library for this tasks. In RAD Studio you can try use "System.IOUtils.pas" and the "TDirectory" class for example. now, said this, you can try this way: but remember in "c:\" you can have zillions of files/dirs!!!! do the little test with a folder contained a little files/subdirs!! // when using "Recursive function, like this try dont use visual components like ListBox or any other" type TMyArrToStoreTheResulted = array of string; // procedure MyFindFilePattern(AFolderRoot: string; APatternToSearch: array of string; const AListBox: TListBox); procedure MyFindFilePattern(AFolderRoot: string; APatternToSearch: array of string; var AArrToStoreTheResulted: TMyArrToStoreTheResulted); var LSearchRecord: TSearchRec; LIsDirectory : boolean; LContinue : boolean; begin // for var LPattern in APatternToSearch do // ....."LPattern" will receive each element in "APatternToSearch" array!!! // for var i: integer := 0 to high(APatternToSearch) do begin AFolderRoot := IncludeTrailingPathDelimiter(AFolderRoot); // LContinue := FindFirst(AFolderRoot + APatternToSearch[i], faAnyFile, LSearchRecord) = 0; // if LContinue then try while LContinue do begin LIsDirectory := ((LSearchRecord.Attr and faDirectory) = faDirectory); // if not((LSearchRecord.Name = '.') or (LSearchRecord.Name = '..')) then begin if LIsDirectory then begin // AListBox.Items.Add('....... subDir (just for text on screen, delete this line): ' + AFolderRoot + LSearchRecord.Name); // MyFindFilePattern(AFolderRoot + LSearchRecord.Name, APatternToSearch, AArrToStoreTheResulted) end else // AListBox.Items.Add('File: ' + AFolderRoot + LSearchRecord.Name); AArrToStoreTheResulted := AArrToStoreTheResulted + [AFolderRoot + LSearchRecord.Name]; end; // LContinue := FindNext(LSearchRecord) = 0; end; finally FindClose(LSearchRecord); end; end; end; procedure TForm1.Button1Click(Sender: TObject); var LMyResult: TMyArrToStoreTheResulted; // of course, more elements, more memory it's necessary! then, dont abuse! begin // MyFindFilePattern('d:\MyZip', ['*.*', '*.txt', '*.zip'], ListBox1); // MyFindFilePattern('d:\MyZip', ['*.*', '*.txt', '*.zip'], LMyResult); // ListBox1.Items.AddStrings(LMyResult); end;

you can use default-way: