home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / MFM_119C.ZIP / SLCTDIR.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-03  |  16KB  |  470 lines
  1. Unit SlctDir;
  2. {========================================================================}
  3. Interface
  4.   Uses
  5.     Dos;
  6.   Function SelectDir(FileAreaPath : PathStr) : PathStr;
  7. {========================================================================}
  8. Implementation
  9.   Uses
  10.     Crt, MfmStr, Screen;
  11.   Type
  12.     ListPtr = ^ListRecord;
  13.     ListRecord = Record
  14.       Next, Prev : ListPtr;
  15.       Attr : Byte;
  16.       Name : String[12];
  17.     End;
  18.   Var
  19.     DirInfo : SearchRec;
  20.     FirstEntry, CurrentEntry, TempEntry : ListPtr;
  21.     TempRecord : ListRecord;
  22.     NoOfEntries, CurrentEntryNo : Word;
  23.     NoEntryToShow : Byte;
  24.     CurrentDrive : Byte;
  25.     ForChar : Char;
  26.     Msr : Registers;
  27.     DriveList, TempString : String;
  28. {========================================================================}
  29. Procedure BuildDirList(FileSpec : PathStr);
  30.   Begin
  31.     FirstEntry := NIL; NoOfEntries := 0;
  32.     FindFirst(FileSpec, AnyFile, DirInfo);
  33.     While DosError = 0 Do
  34.     Begin
  35.       If DirInfo.Name = '.' Then FindNext(DirInfo);
  36.       If DirInfo.Attr = Directory Then
  37.       Begin
  38.         New(CurrentEntry); Inc(NoOfEntries);
  39.         If FirstEntry = NIL Then
  40.         Begin
  41.           FirstEntry := CurrentEntry;
  42.           CurrentEntry^.Prev := NIL;
  43.         End
  44.         Else
  45.         Begin
  46.           CurrentEntry^.Prev := TempEntry;
  47.           TempEntry^.Next := CurrentEntry;
  48.         End;
  49.         CurrentEntry^.Next := NIL;
  50.         CurrentEntry^.Attr := DirInfo.Attr;
  51.         CurrentEntry^.Name := DirInfo.Name;
  52.         TempEntry := CurrentEntry;
  53.       End;
  54.       FindNext(DirInfo);
  55.     End;
  56.   End;
  57. {========================================================================}
  58. Procedure SortDirList;
  59.   Var
  60.     Exchange : Boolean;
  61.   Begin
  62.     If FirstEntry <> NIL Then
  63.     Begin
  64.       New(TempEntry);
  65.       Repeat
  66.         Exchange := False;
  67.         CurrentEntry := FirstEntry;
  68.         While CurrentEntry^.Next <> NIL Do
  69.         Begin
  70.           If CurrentEntry^.Name > CurrentEntry^.Next^.Name Then
  71.           Begin
  72.             TempEntry^.Attr := CurrentEntry^.Attr;
  73.             CurrentEntry^.Attr := CurrentEntry^.Next^.Attr;
  74.             CurrentEntry^.Next^.Attr := TempEntry^.Attr;
  75.             TempEntry^.Name := CurrentEntry^.Name;
  76.             CurrentEntry^.Name := CurrentEntry^.Next^.Name;
  77.             CurrentEntry^.Next^.Name := TempEntry^.Name;
  78.             Exchange := True;
  79.           End;
  80.           CurrentEntry := CurrentEntry^.Next;
  81.         End;
  82.       Until (Not Exchange);
  83.       Dispose(TempEntry);
  84.     End;
  85.   End;
  86. {========================================================================}
  87. Procedure DisplayDirList;
  88.   Begin
  89.     If FirstEntry <> NIL Then
  90.     Begin
  91.       CurrentEntry := FirstEntry;
  92.       WriteLn(' File List ');
  93.       WriteLn('-----------');
  94.       WriteLn(CurrentEntry^.Name);
  95.       While CurrentEntry^.Next <> NIL Do
  96.       Begin
  97.         CurrentEntry := CurrentEntry^.Next;
  98.         WriteLn(CurrentEntry^.Name);
  99.       End;
  100.     End;
  101.   End;
  102. {========================================================================}
  103. Procedure RemoveDirList;
  104.   Begin
  105.     If FirstEntry <> NIL Then
  106.     Begin
  107.       CurrentEntry := FirstEntry;
  108.       While CurrentEntry^.Next <> NIL Do
  109.       Begin
  110.         TempEntry := CurrentEntry;
  111.         CurrentEntry := CurrentEntry^.Next;
  112.         Dispose(TempEntry);
  113.       End;
  114.       Dispose(CurrentEntry);
  115.     End;
  116.   End;
  117. {========================================================================}
  118. Function DisplayEntryNo(EntryNo : Byte) : String;
  119.   Var
  120.     EntryNoCtr : Byte;
  121.   Begin
  122.     If FirstEntry <> NIL Then
  123.     Begin
  124.       TempEntry := FirstEntry; EntryNoCtr := 1;
  125.       While (EntryNoCtr < EntryNo) And (EntryNoCtr < NoOfEntries) Do
  126.       Begin
  127.         TempEntry := TempEntry^.Next;
  128.         Inc(EntryNoCtr);
  129.       End;
  130.       If EntryNoCtr = EntryNo Then
  131.       Begin
  132.         DisplayEntryNo := TempEntry^.Name+Copy('            ',1,12-Length(TempEntry^.Name));
  133.         TempRecord.Attr := TempEntry^.Attr;
  134.         TempRecord.Name := TempEntry^.Name;
  135.       End
  136.       Else
  137.       Begin
  138.         DisplayEntryNo := '            ';
  139.         TempRecord.Attr := 0;
  140.         TempRecord.Name := '';
  141.       End;
  142.     End
  143.     Else
  144.     Begin
  145.       DisplayEntryNo := 'None';
  146.     End;
  147.   End;
  148. {========================================================================}
  149. Procedure DisplayEntryList(StartFrom : Word; Col, Row : Byte);
  150.   Var
  151.     Lsi : Word;
  152.   Begin
  153.     If FirstEntry <> NIL Then
  154.     Begin
  155.       AnsiGotoXYNew(Col,Row);
  156.       If StartFrom > 1 Then WriteLn(' ^ ') Else WriteLn('═══');
  157.       Inc(Row);
  158.       For Lsi := StartFrom To StartFrom+(NoEntryToShow-1) Do
  159.       Begin
  160.         AnsiGotoXYNew(Col,Row);
  161.         WriteLn(DisplayEntryNo(Lsi));
  162.         Inc(Row);
  163.       End;
  164.       AnsiGotoXYNew(Col,Row);
  165.       If NoOfEntries > StartFrom+(NoEntryToShow-1) Then WriteLn(' v ') Else WriteLn('═══');
  166.       Inc(Row);
  167.     End;
  168.   End;
  169. {========================================================================}
  170. Procedure DoubleBox(Col, Row, Height, Width : Byte);
  171.   Var
  172.     Dbb : Byte;
  173.   Begin
  174.     AnsiGotoXYNew(Col,Row); Write('╔');
  175.     For Dbb := 1 To Width-1 Do Write('═');
  176.     Write('╗');
  177.     For Dbb := 1 To Height Do
  178.     Begin
  179.       AnsiGotoXYNew(Col,Row+Dbb); Write('║');
  180.       AnsiGotoXYNew(Col+Width,Row+Dbb); Write('║');
  181.     End;
  182.     AnsiGotoXYNew(Col,Row+Dbb); Write('╚');
  183.     For Dbb := 1 To Width-1 Do Write('═');
  184.     Write('╝');
  185.   End;
  186. {========================================================================}
  187. Function SelectDir(FileAreaPath : PathStr) : PathStr;
  188.   Const
  189.     NoOfFiles = 15;
  190.     Col = 2;
  191.     Row = 2;
  192.   Var
  193.     SelPos, Sfb : Byte;
  194.     Sfc : Char;
  195.     TopChanged : Boolean;
  196.     TopEntry : Word;
  197.     D: DirStr;
  198.     N: NameStr;
  199.     E: ExtStr;
  200.   Begin
  201.     AnsiClearScreen;
  202.     FSplit(FExpand(FileAreaPath),D,N,E);
  203.     BuildDirList(FileAreaPath);
  204.     SortDirList;
  205.     If FirstEntry <> NIL Then
  206.     Begin
  207.       SelPos := 1;
  208.       TopEntry := 1;
  209.       TopChanged := True;
  210.       NoEntryToShow := NoOfFiles;
  211.       DoubleBox(Col,Row,NoEntryToShow+1,15);
  212.       AnsiGotoXYNew(Col+1,Row+(SelPos-TopEntry)+1); Write('>');
  213.       AnsiGotoXYNew(Col+14,Row+(SelPos-TopEntry)+1); Write('<');
  214.       Repeat
  215.         If TopChanged Then
  216.         Begin
  217.           DisplayEntryList(TopEntry,Col+2,Row);
  218.           AnsiGotoXYNew(41,15); Write('D - Change Drive');
  219.           AnsiGotoXYNew(41,16); Write('Q - Quit to Area Select');
  220.           AnsiGotoXYNew(41,17); Write('S - Select Directory');
  221.           TopChanged := False;
  222.         End;
  223.         AnsiGotoXYNew(50,1); AnsiClearToEol;
  224.         If Pos('..',DisplayEntryNo(SelPos)) > 0 Then
  225.         Begin
  226.           Write(D);
  227.         End
  228.         Else
  229.         Begin
  230.           Write(AllTrim(D+DisplayEntryNo(SelPos))+'\');
  231.         End;
  232.         Repeat
  233.           Sfb := GetInput;
  234.           Sfc := Upcase(Chr(Sfb));
  235.           If Sfb = 0 Then
  236.           Begin
  237.             Sfb := GetInput;
  238.             Case Sfb Of
  239.               71 : Sfc := '7';
  240.               72 : Sfc := '8';
  241.               73 : Sfc := '9';
  242.               75 : Sfc := '4';
  243.               77 : Sfc := '6';
  244.               79 : Sfc := '1';
  245.               80 : Sfc := '2';
  246.               81 : Sfc := '3';
  247.             End;
  248.           End;
  249.         Until Sfc In [#13,#27,'1','2','3','7','8','9','D','Q','S'];
  250.         Case Sfc Of
  251.           '1' : Begin
  252.                   If SelPos < NoOfEntries Then
  253.                   Begin
  254.                     AnsiGotoXYNew(Col+1,Row+(SelPos-TopEntry)+1); Write(' ');
  255.                     AnsiGotoXYNew(Col+14,Row+(SelPos-TopEntry)+1); Write(' ');
  256.                     SelPos := NoOfEntries;
  257.                     If NoOfEntries > NoOfFiles Then
  258.                     Begin
  259.                       TopEntry := (NoOfEntries-NoOfFiles)+1;
  260.                       TopChanged := True;
  261.                     End;
  262.                     AnsiGotoXYNew(Col+1,Row+(SelPos-TopEntry)+1); Write('>');
  263.                     AnsiGotoXYNew(Col+14,Row+(SelPos-TopEntry)+1); Write('<');
  264.                   End;
  265.                 End;
  266.           '2' : Begin
  267.                   If SelPos < NoOfEntries Then
  268.                   Begin
  269.                     If (SelPos-TopEntry)+2 > NoOfFiles Then
  270.                     Begin
  271.                       Inc(TopEntry);
  272.                       TopChanged := True;
  273.                       Inc(SelPos);
  274.                     End
  275.                     Else
  276.                     Begin
  277.                       AnsiGotoXYNew(Col+1,Row+(SelPos-TopEntry)+1); Write(' ');
  278.                       AnsiGotoXYNew(Col+14,Row+(SelPos-TopEntry)+1); Write(' ');
  279.                       Inc(SelPos);
  280.                       AnsiGotoXYNew(Col+1,Row+(SelPos-TopEntry)+1); Write('>');
  281.                       AnsiGotoXYNew(Col+14,Row+(SelPos-TopEntry)+1); Write('<');
  282.                     End;
  283.                   End;
  284.                 End;
  285.           '3' : Begin
  286.                   If SelPos < NoOfEntries Then
  287.                   Begin
  288.                     AnsiGotoXYNew(Col+1,Row+(SelPos-TopEntry)+1); Write(' ');
  289.                     AnsiGotoXYNew(Col+14,Row+(SelPos-TopEntry)+1); Write(' ');
  290.                     If NoOfEntries < NoOfFiles Then
  291.                     Begin
  292.                       SelPos := NoOfEntries;
  293.                     End
  294.                     Else
  295.                     Begin
  296.                       If SelPos+NoOfFiles < NoOfEntries Then
  297.                       Begin
  298.                         SelPos := SelPos+NoOfFiles;
  299.                         TopEntry := TopEntry+NoOfFiles;
  300.                         TopChanged := True;
  301.                       End
  302.                       Else
  303.                       Begin
  304.                         SelPos := NoOfEntries;
  305.                         TopEntry := (NoOfEntries-NoOfFiles)+1;
  306.                         TopChanged := True;
  307.                       End;
  308.                     End;
  309.                     AnsiGotoXYNew(Col+1,Row+(SelPos-TopEntry)+1); Write('>');
  310.                     AnsiGotoXYNew(Col+14,Row+(SelPos-TopEntry)+1); Write('<');
  311.                   End;
  312.                 End;
  313.           '7' : Begin
  314.                   If SelPos > 1 Then
  315.                   Begin
  316.                     AnsiGotoXYNew(Col+1,Row+(SelPos-TopEntry)+1); Write(' ');
  317.                     AnsiGotoXYNew(Col+14,Row+(SelPos-TopEntry)+1); Write(' ');
  318.                     SelPos := 1;
  319.                     AnsiGotoXYNew(Col+1,Row+1); Write('>');
  320.                     AnsiGotoXYNew(Col+14,Row+1); Write('<');
  321.                   End;
  322.                   If TopEntry > 1 Then
  323.                   Begin
  324.                     TopEntry := 1;
  325.                     TopChanged := True;
  326.                   End;
  327.                 End;
  328.           '8' : Begin
  329.                   If SelPos > 1 Then
  330.                   Begin
  331.                     If SelPos = TopEntry Then
  332.                     Begin
  333.                       Dec(TopEntry);
  334.                       TopChanged := True;
  335.                       Dec(SelPos);
  336.                     End
  337.                     Else
  338.                     Begin
  339.                       AnsiGotoXYNew(Col+1,Row+(SelPos-TopEntry)+1); Write(' ');
  340.                       AnsiGotoXYNew(Col+14,Row+(SelPos-TopEntry)+1); Write(' ');
  341.                       Dec(SelPos);
  342.                       AnsiGotoXYNew(Col+1,Row+(SelPos-TopEntry)+1); Write('>');
  343.                       AnsiGotoXYNew(Col+14,Row+(SelPos-TopEntry)+1); Write('<');
  344.                     End;
  345.                   End;
  346.                 End;
  347.           '9' : Begin
  348.                   If SelPos > 1 Then
  349.                   Begin
  350.                     AnsiGotoXYNew(Col+1,Row+(SelPos-TopEntry)+1); Write(' ');
  351.                     AnsiGotoXYNew(Col+14,Row+(SelPos-TopEntry)+1); Write(' ');
  352.                     If NoOfEntries < NoOfFiles Then
  353.                     Begin
  354.                       SelPos := 1;
  355.                     End
  356.                     Else
  357.                     Begin
  358.                       If SelPos-NoOfFiles > 1 Then
  359.                       Begin
  360.                         SelPos := SelPos-NoOfFiles;
  361.                         If TopEntry > NoOfFiles Then
  362.                         Begin
  363.                           TopEntry := TopEntry-NoOfFiles;
  364.                         End
  365.                         Else
  366.                         Begin
  367.                           TopEntry := SelPos;
  368.                         End;
  369.                         TopChanged := True;
  370.                       End
  371.                       Else
  372.                       Begin
  373.                         SelPos := 1;
  374.                         TopEntry := 1;
  375.                         TopChanged := True;
  376.                       End;
  377.                     End;
  378.                     AnsiGotoXYNew(Col+1,Row+(SelPos-TopEntry)+1); Write('>');
  379.                     AnsiGotoXYNew(Col+14,Row+(SelPos-TopEntry)+1); Write('<');
  380.                   End;
  381.                 End;
  382.           'D' : Begin
  383.                   DriveList := '';
  384.                   Msr.Ah := $19;
  385.                   MsDos(Msr);
  386.                   CurrentDrive := Msr.Al;
  387.                   For ForChar := 'A' To 'Z' Do
  388.                   Begin
  389.                     Msr.Ah := $0E;
  390.                     Msr.Dl := Ord(ForChar) - Ord('A');
  391.                     MsDos(Msr);
  392.                     Msr.Ah := $19;
  393.                     MsDos(Msr);
  394.                     If Msr.Al = Msr.Dl Then DriveList := DriveList+(Char(Msr.Al+Ord('A')))+': ';
  395.                   End;
  396.                   Msr.Ah := $0E;
  397.                   Msr.Dl := CurrentDrive;
  398.                   MsDos(Msr);
  399.                   AnsiGotoXYNew(1,25);
  400.                   Write(DriveList);
  401.                   AnsiGotoXYNew(41,23);
  402.                   Write('Select drive: ');
  403.                   Repeat
  404.                     Sfc := Upcase(ReadKey);
  405.                   Until (Pos(Sfc,DriveList) > 0) Or (Sfc = #27);
  406.                   If Sfc <> #27 Then
  407.                   Begin
  408.                     GetDir(Ord(Sfc)-(Ord('A')-1),TempString);
  409.                     AnsiGotoXYNew(41,21); ClrEol;
  410.                     Write(TempString);
  411.                     If Copy(TempString,Length(TempString),1) <> '\' Then TempString := TempString+'\';
  412.                     FSplit(FExpand(TempString+N+E),D,N,E);
  413.                     FileAreaPath := D+N+E;
  414.                     RemoveDirList;
  415.                     BuildDirList(FileAreaPath);
  416.                     SortDirList;
  417.                     SelPos := 1;
  418.                     TopEntry := 1;
  419.                     TopChanged := True;
  420.                     NoEntryToShow := NoOfFiles;
  421.                     AnsiClearScreen;
  422.                     DoubleBox(Col,Row,NoEntryToShow+1,15);
  423.                     AnsiGotoXYNew(Col+1,Row+(SelPos-TopEntry)+1); Write('>');
  424.                     AnsiGotoXYNew(Col+14,Row+(SelPos-TopEntry)+1); Write('<');
  425.                     Sfc := ' ';
  426.                   End;
  427.                 End;
  428.         End;
  429.         If (Sfc = #13) And (TempRecord.Attr = Directory) Then
  430.         Begin
  431.           FSplit(FExpand(D+TempRecord.Name+'\'+N+E),D,N,E);
  432.           FileAreaPath := D+N+E;
  433.           RemoveDirList;
  434.           BuildDirList(FileAreaPath);
  435.           SortDirList;
  436.           SelPos := 1;
  437.           TopEntry := 1;
  438.           TopChanged := True;
  439.           NoEntryToShow := NoOfFiles;
  440.           AnsiClearScreen;
  441.           DoubleBox(Col,Row,NoEntryToShow+1,15);
  442.           AnsiGotoXYNew(Col+1,Row+(SelPos-TopEntry)+1); Write('>');
  443.           AnsiGotoXYNew(Col+14,Row+(SelPos-TopEntry)+1); Write('<');
  444.           Sfc := ' ';
  445.         End;
  446.       Until Sfc In [#27,'S','Q'];
  447.       If Sfc In [#27,'Q'] Then
  448.       Begin
  449.         SelectDir := '';
  450.       End
  451.       Else
  452.       Begin
  453.         If Pos('..',DisplayEntryNo(SelPos)) > 0 Then
  454.         Begin
  455.           SelectDir := D;
  456.         End
  457.         Else
  458.         Begin
  459.           SelectDir := AllTrim(D+DisplayEntryNo(SelPos))+'\';
  460.         End;
  461.       End;
  462.       CurrentEntryNo := SelPos;
  463.     End;
  464.     RemoveDirList;
  465.   End;
  466. {========================================================================}
  467. Begin
  468. End.
  469. {========================================================================}
  470.