2000
Subj : Ребят вы чего.
To   : Roman Onufryk
From : Denis Yandukin
Date : Thu Aug 03 2000 11:06 am

Как поживаете, Roman ?

 В Среда Август 02 2000 20:29, Roman Onufryk писал Maxim Lihov:

 RO>  You must write in English!
Yes. 
 RO>  Да гоню, гоню я. :)
 RO>  Так что, так и будем писать: "И я, и я!"?
 RO>  Давайте делом займемся.
 RO>  Кто готов мне дать урок по работе с модемами в Паскале?
 RO>  Только действительно работающий!
 RO>  Я пробую определять порт, как файл (то есть assign).
 RO>  ПисАть в него получается, модем инициализируется, набирает номер и
 RO> т.п. А вот как с него прочитать? Read, ReadLn выдают ошибку.
─── Тут начинается файл SERIAL.PAS ───
{$D-}
(*
 Модуль для работы с последовательными портами (СОМ1-СОМ4)
 Гадяцкий Глеб Александрович (с) Курган КМИ 1994
 FIDO 2:5012/1.125 Gadiacki Gleb

 Внимание ! Вся работа с портами осуществляется на уровне портов
 ввода/вывода. Поэтому этой библиотекой ничего не стоит нарушить
 работу FOSSIL-драйвера, драйвера мыши и пр., перепрограммировав
 последовательный порт на свой лад.

 При создании модуля использовалась литература

 Р. Джордейн "Справочник программиста IBM PC, XT и AT"

 "Программирование модемов" том 4 из серии "Библиотечка системного
 программиста", ДИАЛОГ-МИФИ

*)
unit serial;
interface
type address=record {это для работы с прерываниями}
      seg,ofs:word;
     end;
type
 tserport=record
          basadr:word;
          highspeed,lovspeed:byte;(*старший и младший делитель скорости*)
          {скорость работы порта будет равна 15200/(highspeed*256+lovspeed)
          бодд}
          lengword:byte;(*длинна данных*)
          {допустимые значения 5,6,7,8}
          pariti:boolean;(*включение контроля по четности*)
          {если True - при передаче к каждому байту будет добавлен
          бит четности, по которому при приеме будет осуществялтся контроль
          на ошибки. Способ снижает общую скорость и не шибко надежен}
          stusk_pariti:boolean;(*уровень , по которому ведется контроль*)
          {True - по четности, False - по нечетности}
          stopbit:byte;(*количество стоповых бит*)
          {допустимые знаяения 1,2}
          statline:byte;(*регистр состояния линии*)
          modemline:byte;(*регистр сигналов от модема*)
          modemsyg:byte;(*регистр сигналов модему*)
          {пардон за кривой язык}
          interput:address;
          elev:byte;
          numInt:byte;{номер прерывания}
 end;
var ErrorCode:word;
(* коды ошибок
 1 -неправильный операнд в команде
*)
const     U8250  =0;
          U16450 =1;
          U16550 =2;
          U16550A=3;
          {это типы микросхем при тестировании}
function  GetTypeUART(basadr:word):byte;
          (*возвращает тип микросхемы-контроллера асинхронного канала*)
function  GetSerAdr(n:byte):word;
          (*возвращает базовый адрес асинхонного канала
            используя область данных BIOS*)
function  GetASCIIStr(var ser:Tserport):string;
          (*получить строку по последовательному каналу
            протокол обмена - ASCII
            первый байт - длинна
          *)
procedure SendASCIIStr(str:string;var ser:TserPort);
          (*послать строку по последовательному каналу
           протокол обмена - ASCII
           первый байт - длинна
          *)
procedure ClearBreak(var ser:TserPort);
          (*сбросить сигнал Break*)
procedure SendBreak(var ser:TserPort);
          (*послать сигнал Break на линию*)
          {с сигналом Break есть такие тонкости - он будет на линии, пока
          его не сброят и пока сигнал не сброше передавать по линии что-то
          не рекомендую}
function  TimeOutAktive(var ser:Tserport):boolean;
          (*обнаружен тайм-аут на линии*)
function  BreakAktive(var ser:Tserport):boolean;
          (*обнаружен сигнал Break на линии*)
function  ErrorAktive(var ser:Tserport):boolean;
          (*обнаружена ошибка на линии*)
function  TransReady(var ser:Tserport):boolean;
          (*передатчик готов к передаче следующего байта*)
function  DataReady(var ser:Tserport):boolean;
          (*данные получены, надо читать*)
function  getPredStatPort(ser:Tserport):byte;
          (*вернуть состояние линии предыдущего обращения*)
function  getStatPort(var ser:Tserport):byte;
          (*возвращаем статус линии*)
          {описание регистра статуса см. в соответсвующе литературе.
          из него данный модуль обрабатывае биты готовности передатчика,
          индикатора принятого байта, индикатора Break и тайм-аута}
procedure closeEleven(ser:TserPort);
          (*завершает прерывание*)
function  getEleven(ser:Tserport):byte;
          (*сообщает причину прерывания*)
          {описание см. в соотвевующей литературе}
procedure NewPort(badr:word;var ser:TserPort);
          (*начальная подготовка порта*)
          {передайте базовы адрес порта}
procedure setspeed(var ser:TserPort;speed:longint);
          (*установка скорости обмена*)
procedure SetParams(var ser:Tserport;leng,strob:byte;
                    pariti,stat:boolean);
          (*установка параметров работы последовательного порта*)
procedure CloseInterput(var ser:Tserport);
          (*закрытие прерывания от последовательного порта*)
procedure InicInterput(var ser:Tserport;work:address;
                       numInter:byte;eleven:byte);
          (*установка прерывания от последовательного порта*)
procedure inicport(var ser:Tserport);
          (*инициализация последовательного порта*)
procedure sendsym(sym:byte;ser:Tserport);
          (*получение байта*)
function  getsym(ser:Tserport):byte;
          (*посылка байта*)
procedure setDTR(var ser:Tserport);
          (*установить сигнал DTR*)
procedure clearDTR(var ser:Tserport);
          (*сбросить сигнал DTR*)
procedure setRTS(var ser:Tserport);
          (*установить сигнал RTS*)
procedure clearRTS(var ser:Tserport);
          (*сбросить сигнал RTS*)
function  getDTR(ser:Tserport):boolean;
          (*получить статус линии DTR*)
function  getRTS(ser:Tserport):boolean;
          (*получить статус линии RTS*)
function  getCTS(var time:boolean;var ser:Tserport):boolean;
          (*получить статус линии CTS*)
function  getDSR(var time:boolean;var ser:Tserport):boolean;
          (*получить статус линии DSR*)
function  getRI(var time:boolean;var ser:Tserport):boolean;
          (*получить статус линии RI*)
function  getDCD(var time:boolean;var ser:Tserport):boolean;
          (*получить статус линии DCD*)
function  GetModemLines(var ser:Tserport):byte;
          (*получить статус линий сигналов от модема*)
function  GetPredML(ser:Tserport):byte;
          (*получить предыдущий статус линий сигналов от модема*)
          {при вызове любой функции получения статуса происходит
           чтение статуса из регистра статуса сигналов модема
           (описание регистра см. в документации по UART)
           прочитаное значение запоминается в переменной, данная
           функция возвращает эту переменную}
implementation
uses dos;
function  GetTypeUART(basadr:word):byte;
var tmp1,tmp2,tip:byte;
begin
 tip:=0;
 tmp1:=port[basadr+7];
 port[basadr+7]:=0;
 if port[basadr+7]=0 then
  begin
   port[basadr+7]:=$96;
   if port[basadr+7]=$96 then
    begin
     tip:=1;
     tmp2:=port[basadr+1];
     port[basadr+2]:=1;
     if port[basadr+1] and 128 > 0 then
      begin
       tip:=2;
       if port[basadr+1] and 64 >0 then
        tip:=3;
      end;
     port[basadr+1]:=tmp2;
    end;
  end;
 port[basadr+7]:=tmp1;
 gettypeuart:=tip;
end;
function  GetSerAdr(n:byte):word;
begin
 if (n>0) and (n<5) then
  getseradr:=memw[$40:word((n-1)*2)]
 else
  begin
   getseradr:=0;
   errorcode:=1;
  end;
end;
function  GetASCIIStr(var ser:Tserport):string;
var c:byte;
    str:string;
begin
str[0]:=char(getsym(ser));
for c:=1 to byte(str[0]) do
 str[c]:=char(getsym(ser));
getasciistr:=str;
end;
procedure SendASCIIStr(str:string;var ser:TserPort);
var c:byte;
begin
 for c:=0 to length(str) do
  sendsym(byte(str[c]),ser);
end;
procedure SendBreak(var ser:TserPort);
begin

1a75
 port[ser.basadr+3]:=port[ser.basadr+3] or 64;
end;
procedure ClearBreak(var ser:TserPort);
begin
 port[ser.basadr+3]:=port[ser.basadr+3] and not(64);
end;
function  TimeOutAktive(var ser:Tserport):boolean;
begin
 ser.statLine:=port[ser.basadr+5];
 TimeOutAktive:=(ser.statline and 128 <> 0 );
end;
function  BreakAktive(var ser:Tserport):boolean;
begin
 ser.statLine:=port[ser.basadr+5];
 BreakAktive:=(ser.statline and 16 <> 0 );
end;
function  ErrorAktive(var ser:Tserport):boolean;
begin
 ser.statLine:=port[ser.basadr+5];
 Erroraktive:=(ser.statline and (2+4+8) <> 0 );
end;
function  TransReady(var ser:Tserport):boolean;
begin
 ser.statLine:=port[ser.basadr+5];
 TransReady:=(ser.statline and 64 <> 0 );
end;
function  DataReady(var ser:Tserport):boolean;
begin
 ser.statLine:=port[ser.basadr+5];
 DataReady:=(ser.statline and 1 =1  );
end;
function  getPredStatPort(ser:Tserport):byte;
begin
 getPredStatPort:=ser.statline;
end;
function  getStatPort(var ser:Tserport):byte;
begin
 ser.statline:=port[ser.basadr+5];
 getstatport:=ser.statline;
end;
procedure closeEleven(ser:TserPort);
var tmp:byte;
begin
 asm
  mov  al,20h
  out  20h,al
 end;
end;
function  getEleven(ser:Tserport):byte;
begin
 getEleven:=port[ser.basadr+2];
end;
procedure CloseInterput(var ser:Tserport);
begin
 ser.modemline:=ser.modemline and 15;
 ser.numint:=0;
 ser.elev:=0;
 port[ser.basadr+4]:=ser.modemline;
end;
procedure GetPointInt(numInt:byte;var adr:pointer);
           (*получить адрес вектора прерывания*)
var r:registers;
begin
 r.ah:=$35;
 r.al:=numInt;
 Intr($21,r);
 adr:=ptr(r.es,r.bx);
end;
procedure SetPointInt(numInt:byte;var adr:address);
           (*установить адрес вектора прерывания*)
var r:registers;
begin
 r.ah:=$25;
 r.al:=numInt;
 r.ds:=adr.seg;
 r.dx:=adr.ofs;
 Intr($21,r);
end;
procedure  NewPort(badr:word;var ser:TserPort);
begin
 ser.elev:=0;
 ser.basadr:=badr;
 ser.modemline:=0;
 ser.modemsyg:=0;
end;
procedure setspeed(var ser:TSerPort;speed:longint);
var w:word;
begin
if (speed>=2) and (speed<=115200) then
 with ser do
  begin
   w:=115200 div speed;
   if 11520 mod speed <>0 then
    ErrorCode:=2;
   highspeed:=w div 256;
   lovspeed:= w mod 256;
   ErrorCode:=0;
  end
else
 ErrorCode:=2;
end;
procedure SetParams(var ser:Tserport;leng,strob:byte;
                    pariti,stat:boolean);
begin
  ser.lengword:=leng;
  ser.pariti:=pariti;
  ser.stusk_pariti:=stat;
  ser.stopbit:=strob;
end;
procedure InicInterput(var ser:Tserport;work:address;
                       numInter:byte;eleven:byte);
begin
 ser.interput:=work;
 ser.elev:=eleven;
 ser.numInt:=numInter;
end;
function  GetModemLines(var ser:Tserport):byte;
begin
 ser.modemline:=port[ser.basadr+6];
 GetModemLines:=ser.modemline;
end;
function  GetPredML(ser:Tserport):byte;
begin
 GetPredML:=ser.modemline;
end;
function  getDTR(ser:Tserport):boolean;
begin
 getDTR:=ser.modemline and 1 > 0;
end;
function  getRTS(ser:Tserport):boolean;
begin
 getRTS:=ser.modemline and 2 > 0;
end;
function  getCTS(var time:boolean;var ser:Tserport):boolean;
begin
 with ser do
  begin
   modemsyg:=port[basadr+6];
   if modemsyg and 16 > 0 then
    getCTS:=true
   else
    getCTS:=false;

   if modemsyg and 1 > 0 then
    time:=true
   else
    time:=false;
   end;
end;
function  getDSR(var time:boolean;var ser:Tserport):boolean;
begin
 with ser do
  begin
   modemsyg:=port[basadr+6];
   if modemsyg and 32 > 0 then
    getDSR:=true
   else
    getDSR:=false;

   if modemsyg and 2 > 0 then
    time:=true
   else
    time:=false;
   end;
end;
function  getRI(var time:boolean;var ser:Tserport):boolean;
begin
 with ser do
  begin
   modemsyg:=port[basadr+6];
   if modemsyg and 64 > 0 then
    getRI:=true
   else
    getRI:=false;

   if modemsyg and 4 > 0 then
    time:=true
   else
    time:=false;
   end;
end;
function  getDCD(var time:boolean;var ser:Tserport):boolean;
begin
 with ser do
  begin
   modemsyg:=port[basadr+6];
   if modemsyg and 128 > 0 then
    getDCD:=true
   else
    getDCD:=false;

   if modemsyg and 8 > 0 then
    time:=true
   else
    time:=false;
   end;
end;
procedure setDTR(var ser:Tserport);
begin
ser.modemline:=(ser.modemline div 2)*2 + 1;
port[ser.basadr+4]:=ser.modemline;
end;
procedure clearDTR(var ser:Tserport);
begin
ser.modemline:=(ser.modemline div 2)*2;
port[ser.basadr+4]:=ser.modemline;
end;
procedure setRTS(var ser:Tserport);
begin
ser.modemline:=(ser.modemline div 4)*4 + ser.modemline mod 2 + 2;
port[ser.basadr+4]:=ser.modemline;
end;
procedure clearRTS(var ser:Tserport);
begin
ser.modemline:=(ser.modemline div 4)*4 + ser.modemline mod 2;
port[ser.basadr+4]:=ser.modemline;
end;
procedure sendsym(sym:byte;ser:Tserport);
begin
while port[ser.basadr+5]<32 do ;;
port[ser.basadr]:=sym;
end;
function  getsym(ser:Tserport):byte;
begin
while not(odd(port[ser.basadr+5])) do ;;
getsym:=port[ser.basadr];
end;
procedure InicPort(var ser:Tserport);
var data:byte;
begin
 with ser do
  begin
   ErrorCode:=0;

   data:=port[basadr];
   port[basadr+4]:=0;
   data:=port[basadr+6];

   (*включаем режим установки параметров*)
   data:=port[basadr+3];
   port[basadr+3]:=$80;
   (*установка делителя скорости*)
   port[basadr]:=lovspeed;
   port[basadr+1]:=highspeed;
   (*установка длины данных*)

   case lengword of
    5 :data:=0;
    6 :data:=1;
    7 :data:=2;
   else
    begin
     data:=3;
     if lengword<>8 then
      ErrorCode:=1;(*ошибка в описании параметров*)
    end;
   (*сброс регистра упарвления прерываниями*)
   port[basadr+1]:=0;
   (*выбор контроля по четности*)
   if pariti then
    if stusk_pariti then
     data:=data or 8 or 16
    else
     data:=data or 8;
    end;
    (*установка кол-ва стоповых бит*)
   if stopbit=2 then
    data:=data or 4;
   (*заносим параметры в регистр*)
    port[basadr+3]:=data;
    if elev<>0 then
     (*инициализируем прерывания*)
     begin
      write('ok');
      port[basadr+1]:=elev;(*причина прерываний*)
      modemline:=modemline or 8;
      port[basadr+4]:=modemline;
      while port[basadr+2]<>1 do ;;(*очистка регистра прерываний*)
      setPointInt(numInt,interput);(*устанавливаем вектор прерывания*)
      asm
       cli
       sub al,al
       out 21h,al
       mov al,20h
       out 20h,al
      end;
       port[basadr]:=0;
      asm
       sti
      end;
     end;
end;
end;
begin
end.
─── А здесь SERIAL.PAS кончается ───


                C уважением, Denis Yandukin.
--- рвать здесь
 * Origin: Hа судьбу, дураков и женщин не обижаются. (2:5066/18.9)

.

0