procedure kopf;
begin
 writeln('Kopierprogramm fuer nur ein Diskettenlaufwerk');
 writeln('VEB Mikroelektronik "Wilhelm Pieck" Muehlhausen');
 writeln('                                    Version 1.1');
end;

PROCEDURE READDIR ;
LABEL EXIT ;
BEGIN
 BDOS(26,ADDR(DMA)) ;
 BDOSNR:=17 ;
 FOR I:=0 TO 127 DO
  FDCS[I]:='' ;
 J:=0 ;
 REPEAT
  FDC[0]:=DRIVE+1 ;
  FOR I:=1 TO 11 DO
   FDC[I]:= ORD('?') ;
  FOR I:=12 TO 33 DO
   FDC [I]:= 0 ;
  A:=BDOS (BDOSNR,ADDR(FDC)) ;
  BDOSNR:=18 ;
  IF A>3 THEN GOTO EXIT ;
  FOR I:=0 TO 11 DO
   FDCS [J]:=FDCS[J]+CHR (DMA [A*32+1+I]) ;
  J:=J+1 ;
 UNTIL J=128 ;
EXIT: END ;

PROCEDURE SORT ;
VAR       K  : INTEGER ;
BEGIN
 FOR I:=0 TO J-2 DO BEGIN
  FOR K:=0 TO J-I-2 DO BEGIN
   IF FDCS [K] > FDCS[K+1] THEN
   BEGIN
    HELP:=FDCS[K] ;
    FDCS[K]:= FDCS[K+1] ;
    FDCS[K+1]:=HELP ;
   END ;
  END ;
 END ;
END ;

PROCEDURE SORTe ;
VAR       K  : INTEGER ;
BEGIN
 sort;
 FOR I:=0 TO J-2 DO BEGIN
  FOR K:=0 TO J-I-2 DO BEGIN
   IF copy(FDCS [K],9,3) > copy(FDCS[K+1],9,3) THEN
   BEGIN
    HELP:=FDCS[K] ;
    FDCS[K]:= FDCS[K+1] ;
    FDCS[K+1]:=HELP ;
   END ;
  END ;
 END ;
END ;

procedure nlaufwerk;
begin
 DRIVENAME:=copy(befehl,1,1);
 drivename:=upcase(drivename);
 DRIVE:=ORD(DRIVENAME)-$41 ;
 bdos(14,drive);
 bdos(32,usernr);
 READDIR ;
 case s of
  1:sort;
  2:sorte;
 end;
end;

procedure user(var nr:integer);
var unr :integer;
      u : string [2];
begin
if i=1 then u:=copy(befehl,6,2) else u:=copy(befehl,6,1);
val(u,unr,i);
if i>0 then writeln('fehlerhaftes Argument') else nr:=unr;
bdosnr:=32;
bdos(bdosnr,nr);
readdir;
if s=1 then sort;
if s=2 then sorte;
end;

procedure befehlssatz;
begin
 writeln('?  DIR  USER  XUSER  SORT  SORTE  UNSORT  COPY  A:-H:  EXIT');
end;

procedure kbgb;
var i : integer;
 temp : string[11];
begin;
 i:=0;
 temp:='';
 while i<length(befehl) do begin
  i:=i+1;
  temp:=temp+upcase(copy(befehl,i,1));
 end;
 befehl:=temp;
end;