home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PULLDIR.ZIP / PULLDIR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-12-13  |  14.4 KB  |  450 lines
  1. {$R+,S+,I-,D+,T-,F-,V-,B-,N-,L+ }
  2. {$M 16384,0,655360 }
  3. {############################## PullDir.PAS #################################}
  4.  
  5. Unit PullDir;
  6.  
  7. Interface
  8.  
  9. Uses Dos,
  10.      TPDos,
  11.      TPCrt,
  12.      TPMenu,
  13.      TPEdit,
  14.      TPString,
  15.      PullVar;
  16.  
  17. TYPE
  18.   FrameCharType = (ULeft,LLeft,MLeft,URight,LRight,MRight,MTop,MBot,Horiz,Vert);
  19.   FrameArray    = Array[FrameCharType] of Char;
  20.  
  21. CONST
  22.   ON     : Boolean= True;
  23.   OFF    : Boolean= False;
  24.   Frame1 : FrameArray = '╔╚╞╗╝╡╦╩═║';
  25.  
  26. VAR  Z:  Byte;        { global loop variable }
  27.  
  28. FUNCTION  GetDirectory(VAR Mask,Name: String): Word;
  29. PROCEDURE Beep(Freq,Del: Integer);
  30. PROCEDURE HorizontalLine(HrzChar: char; LeftCol,LeftRow,Width,Color: Byte);
  31. PROCEDURE VerticalLine(VrtChar: char; TopCol,TopRow,Depth,Color: Byte);
  32.  
  33. Implementation
  34.  
  35. PROCEDURE Beep{(Freq,Del: Integer)};
  36.   BEGIN
  37.     sound(Freq);
  38.     delay(del);
  39.     nosound;
  40.   END;
  41.  
  42. PROCEDURE HorizontalLine{(HrzChar: char; LeftCol,LeftRow,Width,Color: Byte)};
  43. BEGIN
  44.   FastWrite(Frame1[MLeft],LeftRow,LeftCol,Color);
  45.   For Z:=1 to Width-2 do FastWrite(Frame1[Horiz],LeftRow,LeftCol+Z,Color);
  46.   FastWrite(Frame1[MRight],LeftRow,LeftCol+Z+1,Color);
  47. END;
  48.  
  49. PROCEDURE VerticalLine{(VrtChar: char; TopCol,TopRow,Depth,Color: Byte)};
  50. BEGIN
  51.   FastWrite(Frame1[MTop],TopRow,TopCol,Color);
  52.   For Z:=1 to Depth-2 do BEGIN
  53.     FastWrite(Frame1[Vert],TopRow+Z,TopCol,Color);
  54.   END;
  55.   FastWrite(Frame1[MBot],TopRow+Z+1,TopCol,Color);
  56. END;
  57.  
  58. FUNCTION GetDirectory{(VAR Mask: St80; VAR Name: St15): Word};
  59. { Main function that will return the most recent searching mask and the
  60.   filename selected.  It returns the key pressed along with its scan code
  61.   for specific command implementation. }
  62.  
  63. CONST
  64.   cl     : Byte       = 1;
  65.   ln     : Byte       = 1;
  66.   hg     : Byte       = 25;
  67.   wd     : Byte       = 80;
  68.   CR     : Char       = ^M;
  69.   ESC    : Char       = ^[;
  70.  
  71. TYPE
  72.   DPtr  = ^DirDat;
  73.   DirDat= Record                       { record of directory entry }
  74.             DName:    String[8];
  75.              DExt:    String[4];
  76.             DSize:    String[7];
  77.             DDate:    String[8];
  78.             DTime:    String[7];
  79.              Next:    DPtr;
  80.              Prev:    DPtr;
  81.           END;
  82.  
  83.  
  84. VAR
  85.   DCol,DRow,Col,Row,DotPos,H: Byte;
  86.                       DirRec: DirDat;
  87.      HeadPtr,TailPtr,TempPtr,
  88.      ThisPtr,PagePtr,ShowPtr: DPtr;          { pointers to directory entries }
  89.                         SRec: SearchRec;
  90.                        TName: String[12];
  91.                         TExt: String[4];
  92.                           DT: DateTime;
  93.                           Pm: String[2];
  94.                 DKey,FuncKey: Word;
  95.       Escaped,DoRead,DirDone: Boolean;
  96.         InPath,ScPath,LdPath: String[80];
  97.                MaxLin,BotLin: Byte;
  98.  
  99.   PROCEDURE PutScreen;       { Draws main screen }
  100.     VAR PAttr: Byte;
  101.     BEGIN
  102.       ClrScr;
  103.       FrameWindow(cl,ln,wd,hg,Clr1[Bor],Clr1[Tit],'');
  104.       HorizontalLine('S',cl,ln+2,wd,Clr1[Bor]);
  105.       HorizontalLine('S',cl,ln+22,wd,Clr1[Bor]);
  106.       VerticalLine('S',cl+45,ln+2,hg-4,Clr1[Bor]);
  107.       For Z:=Row to Row+18 do ChangeAttribute(44,Z,Col-1, Clr1[Bk1]);
  108.       For Z:=Row to Row+18 do ChangeAttribute(33,Z,Col+44,Clr1[Bk2]);
  109.       For Z:=1 to 19 do BEGIN
  110.         Case Z of
  111.           1..3: PAttr:=Clr1[Nor];
  112.              4: PAttr:=Clr1[Tit];
  113.          5..13: PAttr:=Clr1[Key];
  114.         14..19: PAttr:=Clr1[Cmd];
  115.         End;
  116.         FastWrite(EditArray[Z],Z+3,Col+44,PAttr);
  117.       END;
  118.     END;
  119.  
  120.   PROCEDURE PutDir(APtr: DPtr; Col,Row: Byte; Bar: Boolean);
  121.   { Writes a single directory entry to screen }
  122.  
  123.     CONST EmpStr: String = '                                            ';
  124.     VAR TempStr: String;
  125.     BEGIN
  126.       If Not Bar then With APtr^ do BEGIN
  127.         FastWrite(EmpStr,Row,Col-1,Clr1[Bk1]);
  128.         FastWrite(DName,Row,Col+ 1,Clr1[Nam]);
  129.         FastWrite(DExt, Row,Col+10,Clr1[Ext]);
  130.         If DSize='  <DIR>' then FastWrite(DSize,Row,Col+15,Clr1[Dir])
  131.           ELSE FastWrite(DSize,Row,Col+15,Clr1[Siz]);
  132.         FastWrite(DDate,Row,Col+24,Clr1[Dat]);
  133.         FastWrite(DTime,Row,Col+34,Clr1[Tim]);
  134.       END ELSE With APtr^ do BEGIN
  135.         TempStr:=' '+DName+' '+DExt+' '+DSize+'  '+DDate+'  '+DTime+' ';
  136.         FastWrite(TempStr,Row,Col,Clr1[Sel]);
  137.       END;
  138.     END;
  139.  
  140.   PROCEDURE PutPage(PPtr: DPtr; PCol,PRow: Byte);
  141.   { Writes a one page of directory entries to screen }
  142.     BEGIN
  143.       While PRow<BotLin+1 do BEGIN
  144.         If PPtr<>NIL then BEGIN
  145.           PutDir(PPtr,PCol,PRow,OFF);
  146.           PPtr:=PPtr^.Next;
  147.         END ELSE FastWrite(Pad('',43),PRow,PCol,Clr1[Bk1]);
  148.         PRow:=Succ(PRow);
  149.       END;
  150.     END;
  151.  
  152.   FUNCTION PutLead(I: Byte): String;
  153.     BEGIN
  154.       If I >= 10 THEN PutLead:=Long2Str(I)
  155.       Else PutLead:='0'+Long2Str(I);
  156.     END;
  157.  
  158.   PROCEDURE NewRec( VAR NewPtr: DPtr);
  159.     BEGIN
  160.       NEW (NewPtr);
  161.       NewPtr^.Next := NIL;
  162.       NewPtr^.Prev := NIL;
  163.     END;
  164.  
  165.   PROCEDURE NewBefore (VAR HeadPtr, TailPtr, SPtr, TempPtr: DPtr);
  166.   { Inserts an entry in front of SPtr position }
  167.  
  168.   VAR PrevP: DPtr;
  169.   BEGIN
  170.     IF (SPtr = NIL) THEN BEGIN
  171.       HeadPtr := TempPtr;
  172.       TailPtr := TempPtr;
  173.     END
  174.     ELSE BEGIN
  175.       IF (SPtr = HeadPtr) THEN BEGIN
  176.         SPtr^.Prev := TempPtr;
  177.         TempPtr^.Next := SPtr;
  178.         TempPtr^.Prev := NIL;
  179.         HeadPtr := TempPtr;
  180.       END
  181.       ELSE BEGIN
  182.         PrevP := SPtr^.Prev;
  183.         TempPtr^.Prev := PrevP;
  184.         TempPtr^.Next := SPtr;
  185.         PrevP^.Next := TempPtr;
  186.         SPtr^.Prev := TempPtr;
  187.       END
  188.     END;
  189.     SPtr := TempPtr;
  190.   END;
  191.  
  192.   PROCEDURE NewAfter (VAR HeadPtr, TailPtr, SPtr, TempPtr: DPtr);
  193.   { Inserts an entry after SPtr position }
  194.  
  195.     VAR  NextP     : DPtr;
  196.     BEGIN
  197.       IF (SPtr = NIL) THEN BEGIN
  198.         HeadPtr := TempPtr;
  199.         TailPtr := TempPtr;
  200.       END
  201.       ELSE BEGIN
  202.         IF (SPtr = TailPtr) THEN BEGIN
  203.           SPtr^.Next := TempPtr;
  204.           TempPtr^.Prev := SPtr;
  205.           TempPtr^.Next := NIL;
  206.           TailPtr := TempPtr;
  207.         END
  208.         ELSE BEGIN
  209.           NextP := SPtr^.Next;
  210.           TempPtr^.Next := NextP;
  211.           TempPtr^.Prev := SPtr;
  212.           NextP^.Prev := TempPtr;
  213.           SPtr^.Next := TempPtr;
  214.         END
  215.       END;
  216.       SPtr := TempPtr;
  217.     END;
  218.  
  219.   PROCEDURE SortDir(TempPtr: DPtr);   { Sorts entries as they are loaded }
  220.     VAR SPtr: DPtr;
  221.         Done: Boolean;
  222.    DStr,SStr: String;
  223.  
  224.   PROCEDURE Insert(VAR SPtr,TempPtr: DPtr; Place: Char);
  225.     BEGIN
  226.       If Place='A' THEN NewAfter(HeadPtr,TailPtr,SPtr,TempPtr) ELSE
  227.         If Place='H' THEN NewBefore(HeadPtr,TailPtr,HeadPtr,TempPtr) ELSE
  228.           NewBefore(HeadPtr,TailPtr,SPtr,TempPtr);
  229.       Done:=TRUE;
  230.     END;
  231.  
  232.     BEGIN
  233.       Done:=FALSE;
  234.       SPtr:=TailPtr;
  235.       If (SPtr=NIL) THEN BEGIN
  236.         HeadPtr:=TempPtr;
  237.         TailPtr:=TempPtr;
  238.         ThisPtr:=TempPtr;
  239.         Done:=TRUE;
  240.       END ELSE BEGIN
  241.         While (SPtr<>NIL) and (not Done) do BEGIN
  242.           DStr:=TempPtr^.DName+TempPtr^.DExt;
  243.           SStr:=SPtr^.   DName+SPtr^.   DExt;
  244.           If CompUCString(DStr,SStr)= Greater then Insert(SPtr,TempPtr,'A')
  245.             ELSE SPtr:=SPtr^.Prev;
  246.         END;
  247.       END;
  248.       If not Done then Insert(HeadPtr,TempPtr,'B');
  249.     END;
  250.  
  251.   FUNCTION LoadDir(Mask: String): Boolean;
  252.   { Loads a given mask of directories }
  253.  
  254.     BEGIN
  255.       If Mask <> '' THEN BEGIN
  256.         HeadPtr:=NIL;
  257.         TailPtr:=NIL;
  258.         ThisPtr:=NIL;
  259.         TempPtr:=NIL;
  260.         FindFirst(Mask,AnyFile,SRec);
  261.         If DosError=0 then While DosError = 0 do BEGIN
  262.           NewRec(TempPtr);
  263.           TName:=SRec.Name;
  264.           DotPos:= Pos('.',TName);
  265.           If DotPos <> 0 THEN BEGIN
  266.             TExt:= '.'+Copy(TName,DotPos+1,Length(TName)-DotPos);
  267.             Delete(TName,DotPos,1+Length(TName)-DotPos);
  268.           END Else TExt:= '';
  269.           TempPtr^.DName:=Pad(TName,8);
  270.           TempPtr^.DExt:=Pad(TExt,4);
  271.           If (SRec.Attr and Directory) <> 0 THEN TempPtr^.DSize:='  <DIR>'
  272.           ELSE TempPtr^.DSize:=LeftPad(Long2Str(SRec.Size),7);
  273.           UnpackTime(SRec.Time,DT);
  274.           TempPtr^.DDate:=PutLead(DT.Month)+'-'+PutLead(DT.Day)+'-'+PutLead(DT.Year MOD 100);
  275.           If DT.Hour >= 12 THEN Pm:= 'pm' Else Pm:= 'am';
  276.           H:= DT.Hour MOD 12;
  277.           If H= 0 THEN H:= 12;
  278.           TempPtr^.DTime:=PutLead(H)+':'+PutLead(DT.Min)+Pm;
  279.           SortDir(TempPtr);
  280.           FindNext(SRec);
  281.           LoadDir:=TRUE;
  282.         END ELSE LoadDir:=FALSE;
  283.       END;
  284.     END;
  285.  
  286.   FUNCTION GetFile: Word;      { Selects a filename or subdirectory }
  287.     BEGIN
  288.       DRow:=Row;
  289.       DCol:=Col;
  290.       PutPage(PagePtr,Col,Row);
  291.       PutDir(ThisPtr,DCol,DRow,ON);
  292.       REPEAT
  293.         FuncKey:=ReadKeyWord;
  294.         Case Chr(Lo(FuncKey)) of
  295.           ^W: Hi(FuncKey):=71;
  296.           ^Z: Hi(FuncKey):=79;
  297.           ^R: Hi(FuncKey):=73;
  298.           ^C: Hi(FuncKey):=81;
  299.           ^E: Hi(FuncKey):=72;
  300.           ^X: Hi(FuncKey):=80;
  301.         END;
  302.         Case Hi(FuncKey) of
  303.           71: BEGIN                                           {Home}
  304.                 PagePtr:=HeadPtr;
  305.                 ThisPtr:=HeadPtr;
  306.                 DRow:=Row;
  307.               END;
  308.           79: BEGIN                                           {END}
  309.                 PagePtr:=TailPtr;
  310.                 DRow:=Row;
  311.                 For Z:=1 to MaxLin-1 do
  312.                   If PagePtr^.Prev<>NIL then BEGIN
  313.                     PagePtr:=PagePtr^.Prev;
  314.                     DRow:=Succ(DRow);
  315.                   END;
  316.                 ThisPtr:=TailPtr;
  317.               END;
  318.           73: BEGIN                                           {PgUp}
  319.                 For Z:=1 to MaxLin-1 do
  320.                   If PagePtr^.Prev<>NIL then BEGIN
  321.                     PagePtr:=PagePtr^.Prev;
  322.                     ThisPtr:=PagePtr;
  323.                     DRow:=Row;
  324.                   END;
  325.               END;
  326.           81: BEGIN                                           {PgDn}
  327.                 For Z:=1 to MaxLin-1 do
  328.                   If PagePtr^.Next<>NIL then BEGIN
  329.                     PagePtr:=PagePtr^.Next;
  330.                     ThisPtr:=PagePtr;
  331.                     DRow:=Row;
  332.                   END;
  333.                   If PagePtr^.Next=NIL then BEGIN
  334.                     DRow:=Row;
  335.                     For Z:=1 to MaxLin-1 do
  336.                       If PagePtr^.Prev<>NIL then BEGIN
  337.                         PagePtr:=PagePtr^.Prev;
  338.                         DRow:=Succ(DRow);
  339.                       END;
  340.                     ThisPtr:=TailPtr;
  341.                   END;
  342.               END;
  343.           72: BEGIN                                           {Up}
  344.                 If (ThisPtr^.Prev<>NIL) and (DRow>Row) then BEGIN
  345.                   PutDir(ThisPtr,DCol,DRow,OFF);
  346.                   ThisPtr:=ThisPtr^.Prev;
  347.                   DRow:=Pred(DRow);
  348.                 END ELSE If ThisPtr^.Prev<>NIL then BEGIN
  349.                   PutDir(ThisPtr,DCol,DRow,OFF);
  350.                   ScrollWindowDown(Col,Row,Col+42,BotLin,1);
  351.                   ThisPtr:=ThisPtr^.Prev;
  352.                 END;
  353.               END;
  354.           80: BEGIN                                           {Down}
  355.                 If (ThisPtr^.Next<>NIL) and (DRow<BotLin) then BEGIN
  356.                   PutDir(ThisPtr,DCol,DRow,OFF);
  357.                   ThisPtr:=ThisPtr^.Next;
  358.                   DRow:=Succ(DRow);
  359.                 END ELSE If ThisPtr^.Next<>NIL then BEGIN
  360.                   PutDir(ThisPtr,DCol,DRow,OFF);
  361.                   ScrollWindowUp(Col,Row,Col+42,BotLin,1);
  362.                   ThisPtr:=ThisPtr^.Next;
  363.                 END;
  364.               END;
  365.         END;
  366.         If Hi(FuncKey) in [71,79,73,81] then PutPage(PagePtr,Col,Row);
  367.         PutDir(ThisPtr,DCol,DRow,ON);
  368.       UNTIL (Lo(FuncKey)=27) or (Lo(FuncKey)=13);
  369.       GetFile:=FuncKey;
  370.     END;
  371.  
  372.   PROCEDURE PutStat;             { Shows disk & memory parameters }
  373.     BEGIN
  374.       FastWrite(Pad('',78),BotLin+2,Col-1,Clr1[Mem]);
  375.       FastWrite(' Disk Size: ',BotLin+2,Col,Clr1[Mem]);
  376.       FastWrite(Long2Str(DiskSize(0)),BotLin+2,Col+12,Clr1[Num]);
  377.       FastWrite(' Disk Free: ',BotLin+2,Col+23,Clr1[Mem]);
  378.       FastWrite(Long2Str(DiskFree(0)),BotLin+2,Col+35,Clr1[Num]);
  379.       FastWrite(' Free Memory : ',BotLin+2,Col+45,Clr1[Mem]);
  380.       FastWrite(Long2Str(MemAvail),BotLin+2,Col+60,Clr1[Num]);
  381.     END;
  382.  
  383. BEGIN
  384.   CheckBreak:=TRUE;       DoRead:=FALSE;       DirDone:=FALSE;
  385.   Col:=cl+2;              Row:=ln+3;           PutScreen;
  386.   DCol:=Col;              DRow:=Row;           ForceUpper:=TRUE;
  387.   ScPath:='';             LdPath:='';          MaxLin:=19;
  388.   BotLin:=Row+MaxLin-1;
  389.   GetDir(0,InPath);
  390.   PutStat;
  391.   If ParsePath(InPath,ScPath,LdPath) then
  392.     ReadString('Enter mask: ',ln+1,cl+1,66,Clr1[Ask],Clr1[Msk],Clr1[Nor],Escaped,ScPath);
  393.   If not Escaped then
  394.   REPEAT
  395.     PutStat;
  396.     If DoRead then BEGIN
  397.       GetDir(0,InPath);
  398.       If ParsePath(InPath,ScPath,LdPath) then
  399.         ReadString('Enter mask: ',ln+1,cl+1,66,Clr1[Ask],Clr1[Msk],Clr1[Nor],Escaped,ScPath);
  400.         DoRead:=FALSE;
  401.       If Escaped then DirDone:=TRUE;
  402.     END;
  403.     If LoadDir(ScPath) then BEGIN
  404.       FastWrite(ScPath+'          ',ln+1,cl+13,Clr1[Msk]);
  405.       ThisPtr:=HeadPtr;
  406.       PagePtr:=HeadPtr;
  407.       DKey:=GetFile;
  408.       If Chr(Lo(DKey))=CR then BEGIN
  409.         Name:=ThisPtr^.DName+'.'+ThisPtr^.DExt;
  410.         Mask:=ScPath;
  411.         GetDirectory:=DKey;
  412.         If ThisPtr^.DSize<>'  <DIR>' then DirDone:=TRUE;
  413.       END ELSE If Chr(Lo(DKey))=ESC then DirDone:=TRUE;
  414.     END ELSE BEGIN
  415.       Beep(600,100);
  416.       GetDir(0,InPath);
  417.     END;
  418.     If ThisPtr^.DSize='  <DIR>' then BEGIN
  419.       If ThisPtr^.DExt='.   ' then BEGIN
  420.         GetDir(0,InPath);
  421.         If ParsePath(InPath,ScPath,LdPath) then DoRead:=FALSE;
  422.       END ELSE If ThisPtr^.DExt='..  ' then BEGIN
  423.         ChDir('..');
  424.         GetDir(0,InPath);
  425.         If ParsePath(InPath,ScPath,LdPath) then DoRead:=FALSE;
  426.       END ELSE BEGIN
  427.         GetDir(0,InPath);
  428.         If ParsePath(InPath,ScPath,LdPath) then BEGIN
  429.           InPath:=LdPath+TrimTrail(ThisPtr^.DName);
  430.           ChDir(InPath);
  431.           GetDir(0,InPath);
  432.         END;
  433.         If ParsePath(InPath,ScPath,LdPath) then BEGIN
  434.           DoRead:=FALSE;
  435.           DirDone:=FALSE;
  436.           ThisPtr:=HeadPtr;
  437.           While ThisPtr^.Next<>NIL do BEGIN
  438.             ThisPtr:=ThisPtr^.Next;
  439.             Dispose(ThisPtr^.Prev);
  440.           END;
  441.           Dispose(ThisPtr);
  442.         END;
  443.       END;
  444.     END;
  445.     FastWrite(Pad(ScPath,66),ln+1,cl+13,Clr1[Msk]);
  446.   UNTIL DirDone;
  447. END;
  448.  
  449. END.
  450.