dirdemo.pas 2.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104
  1. PROGRAM DirDemo;
  2. {
  3. How you can use unit linklist.
  4. 21 Mar 2001.
  5. Changed to use printf in amigalib.
  6. 25 Nov 2002.
  7. [email protected]
  8. }
  9. uses Amigados, exec, strings, linklist, amigalib;
  10. CONST BufferSize = 2048;
  11. CSI = chr($9b);
  12. VAR ExData : pExAllData;
  13. PData : pExAllData;
  14. EAC : pExAllControl;
  15. MyLock : FileLock;
  16. AnyMore : BOOLEAN;
  17. FileList : pList;
  18. DirList : pList;
  19. tempnode : pFPCNode;
  20. Buffer : PChar;
  21. i,temp : longint;
  22. TotalSize : longint;
  23. TheDir : AnsiString;
  24. PROCEDURE CleanUp(TheMsg : STRING; ErrCode : INTEGER);
  25. BEGIN
  26. IF EAC <> NIL THEN FreeDosObject(DOS_EXALLCONTROL,EAC);
  27. IF MyLock <> 0 THEN UnLock(MyLock);
  28. IF ExData <> NIL THEN ExecFreeMem(ExData,BufferSize);
  29. IF DirList <> NIL THEN DestroyList(DirList);
  30. IF FileList <> NIL THEN DestroyList(FileList);
  31. IF Buffer <> NIL THEN StrDispose(Buffer);
  32. IF TheMsg <> '' THEN WriteLN(TheMsg);
  33. Halt(ErrCode);
  34. END;
  35. PROCEDURE Usage;
  36. BEGIN
  37. Write(CSI, '1m', 'DirDemo'#10,CSI,'0m', 'For FPC Pascal USAGE: DirDemo ThePath'#10);
  38. CleanUp('',0);
  39. END;
  40. BEGIN
  41. Buffer := StrAlloc(255);
  42. IF ParamCount <> 1 then Usage;
  43. TheDir := ParamStr(1);
  44. CreateList(FileList);
  45. CreateList(DirList);
  46. TotalSize := 0;
  47. EAC := AllocDosObject(DOS_EXALLCONTROL,NIL);
  48. IF EAC = NIL THEN CleanUp('No AllocDosObject',10);
  49. ExData := ExecAllocMem(BufferSize,0);
  50. EAC^.eac_LastKey := 0;
  51. EAC^.eac_MatchString := NIL;
  52. EAC^.eac_MatchFunc := NIL;
  53. MyLock:=Lock(PChar(TheDir),SHARED_LOCK);
  54. IF MyLock=0 THEN CleanUp('No lock on directory',10);
  55. REPEAT
  56. AnyMore := ExAll(MyLock,ExData,BufferSize,ED_SIZE,EAC);
  57. temp := IOErr;
  58. PData := ExData;
  59. FOR i := 1 TO EAC^.eac_Entries DO BEGIN
  60. IF PData^.ed_Type >= 0 THEN BEGIN
  61. tempnode := AddNewNode(DirList,PData^.ed_Name);
  62. END ELSE BEGIN
  63. tempnode := AddNewNode(FileList,PData^.ed_Name);
  64. tempnode^.ln_Size := PData^.ed_Size;
  65. END;
  66. PData := PData^.ed_Next;
  67. END;
  68. UNTIL (AnyMore=FALSE) AND (temp=ERROR_NO_MORE_ENTRIES);
  69. SortList(DirList);
  70. SortList(FileList);
  71. Write(CSI, '1m');
  72. Write(CSI, '32m');
  73. WriteLN('Directory of: "', TheDir,'"');
  74. tempnode := GetFirstNode(DirList);
  75. FOR i := 1 TO NodesInList(DirList) DO BEGIN
  76. printf('%-30s <DIR>'#10,[PtrUInt(GetNodeData(tempnode))]);
  77. tempnode := GetNextNode(tempnode);
  78. END;
  79. Write(CSI, '0m');
  80. tempnode := GetFirstNode(FileList);
  81. FOR i := 1 TO NodesInList(FileList) DO BEGIN
  82. printf('%-30s%7ld'#10 ,[PtrUInt(GetNodeData(tempnode)),tempnode^.ln_Size]);
  83. TotalSize := TotalSize + tempnode^.ln_Size;
  84. tempnode := GetNextNode(tempnode);
  85. END;
  86. WriteLN('The total size is ',TotalSize,' Byte.');
  87. CleanUp('',0);
  88. END.