|
| 1 | +unit dtinydir; |
| 2 | + |
| 3 | +// tiny directory listing |
| 4 | +// - rlyeh, public domain | wtrmrkrlyeh |
| 5 | +// - ported to pascal by Doj |
| 6 | + |
| 7 | +{$MODE FPC} |
| 8 | +{$MODESWITCH DEFAULTPARAMETERS} |
| 9 | +{$MODESWITCH OUT} |
| 10 | +{$MODESWITCH RESULT} |
| 11 | + |
| 12 | +interface |
| 13 | + |
| 14 | +type |
| 15 | + TTinyDirCallback = procedure (Name: PAnsiChar; IsDir: Boolean); |
| 16 | +function tinydir(directory: PAnsiChar; yield: TTinyDirCallback): Boolean; |
| 17 | + |
| 18 | +implementation |
| 19 | + |
| 20 | +{$IF Defined(WINDOWS)} |
| 21 | +uses |
| 22 | + windows; |
| 23 | +{$ELSE} |
| 24 | +uses |
| 25 | + BaseUnix; |
| 26 | +{$ENDIF} |
| 27 | + |
| 28 | +function tinydir(directory: PAnsiChar; yield: TTinyDirCallback): Boolean; |
| 29 | +var |
| 30 | + Src: AnsiString; |
| 31 | +{$IF Defined(WINDOWS)} |
| 32 | + fdata: windows.WIN32_FIND_DATA; |
| 33 | + h: windows.HANDLE; |
| 34 | + next: Boolean; |
| 35 | +{$ELSE} |
| 36 | + Dir, Tmp: BaseUnix.PDir |
| 37 | + Dirent: BaseUnix.PDirent; |
| 38 | +{$ENDIF} |
| 39 | +begin |
| 40 | + src := directory; |
| 41 | + while (Src <> '') and ((Src[Length(Src)] = '/') or (Src[Length(Src)] = '\')) do |
| 42 | + SetLength(Src, Length(Src) - 1); |
| 43 | +{$IF Defined(WINDOWS)} |
| 44 | + h := FindFirstFileA(PAnsiChar(src + '/*'), @fdata); |
| 45 | + while h <> INVALID_HANDLE_VALUE do begin |
| 46 | + next := True; |
| 47 | + while next do begin |
| 48 | + if fdata.cFileName[0] <> '.' then begin |
| 49 | + yield(PAnsiChar(src + '/' + fdata.cFileName), (fdata.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) > 0); |
| 50 | + end; |
| 51 | + next := FindNextFileA(h, @fdata); |
| 52 | + end; |
| 53 | + FindClose(h); |
| 54 | + Exit(True); |
| 55 | + end; |
| 56 | +{$ELSE} |
| 57 | + Dir := FpOpenDir(PAnsiChar(Src + '/')); |
| 58 | + if Dir <> nil then begin |
| 59 | + Dirent := FpReadDir(Dir^); |
| 60 | + while Dirent <> nil do begin |
| 61 | + if Dirent^.d_name[0] <> '.' then begin |
| 62 | + Tmp := FpOpenDir(ep^.d_name); |
| 63 | + if Tmp then begin |
| 64 | + FpCloseDir(Tmp^); |
| 65 | + yield(PAnsiChar(Src + '/' + ep->d_name), True); |
| 66 | + end else |
| 67 | + yield(PAnsiChar(Src + '/' + ep->d_name), False); |
| 68 | + end; |
| 69 | + end; |
| 70 | + FpCloseDir(Dir^); |
| 71 | + return closedir( dir ), true; |
| 72 | + end; |
| 73 | +{$ENDIF} |
| 74 | + Exit(False); |
| 75 | +end; |
| 76 | + |
| 77 | +// |
| 78 | +// procedure Callback(Name: PAnsiChar; IsDir: Boolean); |
| 79 | +// begin |
| 80 | +// if IsDir then |
| 81 | +// Write('<dir> '); |
| 82 | +// Writeln(Name); |
| 83 | +// // uncomment for recursive listing: |
| 84 | +// // if IsDir then |
| 85 | +// // tinydir(Name, @CallbackRecursive); |
| 86 | +// end; |
| 87 | +// |
| 88 | +// begin |
| 89 | +// tinydir('./', @Callback); |
| 90 | +// end. |
| 91 | +// |
| 92 | + |
| 93 | +end. |
0 commit comments