C!T ROM 2/ctrom_ii_b.zip/ctrom_ii_b/PROGRAM/PASCAL/PARADIS1/COMSTUFF.PAS

Pascal/Delphi Source File | 1992-02-26 | 12KB | 490 lines

(7448)  Fri 21 Feb 92 19:18
By: Steve Sparks
To: Ed Briggs
Re: A unit
St:
---------------------------------------------------------------------------
@EID:9d72 18559a40
unit modemio;  {(c) Copyright Steven S. Sparks 1992.}

{ If you would like Xmodem and Timer routines NETMAIL Steve Sparks at 382/104

This unit was developed for anyone needing simple communications.
You can use this to develop communications programs from bulletin boards
to terminal programs.

Hopefully this is one of the least complicated MODEMIO units you will ever
use. The reason behind this is that all the complicated IO - buffering,
IRQ,INT and other problems are left to a Fossil driver.

This UNIT REQUIRES X00.SYS to operate properly. When you compile this UNIT you
must have from the X00_???.ZIP a copy of BYPASS.OBJ. This will allow the
extended communications of X00.SYS to be used.

If you do not have BYPASS.OBJ then you can delete the include of
BYPASS.OBJ, delete the BYPASS function and change all the BYPASS refrences to
INTER($14,regs).

HOWEVER THE USE OF BYPASS WILL ALLOW COM3,COM4 AND IRQ2 AND IRQ5 support!

If you use BYPASS you may notice some after effects of the fossil in memory
once the communications program is executed. This can be resolved by re-booting
your machine. The effect is only there onec the fossil has been active.

I have yet to figure out this problem/bug..is it my routines or the fossil.

These routines are COPYRIGHT Steven S. Sparks 1992. However anyone can use then
for anything. If you sell a product that contains any part of this unit you
must include a notation to the effect. No money or fee is required.


}

interface

uses crt;

var
 local:boolean;

{ Local is a variable used to help determine if there is a carrier. You are
required to pass this variable to the CD routine.

if cd(local,comport) then writeln('Connected!');

If you set local:=true then CD is true, else if local:=false then CD is the
actual value of the CD bit. This is very helpful when testing a routine.

You should program your routines to prevent output
to the serial port but to the screen if local is true. This is helpful
when testing your program

}

procedure flowcontrol(comport:integer); {Xon/Xoff Turn off for file xfers}
procedure flowoff(comport:integer);
procedure watchdogon(comport:integer);  {Reboot PC if lost CD}
procedure watchdogoff(comport:integer);
procedure purgeinput(comport:integer);  {Purge buffers}
procedure purgeoutput(comport:integer);
procedure hangup(comport:integer);      {Lower then raise DTR}
procedure initmodem(com:integer; baud:char); {Set baud...examine reoutine}
procedure sendc(com: integer; c:char);
procedure sendxc(com:integer; c:char);
procedure getc(com:integer; var c:char);
procedure getxc(com:integer; var c:integer);
procedure startcom(com:integer);             {RUN THIS FIRST TO START FOSSIL}
procedure stopcom(com:integer);              {THIS TURNS THE FOSSIL OFF!!!}

{procedure bypass; far; external;  - This is not needed outside of modemio }

function cd(var local:boolean; port:integer) : boolean;
function ring(comport:integer) : boolean;

implementation

{$L bypass.obj}

procedure bypass; far; external;

procedure flowcontrol(comport:integer);

          begin
            comport:=comport-1;
           asm
             mov dx,comport
             mov al,$ff
             mov ah,$0f
           end;
              bypass;
         end;

procedure flowoff(comport:integer);
          begin
           comport:=comport-1;
           asm
            mov dx,comport
            mov ah,$0f
            mov al,$00
          end;
           bypass;
         end;

procedure watchdogon(comport:integer);

          begin
            comport:=comport-1;
           asm
             mov dx,comport
             mov al,$01
             mov ah,$14
           end;
              bypass;
         end;

procedure watchdogoff(comport:integer);

          begin
            comport:=comport-1;
           asm
             mov dx,comport
             mov al,$00
             mov ah,$14
           end;
              bypass;
         end;


procedure flush(comport:integer);

          begin
            comport:=comport-1;
            asm
             mov dx,comport
             mov ah,$08
            end;
            bypass;
         end;

procedure purgeoutput(comport:integer);
          begin
            comport:=comport-1;
            asm
             mov dx,comport
             mov ah,09
           end;
           bypass;
          end;

procedure purgeinput(comport:integer);
          begin
           comport:=comport-1;
           asm
            mov dx,comport
            mov ah,$0A
           end;
           bypass;
          end;




{ Initlize com comport.  }
procedure initmodem(com:integer; baud:char);
          var
           b    : integer;
           rate : byte;

          begin

          case baud of
               '1': b:=$43; {300n}
               '2': b:=$83; {1200n}
               '3': b:=$a3; {2400n}
               '4': b:=$e3; {9600n}

              else begin
                     writeln('     BAUD SET NOT VALID 300N - DEFALT');
                     b:=$43;
                   end;
              end; {case}

          case baud of
              '1': writeln('  Baud: 300,N,8,1');
              '2': writeln('  Baud: 1200,N,8,1');
              '3': writeln('  Baud: 2400,N,8,1');
              '4': writeln('  Baud: 9600,N,8,1');

              else begin
                     writeln('     BAUD SET NOT VALID 300N - DEFALT');
                   end;
              end; {case}

                 com:=com-1;
                 rate:=b;
                asm
                  mov dx,com
                  mov ah,$00
                  mov al,rate
                end;
                bypass;
          end;



FUNCTION cd(var local:boolean; port:integer) : BOOLEAN;
          var
           temp   : boolean;
           result : byte;

          begin

            temp:=false;

            port := port-1;
               asm
                 mov dx,port
                 mov ah,$03;
                 mov al,$00
               end;
             bypass;
               asm
                mov result,al
               end;

             IF result AND $80 = 128 THEN temp:=TRUE
                                     ELSE temp:=FALSE;

             if local=true then temp:=true;

             cd:=temp;

         end;

procedure hangup(comport:integer);
          var
           count:integer;


    procedure lower(comport:integer);
          begin
            comport:=comport-1;
            asm
             mov dx,comport
             mov ah,$06
             mov al,$00
            end;
            bypass;
          end;

    procedure higher(comport:integer);
          begin
            comport:=comport-1;
            asm
             mov dx,comport
             mov ah,$06
             mov al,$01
            end;
            bypass;
          end;

        begin
        count:=0;
        repeat
          count:=count+1;
          flowoff(comport);
          flush(comport);
          lower(comport);
          delay(1000);
          higher(comport);
          local:=false;
          if count>1 then writeln(' Error: CAN NOT DROP CARRIER!');
         until not cd(local,comport) or (count>=255);
         if count>=255 then halt(0);

        end;


function ring(comport:integer) : boolean;

          var
           result : byte;

          begin
             comport:=comport-1;
            asm
             mov dx,comport
             mov ah,$03
             mov al,$00
            end;
            bypass;
            asm
             mov result,al
            end;

             IF result AND 64 = 64 THEN ring:=TRUE
                                    ELSE ring:=FALSE;

         end;






{Sends a character to the modem }
procedure sendc(com: integer; c:char);
          var
           x : byte;
           sx,sy : integer;
           loop  : integer;

          begin

            com:=com-1;
            x:=ord(c);

            asm
             mov dx,com
             mov ah,$01
             mov al,x;
            end;
            bypass;


          end;


procedure sendxc(com:integer; c:char);

          var
           sx,sy : integer;
           x     : byte;
          begin

            com:=com-1;
            x:=ord(c);

            asm
             mov dx,com
             mov ah,$01
             mov al,x
            end;
            bypass;

          end;


procedure getc(com:integer; var c:char);

          var
           result : byte;
           sx,sy : integer;

          begin

            c:=chr(0);
            com:=com-1;
            asm
             mov dx,com
             mov ah,$03
             mov al,$00
            end;
            bypass;
            asm
             mov result,ah
           end;

           if result and 1 = 1
              then begin


                     asm
                      mov dx,com
                      mov ah,$02
                      mov al,$00
                     end;
                     bypass;
                     asm
                      mov result,al
                     end;

                     c:=chr(result);

                   end;

            if c=chr(7) then c:=chr(0);
            if c='+' then c:=chr(0);
            if c=chr(26) then c:=chr(0);

          end;



procedure getxc(com:integer; var c:integer);

          var
           result : byte;
           sx,sy : integer;

          begin

            c:=-1;
            com:=com-1;
            result:=00;

            asm
             mov dx,com
             mov ah,$03
             mov al,$00
            end;
            bypass;
            asm
             mov result,ah
            end;

           if result and 1 = 1
              then begin
                     asm
                       mov dx,com
                       mov ah,$02
                       mov al,$00
                     end;
                     bypass;
                     asm
                      mov result,al
                     end;

                     c:=result;
                   end;

          end;


procedure startcom(com:integer);
          var
           result : integer;

          begin
             com:=com-1;
            asm
              mov ax,$0000
              mov dx,com
              mov ah,$04
            end;
             bypass;
            asm
             mov result,ax
            end;


          if result <> $1954 then
                        begin
                          writeln;
                          writeln('  Fossil not supporting Com',com+1,' or
Fossil not installed.');
                          halt(0);
                       end;

          end;

procedure stopcom(com:integer);
          begin
            asm
             mov dx,com
             mov ah,$05
            end;
            bypass;
          end;

END.

local:=true;



--- msged 2.05
 * Origin: Quick_Mail  (1:382/104)

@PATH: 382/104 3 1 147/46 13/13 396/1 170/400 512/0 1007