← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/packages/extra/amunits/demos/dirdemo.pas

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

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