PC Online 1997 October/PCO1097.ISO/FilesBBS/WIN3X/MSTARTER.ARJ/COMMUNIT.PAS

Pascal/Delphi Source File | 1995-02-14 | 15.0 KB | 423 lines

{----------------------------------------------------------------}
{ COMMUNIT   interruptgesteuerte V24-Kommunikation               }
{            (c) 1994 Peter Zwosta                               }
{----------------------------------------------------------------}
Unit CommUnit;
{$S-}

INTERFACE { -----------------------------------------------------}

uses Crt, Dos, CommCons, CommHelp;

const

  isComIntSet         : boolean = false;  { Handler gesetzt ?    }
  Test_Modem_and_Port : boolean = true;   { vgl. InitComPort     }
  FIFO_Automatic      : boolean = true;   { autmat. FIFO-Support }

  { Resultwerte für InitComPort  (Test_Modem_and_Port = true     }
  InitOK    = $0000;
  NoModem   = $0001;
  NoPort    = $0002;
  InitError = $0004;


{ Serielle Routinen }
Function InitComPort(aPort     : word;
                     Baud      : BaudType;
                     DataBits  : byte;
                     StopBits  : byte;
                     Parity    : byte;
                     HandShake : word) : word; { vgl. Resultwerte  }
Procedure CloseComPort;
Function  V24ReadCh : char;
Procedure V24TimedReadCh(var ch : char; var isTimeOut : boolean);
Function  V24WriteCh(ch : char) : boolean;  { liefert TRUE,         }
                                           { wenn erfolgreich      }
Function V24WriteStr(s : string) : boolean;
Function V24WriteCommand(s : string) : boolean;

Procedure Set_DTR_RTS;
Procedure ClearBuffer;

{ Erlaubt und verhindert externe Hardw.Interrupts }
Procedure EnableInts;
Procedure DisableInts;

{ Installieren und Entfernen des Interrupt-Vectors }
Procedure SetInt;
Procedure ResetInt;

IMPLEMENTATION { ------------------------------------------------}

const

  BufSize    = 9192;  { Größe des Puffers  (InputBuffer)         }

  WaitCh    =  '~';
  Attention =  '^';
  Enter     =  'M';

var HandshakeType : word;
    OldIntVector  : pointer;
    OldExitProc   : pointer;
    ComPort       : word;
    InputBuffer   : array[1..BufSize] of char;
    StartInBuf,
    EndInBuf          : integer;

{ ------------------------------------------------------------- }
{ NOMODEMFOUND true, wenn nach dem Initialisieren alle Bits des }
{              Modemstatusregisters 0 sind.                     }
{ ------------------------------------------------------------- }
Function NoModemFound : boolean;
begin
  NoModemFound := ((Port[ComBase[ComPort] + MSR] and $FF) = 0);
end;
{ ------------------------------------------------------------- }
{ NOPORTFOUND true, wenn nach dem Initialisieren eins der       }
{             Deltas > 0 ist.                                   }
{ ------------------------------------------------------------- }
Function NoPortFound : boolean;
begin
  NoPortFound := ((Port[ComBase[ComPort] + MSR]  and $0F) > 0);
end;
{ ------------------------------------------------------------- }
{ ENABLEINTS, DISABLEINTS                                       }
{ ------------------------------------------------------------- }
Procedure EnableInts;
begin
  asm
    STI
  end;
end;
Procedure DisableInts;
begin
  asm
    CLI
  end;
end;
{ ------------------------------------------------------------- }
{ INITCOMPORT Zum Installieren des ComPorts. Hierzu sind die    }
{             Konstanten, die im Zusammenhang mit dem LSR       }
{             definiert wurden zu verwenden.                    }
{ ------------------------------------------------------------- }
Function InitComPort(aPort     : word;
                     Baud      : BaudType;
                     DataBits  : byte;
                     StopBits  : byte;
                     Parity    : byte;
                     HandShake : word) : word;

var reg     : byte;
    divisor : word;
    Speed   : longint;
begin
  StartInBuf  := 1;               { Anfang der Chars in CHBuffer }
  EndInBuf    := 1;   { Eins größer als die Position des letzten }
                      { Chars in ChBuffer                        }
  HandShakeType := HandShake;     { Merken, was für ein Handsh.  }

  ComPort       := aPort;
  Speed         := BaudTab[ord(Baud)];

  { Geschwindigkeit setzen }
  reg := Port[ComBase[aPort] + LCR] or DLAB;
  Port[ComBase[aPort] + LCR] := reg;          { DLAB setzen      }
  divisor := round(115200/Speed);
  Port[ComBase[aPort] + DLL] := lo(divisor);
  Port[ComBase[aPort] + DLH] := hi(divisor);
  Port[ComBase[aPort] + LCR] := reg xor DLAB; { DLAB zurücksetzen}

  { Leitungssteuerregister setzen }
  reg := DataBits or Stopbits or Parity;
  Port[ComBase[aPort] + LCR] := reg;

  If FIFO_Automatic Then
    begin
      if Pos('16550', GetSIO(aPort)) > 0 Then
        Switch16550(aPort, true, 8);
    end;

  SetInt;          { PIC-Register setzen und Int-Vektor setzen }

  InitComport := InitOK;
  If Test_Modem_and_Port Then
    begin
      If NoModemFound
        Then InitComport := NoModem
        Else If NoPortFound Then InitComport := NoPort;
    end;
end;

Procedure CloseComport;
begin
  ResetInt;
end;
{ -------------------------------------------------------------- }
{ V24ReadCh liest ein Zeichen aus dem InputBuffer, wenn eins     }
{          da ist.                                               }
{ -------------------------------------------------------------- }
Function V24ReadCh : char;
begin
  V24ReadCh := #0;
  If StartInBuf <> EndInBuf then
    begin
      DisableInts;
      V24ReadCh  := InputBuffer[StartInBuf];
      StartInBuf := (StartInBuf mod BufSize) + 1;
      EnableInts;
    end;
end;
{ -------------------------------------------------------------- }
{ V24TimedReadCh liest ein Zeichen aus dem InputBuffer. Liefert  }
{                isTimeOut = false zurück, wenn nach einer best. }
{                Zeit kein Zeichen gelesen werden konnte.        }
{ -------------------------------------------------------------- }
Procedure V24TimedReadCh(var ch : char; var isTimeOut : boolean);
var TimeCount : word;

begin
  TimeCount := 65535;
  ch      := #0;
  Repeat
    DisableInts;
    isTimeout := (StartInBuf = EndInBuf);
    EnableInts;
    dec(TimeCount);
  until (TimeCount = 0) or (isTimeOut = false);
  If (not isTimeOut) Then
    begin
      DisableInts;
      ch := InputBuffer[StartInBuf];
      StartInBuf := (StartInBuf mod BufSize) + 1;
      EnableInts;
    end;
end;
{ -------------------------------------------------------------- }
{ V24WriteCh  schreibt ein Zeichen in das TH-Register            }
{ -------------------------------------------------------------- }
Function V24WriteCh(ch : char) : boolean;
var TimeCount : word;
begin
  V24WriteCh  := false;
  TimeCount   := 65535;
  { DTR und CTS setzen                                           }
  If (HandshakeType and RTS_CTS) > 0 Then
    begin
       Set_DTR_RTS;                 { Wir sind fertig zum Senden }
       { Auf Clear To send warten }
       While ((Port[ComBase[ComPort] + MSR] and CTS) = 0) and
              (TimeCount > 0) do dec(TimeCount);
       if TimeCount > 0 Then TimeCount := 65535;
    end;
  { Warten bis der Transmitter (THR) leer ist                    }
  While ((Port[ComBase[ComPort] + LSR] and THREmpty) = 0) and
        (TimeCount > 0) do dec(TimeCount);
  If TimeCount > 0 Then
    begin
     Port[ComBase[ComPort] + THR] := ord(ch);  { Zeichen ausgeben }
     V24WriteCh := true;
    end;
end;
{ -------------------------------------------------------------- }
{ V24WriteStr  schreibt einen ganzen String ins TH-Register.     }
{ -------------------------------------------------------------- }
Function V24WriteStr(s : string) : boolean;
var i   : integer;
    OK  : boolean;
begin
  OK := true;
  For i := 1 to length(s) do
    begin
      OK := V24WriteCh(s[i]);
      If not OK then Break;
    end;
  V24WriteStr := OK;
end;
{ -------------------------------------------------------------- }
{ V24WriteCommand  schreibt einen String ins THR, ermöglicht     }
{                  zusätzlich die Definition von Sonderzeichen,  }
{                  die z.B. im Init-String für das Modem ver-    }
{                  wendet werden können.                         }
{ -------------------------------------------------------------- }
Function V24WriteCommand(s : string) : boolean;
var OK : boolean;
    i  : integer;
begin
  OK := true;
  i := 0;
  While i < length(s) do
    begin
      inc(i);
      case s[i] of
        WaitCh      : begin
                        delay(500);
                        continue;
                      end;
        Attention   :
            begin
              if (i+1) <= length(s) Then
                If s[i+1] = Enter Then
                  begin
                    inc(i);
                    s[i] := #13;
                  end;
            end;
      end;
      OK := V24WriteCh(s[i]);
      If not OK then Break;
    end;
  V24WriteCommand := OK;
end;

{ -------------------------------------------------------------- }
{ Set_DTR_RTS Modem-Control-Register mitteilen, daß das Prog.    }
{             fertig zum Senden ist.                             }
{             DTR : Data Terminal Ready                          }
{             RTS : Request to send                              }
{ -------------------------------------------------------------- }
Procedure Set_DTR_RTS;
var reg : byte;
begin
  reg := Port[ComBase[ComPort] + MCR] or DTR or RTS;
  Port[ComBase[ComPort] + MCR] := reg;
end;

{ -------------------------------------------------------------- }
{ CLEARBUFFER    setzt den InputBuffer auf 0                     }
{ -------------------------------------------------------------- }
Procedure ClearBuffer;
begin
  StartInBuf := EndInBuf;
end;
{ -------------------------------------------------------------- }
{ NEWINTHANDLER ersetzt den alten Interrupt-Handler und nimmt    }
{               bei einem Interrupt die Zeichen aus dem RHR      }
{               und schreibt sie in den InputBuffer              }
{ -------------------------------------------------------------- }
{$F+}
Procedure NewIntHandler; Interrupt;
begin
  DisableInts;
  { Zeichen einlesen, wenn Ereignis = DataReady                  }
  { Ist eigentlich nicht notwenig, wenn im IER nur Ereignisse    }
  { vom Typ DataReady zugelassen wurden.                         }

  { Das while .. ist für den FIFO notwendig, da hier auf einmal  }
  { mehrere Bits abgeholt werden können.                         }
  { Ist der FIFO nicht aktiv, dann schadet das while auch nicht. }
  While (Port[ComBase[ComPort] + IIR] and IIR_DRMask)
                         = IIR_DataReady do
    begin
      InputBuffer[EndInBuf] := chr(Port[ComBase[ComPort] + RHR]);
      { EndBuf neu setzen. Erhöhen oder wieder 1 setzen.         }
      EndInBuf := (EndInbuf mod BufSize) + 1;
    end;
  Port[PIC_ICR] := EOI;  { Der PIC kann jetzt den nächsten       }
                         { IRQ bearbeiten                        }
  EnableInts;
end;
{$F-}

{ -------------------------------------------------------------- }
{ SETINT setzt im MCR das Bit OT2, damit überhaupt IRQ's erzeugt }
{        legt im IER fest, bei welchen Ereignissen ein IRQ er-   }
{                    zeugt werden soll.                          }
{        holt den alten Interrupt-Vector und setzt den neuen     }
{                    (NewIntHandler)                             }
{        setzt das dem IRQ entsprechende Bit im PIC_IMR auf 0,   }
{                    damit der PIC den Interrupt weitergibt.     }
{        setzt im MCR, die Bits DTR und RTS                      }
{ -------------------------------------------------------------- }
Procedure SetInt;
var reg : byte;
begin
  DisableInts; { verhindern, daß andere Ints dazwischen kommen   }

  { Alten Interrupt-Vector holen und neuen Int-Handler setzen    }
  { Die Nummer des Interrupts steht in ComInt[] und ergibt sich  }
  { aus IRQ + 8.                                                 }
  If not isComIntSet Then
      GetIntVec(ComInt[ComPort], OldIntVector);
  SetIntVec(ComInt[ComPort], @NewIntHandler);

  { ModemControl-Register mitteilen, daß Interrupts gesendet     }
  { werden können                                                }
  reg := Port[ComBase[ComPort] + MCR] or OT2;
  Port[ComBase[ComPort] + MCR] := reg;

  { Im Interrupt-Enable Register (IER) festlegen, bei welchem    }
  { Ereignis ein Interrupt ausgeführt werden soll.               }
  { Hier nur wenn Daten in RHR bereitstehen                      }
  Port[ComBase[ComPort] + IER] := IER_RHR;

  { Register im PIC setzen                                       }
  { Im Interrupt-Mask-Register das Bit, das dem IRQ entspricht   }
  { 0 setzen, damit der PIC die IRQ's weiterleitet.              }
  reg :=  byte(not (1 shl ComIRQ[ComPort])); { IRQ3: 1111 0111   }
  Port[PIC_IMR] := Port[PIC_IMR] and reg;
  { Set_DTR_RTS; }        { Wir sind fertig zum Senden           }
  EnableInts;             { Jetzt können Ints ausgeführt werden. }

  isComIntSet := true;
end;

{ -------------------------------------------------------------- }
{ RESETINT  macht die in SETINT durchgeführten Einstellungen     }
{           wieder rückgängig.                                   }
{ -------------------------------------------------------------- }
Procedure ResetInt;
var reg : byte;
begin
  If not isComIntSet Then EXIT;

  { FIFO ausschalten }
  If FIFO_Automatic and Enabled16550(ComPort)
    then Switch16550(ComPort, true, 0);

  DisableInts;

  { Im Modem-Control-Register DTR (Data Terminal Ready) und      }
  { RTS (Request to send) ausschalten                            }
  reg := byte(not (DTR or RTS));                     { 1111 1100 }
  Port[ComBase[ComPort] + MCR] :=
             Port[ComBase[ComPort] + MCR] and reg;

  { dem IRQ entsprechendes Bit im PIC_IMR maskieren (1 setzen)   }
  reg := (1 shl ComIRQ[ComPort]);       { z.B. IRQ4: 0001 0000   }
  Port[PIC_IMR] := Port[PIC_IMR] or reg;

  { Im Modem-Control Register verhindern, daß Interrupts         }
  { gesendet werden.                                             }
  reg :=  byte(not OT2);                             { 1111 0111 }
  Port[ComBase[ComPort] + MCR] :=
             Port[ComBase[ComPort] + MCR] and reg;

  { Im Interrupt-Enable Register alle Ereignisse disablen        }
  Port[ComBase[ComPort] + IER] := 0;
  { alten InterruptVector wieder setzen                          }
  SetIntVec(ComInt[ComPort], OldIntVector);
  EnableInts;
  isComIntSet := false;
end;

{ -------------------------------------------------------------- }
{ COMMEXITPROC  Sollte das Programm aus irgendeinem Grund        }
{               abstürzen, wird hier schnell noch RESETINT       }
{               ausgeführt.                                      }
{ -------------------------------------------------------------- }
{$F+}
Procedure CommExitProc;
begin
  ExitProc := OldExitProc;
  If isComIntSet Then ResetInt;
end;
{$F-}

BEGIN
  OldExitProc   := ExitProc;
  ExitProc      := @CommExitProc;

  OldIntVector  := nil;
END.