home *** CD-ROM | disk | FTP | other *** search
/ PC Online 1997 October / PCO1097.ISO / FilesBBS / WIN3X / MSTARTER.ARJ / COMMHELP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-02-14  |  8.4 KB  |  248 lines
  1. {----------------------------------------------------------------}
  2. { COMMUNIT   Hilfsprozeduren und Deklarationen zu COMMUNIT       }
  3. {            und V24Unit                                         }
  4. {----------------------------------------------------------------}
  5. Unit COMMHELP;
  6.  
  7. Interface {******************************************************}
  8.  
  9. uses Crt, CommCons;
  10.  
  11. Procedure AlleComs;
  12.  
  13. Function GetSIO(aComPort : word) : string;
  14. { speziell für den 16550 }
  15. Function Enabled16550(aComPort : word) : boolean;
  16. Procedure Switch16550(aComPort : word; EmptyBuffer : boolean;
  17.                       aWhat : byte);
  18.  
  19. { Zum Anzeigen der versch. Register }
  20. Procedure ShowMCR(aPort : word);
  21. Procedure ShowMSR(aPort : word);
  22. Procedure ShowLSR(aPort : word);
  23. Procedure ShowLCR(aPort : word);
  24.  
  25. { Zum Zeigen der Einstellungen }
  26. Function GetBaudStr(aBaud : BaudType) : string;
  27. Function GetParityStr(aParity : word): string;
  28. Function GetDataBitStr(aDataBits : byte): string;
  29. Function GetStopBitStr(aStopBits : byte): string;
  30. Function GetComPortStr(aPort : word): string;
  31.  
  32. Implementation {*************************************************}
  33.  
  34. { ------------------------------------------------------------- }
  35. { ALLECOMS setzt die Portadressen abh. von ComBase und MaxPorts }
  36. { ------------------------------------------------------------- }
  37. Procedure AlleComs;
  38. begin
  39.    meml[$0000:$0400] := ComBase[COM1];
  40.    meml[$0000:$0402] := ComBase[COM2];
  41.    If MaxPorts > 2 Then meml[$0000:$0404] := ComBase[COM3];
  42.    If MaxPorts > 3 Then meml[$0000:$0406] := ComBase[COM4];
  43. end;
  44.  
  45. {--------------------------------------------------------------- }
  46. { GetSIO   Welcher Schnittstellenbaustein ist installiert?       }
  47. {--------------------------------------------------------------- }
  48. Function GetSIO(aComPort : word) : string;
  49. begin
  50.   GetSIO := 'nicht gefunden';
  51.   If (Port[ComBase[aComPort]+IIR] and $30) <> 0 Then EXIT;
  52.   { Falls der 16550 aktiviert ist, würden durch das SWITCH }
  53.   { sonst die Einstellungen überschrieben                  }
  54.   If Enabled16550(aComPort) Then
  55.     begin
  56.      GetSIO := '16550A        ';
  57.      EXIT;
  58.     end;
  59.   Switch16550(aComPort, false, 1); { Puffer nicht löschen }
  60.   If Enabled16550(aComPort)
  61.      Then GetSIO := '16550A        '
  62.      Else If (Port[ComBase[aComPort]+IIR] and $80) > 0
  63.             Then GetSIO := '16550N        '
  64.             Else begin { Scratch Register da? }
  65.               Port[ComBase[aComPort]+7] := $55;
  66.               If (Port[ComBase[aComPort]+7] = $55)
  67.                 Then GetSIO := '8250A/16450   '
  68.                 Else GetSIO := '8250/8250B    ';
  69.             end;
  70. end;
  71. { -------------------------------------------------------------- }
  72. { Enabled16550   Prüft, ob der 16550 angeschalten ist            }
  73. {                Dann, wenn die Bits 6 und 7 im IIR aktiv sind   }
  74. {                und die anderen nicht (!! lesender Zugriff)     }
  75. { -------------------------------------------------------------- }
  76. Function Enabled16550(aComPort : word) : boolean;
  77. begin
  78.   Enabled16550 := (Port[ComBase[aComPort]+IIR] and $C0) = $C0;
  79. end;
  80.  
  81. { -------------------------------------------------------------- }
  82. { Switch16550    Schaltet 16550 ein oder aus.                    }
  83. {                EmptyBuffer: bei TRUE wird der Puffer           }
  84. {                             gelöscht.                          }
  85. {                aWhat = 0: FIFO aus (Kompatibilitätsmodus)      }
  86. {                aWhat = 1, 2, 8, 14 Trigger bei 1..14 Bytes     }
  87. { -------------------------------------------------------------- }
  88. { Zum Ausschalten FIFO Reset Receive und FIFO Reset Transmit     }
  89. { Bits 1 und 2 setzen und FIFO enable Bit 0 entfernen.           }
  90. { Zum Einschalten FIFO enable, Bit 0 setzen und mit den Bits     }
  91. { 6 und 7, Trigger Level die Anzahl der Bytes festlegen,         }
  92. { nach denen ein Interrupt passieren soll.                       }
  93. {  1 -->  0000 0001                                              }
  94. {  2 -->  0100 0001                                              }
  95. {  8 -->  1000 0001                                              }
  96. { 14 -->  1100 0001                                              }
  97. { -------------------------------------------------------------- }
  98. Procedure Switch16550(aComPort : word;
  99.                       EmptyBuffer : boolean;
  100.                       aWhat : byte);
  101. var IIRByte : byte;
  102. begin
  103.   IIRBYTE := 0;
  104.   case aWhat of
  105.      0 : IIRByte := $06; { Enable = Aus, FIFO-Puffer löschen     }
  106.      1 : IIRByte := $01;
  107.      2 : IIRByte := $41;
  108.      8 : IIRByte := $81;
  109.     14 : IIRByte := $C1;
  110.   end;
  111.   If EmptyBuffer Then IIRByte := IIRByte or $06;
  112.   Port[ComBase[aComPort] + IIR] := IIRByte;
  113. end;
  114.  
  115. {--------------------------------------------------------------- }
  116. { ShowMCR   zeigt das Modem Control Register                     }
  117. {--------------------------------------------------------------- }
  118. Procedure ShowMCR(aPort : word);
  119. var    i   : integer;
  120.        reg : byte;
  121. const MCRStat :  array[0..4] of string =
  122.                  ('  LP', 'OT2', '  OT1', '  RTS', '  DTR');
  123. begin
  124.   reg := Port[ComBase[aPort] + MCR];
  125.   write('                  ');
  126.   For i := 0 to 4 do
  127.     begin
  128.       if (reg and ($10 shr i)) <> 0
  129.           Then TextColor(LightRed)
  130.           Else TextColor(white);
  131.       write(MCRStat[i]+ '  ');
  132.     end;
  133.   TextColor(White);
  134. end;
  135. {--------------------------------------------------------------- }
  136. { ShowMSR   zeigt das Modem Status Register                      }
  137. {--------------------------------------------------------------- }
  138. Procedure ShowMSR(aPort : word);
  139. var    i   : integer;
  140.        reg : byte;
  141.  
  142. const MSRStat :  array[0..7] of string =
  143.       ('     CD', 'RI', 'DSR', ' CTS', 'DCD', '  DRI', ' DDSR', ' DCTS');
  144. begin
  145.   reg := Port[ComBase[aPort] + MSR];
  146.   For i := 0 to 7 do
  147.     begin
  148.       if (reg and ($80 shr i)) <> 0
  149.           Then TextColor(LightRed)
  150.           Else TextColor(White);
  151.       write(MSRStat[i]+ '  ');
  152.     end;
  153.   TextColor(White);
  154. end;
  155.  
  156. {--------------------------------------------------------------- }
  157. { ShowLSR   zeigt das Line Status Register                       }
  158. {--------------------------------------------------------------- }
  159. Procedure ShowLSR(aPort : word);
  160. var    i   : integer;
  161.        reg : byte;
  162.  
  163. const LSRStat :  array[0..7] of string =
  164.       ('Timeout', 'TE', 'THE', '  BI', ' FE', '   PE', '   OE', 'DataR');
  165. begin
  166.   reg := Port[ComBase[aPort] + LSR];
  167.   For i := 0 to 7 do
  168.     begin
  169.       if (reg and ($80 shr i)) <> 0
  170.           Then TextColor(LightRed)
  171.           Else TextColor(White);
  172.       write(LSRStat[i]+ '  ');
  173.     end;
  174.   TextColor(White);
  175. end;
  176. {--------------------------------------------------------------- }
  177. { ShowLCR   zeigt das Line Control Register                      }
  178. {--------------------------------------------------------------- }
  179. Procedure ShowLCR(aPort : word);
  180. var    i   : integer;
  181.        reg : byte;
  182.  
  183. const LCRStat :  array[0..7] of string =
  184.        ('   DLAB', 'SB', ' SP', 'XPar', 'Par', 'StopB', 'Data2',
  185.         'Data1');
  186.  
  187. begin
  188.   reg := Port[ComBase[aPort] + LCR];
  189.   For i := 0 to 7 do
  190.     begin
  191.       if (reg and ($80 shr i)) <> 0
  192.           Then TextColor(LightRed)
  193.           Else TextColor(White);
  194.       write(LCRStat[i]+ '  ');
  195.     end;
  196.   TextColor(White);
  197. end;
  198. { ----------------------------------------- }
  199. { Zum Anzeigen der aktuellen Einstellungen  }
  200. { ----------------------------------------- }
  201. Function GetBaudStr(aBaud : BaudType) : string;
  202. var s : string;
  203. begin
  204.   str(BaudTab[ord(aBaud)], s);
  205.   GetBaudStr := s;
  206. end;
  207. Function GetParityStr(aParity : word): string;
  208. var s : string;
  209. begin
  210.   s := '';
  211.   case aParity of
  212.     NoParity   : s := 'keine';
  213.     EvenParity : s := 'gerade';
  214.     OddParity  : s := 'ungerade';
  215.   end;
  216.   GetParityStr := s;
  217. end;
  218. Function GetDataBitStr(aDataBits : byte): string;
  219. var s : string;
  220. begin
  221.   s := '';
  222.   case aDataBits of
  223.     DataBit5 : s := '5';
  224.     DataBit6 : s := '6';
  225.     DataBit7 : s := '7';
  226.     DataBit8 : s := '8';
  227.   end;
  228.   GetDataBitStr := s;
  229. end;
  230. Function GetStopBitStr(aStopBits : byte): string;
  231. var s : string;
  232. begin
  233.   s := '';
  234.   case aStopBits of
  235.     StopBit1 : s := '1';
  236.     StopBit2 : s := '2';
  237.   end;
  238.   GetStopBitStr := s;
  239. end;
  240.  
  241. Function GetComPortStr(aPort : word): string;
  242. begin
  243.    If (aPort >= COM1) and (aPort <= COM4)
  244.      Then GetComportStr := PortString[aPort]
  245.      Else GetComportStr := 'unzulässig';
  246. end;
  247. END.
  248.