home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Pascal / MAXONPASCAL3.DMS / in.adf / DEMOS-OS1.3 / Trackdisk.p < prev    next >
Encoding:
Text File  |  1994-07-23  |  3.7 KB  |  164 lines
  1. { MaxonPascal3-Anpassung / Test:  Falk Zühlsdorff (PackMAN) 1994 }
  2.  
  3. Program Trackdisk;
  4.  
  5. Uses ExecSupport,Crt;
  6.  
  7. {$include "devices/trackdisk.h" }
  8.  
  9. Const Drive = 0;     { Laufwerksnummer }
  10.       Hex   = '0123456789abcdef';
  11.  
  12. Type ModeType = (Hexdump, AsciiDump);
  13.  
  14. Var diskport    : p_MsgPort;
  15.     diskreq     : ^IOExtTD;
  16.     DiskBuffer  : ^Array[1..TD_SECTOR] Of Byte;
  17.     DeviceFehler: integer;      { Fehlernummer von OpenDevice }
  18.     Err         : integer;      { Fehlernummer von IO-Operationen }
  19.     DiskChangeCount : integer;
  20.     i, j        : integer;
  21.     b           : Byte;
  22.     c           : Char;
  23.     Modus       : ModeType;
  24.     Block       : integer;
  25.     st          : String[20];
  26.  
  27.  
  28. Procedure Exitus;
  29.   { Nach Programmende oder Fehler System aufräumen }
  30.   Begin
  31.     If DeviceFehler <> 0 Then CloseDevice(PTR(diskreq));
  32.   End;
  33.  
  34.  
  35. Procedure MotorOn;
  36.   Begin
  37.     diskreq^.iotd_Req.io_Length := 1;
  38.     diskreq^.iotd_Req.io_Command := TD_MOTOR;
  39.     Err := DoIO(PTR(diskreq));
  40.   End;
  41.  
  42.  
  43. Procedure MotorOff;
  44.   Begin
  45.     diskreq^.iotd_Req.io_Length := 0;
  46.     diskreq^.iotd_Req.io_Command := TD_MOTOR
  47.     Err := DoIO(PTR(diskreq));
  48.   End;
  49.  
  50.  
  51. Procedure ReadDiskBlock( nr: integer);
  52.   Begin
  53.     With diskreq^, iotd_Req Do
  54.       Begin
  55.         io_Length := TD_SECTOR;
  56.         io_Data := DiskBuffer;
  57.         io_Command := ETD_READ;
  58.         iotd_Count := DiskChangeCount;
  59.         io_Offset := TD_SECTOR*nr;
  60.       End;
  61.     Err := DoIO(PTR(diskreq));
  62.   End;
  63.  
  64.  
  65. Begin
  66.   diskport := Nil;
  67.   diskreq  := Nil;
  68.   DeviceFehler := 0;
  69.   AddExitServer(Exitus);
  70.  
  71.   diskport := CreatePort('Trackdisk-Port' ,0);
  72.   If diskport=Nil Then Error('CreatePort hat versagt.');
  73.  
  74.   diskreq := Ptr( CreateExtIO(diskport, SizeOf(IOExtTD)) );
  75.   If diskreq=Nil Then Error('CreateExtIO hat versagt.');
  76.  
  77.   DeviceFehler := OpenDevice(TD_NAME, Drive,PTR(diskreq), 0);
  78.   If DeviceFehler <> 0 Then Error('OpenDevice ging nicht.');
  79.  
  80.   DiskBuffer := Ptr(Alloc_Mem(SizeOf(Diskbuffer^), 2));
  81.  
  82.   diskreq^.iotd_Req.io_Command := TD_CHANGENUM;
  83.   Err := DoIO(PTR(diskreq));
  84.   DiskChangeCount := diskreq^.iotd_Req.io_Actual;
  85.  
  86.  
  87.   Block := 880;
  88.  
  89.  
  90.   Page;
  91.   Modus := HexDump;
  92.  
  93.   Repeat
  94.  
  95.     MotorOn;
  96.     ReadDiskBlock( Block );
  97.     MotorOff;
  98.  
  99.     GotoXY(1,1);
  100.     Write('Sektor', Block:6);
  101.  
  102.     Case Modus Of
  103.       HexDump:
  104.         Begin
  105.           For i:=0 to 15 Do
  106.             Begin
  107.               GotoXY(1, i+3);
  108.               For j:=1 to 32 Do
  109.                 Begin
  110.                   b := DiskBuffer^[32*i+j];
  111.                   Write( Hex.[b shr 4 + 1], Hex.[b And 15 + 1] )
  112.                   If (j and 3)=0 Then Write(' ');
  113.                 End;
  114.             End
  115.         End;
  116.       AsciiDump:
  117.         Begin
  118.           For i:=0 to 15 Do
  119.             Begin
  120.               GotoXY(1,i+3); Write(i:3,': ');
  121.               For j:=1 to 32 Do
  122.                 Begin
  123.                   c := Chr(DiskBuffer^[32*i+j]);
  124.                   If c in [' '..#127, #160..#255] Then
  125.                     Write(c)
  126.                   Else
  127.                     Write('_');
  128.                 End;
  129.               ClrEol;
  130.             End
  131.         End;
  132.     End;
  133.  
  134.     GotoXY(1, 20);
  135.     Write('A Asciidump   H HexDump    S Sector   Esc Exit   > ');
  136.  
  137.     Repeat
  138.       c := Upcase(ReadKey)
  139.     Until (c In ['H', 'A', 'S', #x] ) Or WindowClosed;
  140.  
  141.     Case c Of
  142.       'H': Modus := HexDump;
  143.       'A': Modus := AsciiDump;
  144.       'S': Begin
  145.              GotoXY(1,20);
  146.              Write('Nummer: '); ClrEol;
  147.              Readln(st);
  148.              While st[1]=' ' Do Delete(st,1,1);
  149.              If st <> '' Then
  150.                Begin
  151.                  Val(st,i,j);
  152.                  If (j<>0) Or (i<0) Then Writeln('Illegal Number!')
  153.                  Else
  154.                    Block := i
  155.                End;
  156.            End;
  157.     Otherwise
  158.     End;
  159.  
  160.   Until WindowClosed or (c=#x);
  161.  
  162. End.
  163.  
  164.