123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104 |
- PROGRAM DirDemo;
- {
- How you can use unit linklist.
- 21 Mar 2001.
- Changed to use printf in amigalib.
- 25 Nov 2002.
- [email protected]
- }
- uses Amigados, exec, strings, linklist, amigalib;
- CONST BufferSize = 2048;
- CSI = chr($9b);
- VAR ExData : pExAllData;
- PData : pExAllData;
- EAC : pExAllControl;
- MyLock : FileLock;
- AnyMore : BOOLEAN;
- FileList : pList;
- DirList : pList;
- tempnode : pFPCNode;
- Buffer : PChar;
- i,temp : longint;
- TotalSize : longint;
- TheDir : AnsiString;
- PROCEDURE CleanUp(TheMsg : STRING; ErrCode : INTEGER);
- BEGIN
- IF EAC <> NIL THEN FreeDosObject(DOS_EXALLCONTROL,EAC);
- IF MyLock <> 0 THEN UnLock(MyLock);
- IF ExData <> NIL THEN ExecFreeMem(ExData,BufferSize);
- IF DirList <> NIL THEN DestroyList(DirList);
- IF FileList <> NIL THEN DestroyList(FileList);
- IF Buffer <> NIL THEN StrDispose(Buffer);
- IF TheMsg <> '' THEN WriteLN(TheMsg);
- Halt(ErrCode);
- END;
- PROCEDURE Usage;
- BEGIN
- Write(CSI, '1m', 'DirDemo'#10,CSI,'0m', 'For FPC Pascal USAGE: DirDemo ThePath'#10);
- CleanUp('',0);
- END;
- BEGIN
- Buffer := StrAlloc(255);
- IF ParamCount <> 1 then Usage;
- TheDir := ParamStr(1);
- CreateList(FileList);
- CreateList(DirList);
- TotalSize := 0;
- EAC := AllocDosObject(DOS_EXALLCONTROL,NIL);
- IF EAC = NIL THEN CleanUp('No AllocDosObject',10);
- ExData := ExecAllocMem(BufferSize,0);
- EAC^.eac_LastKey := 0;
- EAC^.eac_MatchString := NIL;
- EAC^.eac_MatchFunc := NIL;
- MyLock:=Lock(PChar(TheDir),SHARED_LOCK);
- IF MyLock=0 THEN CleanUp('No lock on directory',10);
- REPEAT
- AnyMore := ExAll(MyLock,ExData,BufferSize,ED_SIZE,EAC);
- temp := IOErr;
- PData := ExData;
- FOR i := 1 TO EAC^.eac_Entries DO BEGIN
- IF PData^.ed_Type >= 0 THEN BEGIN
- tempnode := AddNewNode(DirList,PData^.ed_Name);
- END ELSE BEGIN
- tempnode := AddNewNode(FileList,PData^.ed_Name);
- tempnode^.ln_Size := PData^.ed_Size;
- END;
- PData := PData^.ed_Next;
- END;
- UNTIL (AnyMore=FALSE) AND (temp=ERROR_NO_MORE_ENTRIES);
- SortList(DirList);
- SortList(FileList);
- Write(CSI, '1m');
- Write(CSI, '32m');
- WriteLN('Directory of: "', TheDir,'"');
- tempnode := GetFirstNode(DirList);
- FOR i := 1 TO NodesInList(DirList) DO BEGIN
- printf('%-30s <DIR>'#10,[PtrUInt(GetNodeData(tempnode))]);
- tempnode := GetNextNode(tempnode);
- END;
- Write(CSI, '0m');
- tempnode := GetFirstNode(FileList);
- FOR i := 1 TO NodesInList(FileList) DO BEGIN
- printf('%-30s%7ld'#10 ,[PtrUInt(GetNodeData(tempnode)),tempnode^.ln_Size]);
- TotalSize := TotalSize + tempnode^.ln_Size;
- tempnode := GetNextNode(tempnode);
- END;
- WriteLN('The total size is ',TotalSize,' Byte.');
- CleanUp('',0);
- END.
|