awascii.pas

测试用例

(***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Async Professional
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1991-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{*                   AWASCII.PAS 4.06                    *}
{*********************************************************}
{* ASCII protocol                                        *}
{*********************************************************}

{Global defines potentially affecting this unit}
{$I AWDEFINE.INC}

{Options required for this unit}
{$I-,B-,F+,A-,X+,J+}

unit AwAscii;
  {-Provides ASCII recieve and transmit functions}

interface

uses
  WinTypes,
  WinProcs,
  Messages,
  SysUtils,
  OoMisc,
  AwUser,
  AwTPcl,
  AwAbsPcl,
  AdPort;    

function spInit(var P : PProtocolData; H : TApdCustomComPort; Options : Cardinal) : Integer;
procedure spDone(var P : PProtocolData);

function spReinit(P : PProtocolData) : Integer;
procedure spDonePart(P : PProtocolData);

{Options}
function spSetDelays(P : PProtocolData; CharDelay, LineDelay : Cardinal) : Integer;
function spSetEOLChar(P : PProtocolData; C : Char) : Integer;
function spGetLineNumber(P : PProtocolData) : LongInt;
function spSetEOLTranslation(P : PProtocolData; CR, LF : Cardinal) : Integer;
function spSetEOFTimeout(P : PProtocolData; NewTimeout : LongInt) : Integer;

{Control}
procedure spPrepareTransmit(P : PProtocolData);
procedure spPrepareReceive(P : PProtocolData);
procedure spTransmit(Msg, wParam : Cardinal; lParam : LongInt);
procedure spReceive(Msg, wParam : Cardinal; lParam : LongInt);

implementation

const
  {Compile time constants}
  awaDefInterCharDelay = 0;   {Default is zero ms delay between chars}
  awaDefInterLineDelay = 0;   {Default is zero ms delay between lines}
  awaDefEOLChar = cCR;        {Default EOL char is carriage return}
  awaDefRcvTimeout = 364;     {Default Ticks to assume end of receive, 20 sec}
  awaDefBlockLen = 60;        {Default block length (assume avg of 60)}
                           {Note: must be less than SizeOf(TDataBlock)-1}
  awaDefCRTranslate = atNone; {Default CR Translation is none}
  awaDefLFTranslate = atNone; {Default LF Translation is none}
  awaDefMaxAccumDelay = 250;  {Max accum milliseconds to delay in one call}

  aDataTrigger = 0;

  LogAsciiState : array[TAsciiState] of TDispatchSubType = (          
     dsttaInitial, dsttaGetBlock, dsttaWaitFreeSpace, dsttaSendBlock,
     dsttaSendDelay, dsttaFinishDrain, dsttaFinished, dsttaDone,
     dstraInitial, dstraCollectBlock, dstraProcessBlock,
     dstraFinished, dstraDone);

{Ascii protocol}

  procedure spInitData(P : PProtocolData);
    {-Init data}
  begin
    with P^ do begin
      {Init Ascii data}
      sInterCharDelay   := awaDefInterCharDelay;
      sInterLineDelay   := awaDefInterLineDelay;
      sEOLChar          := awaDefEOLChar;
      sCtrlZEncountered := False;
      aRcvTimeout       := awaDefRcvTimeout;
      sMaxAccumDelay    := awaDefMaxAccumDelay;
      aBlockLen         := awaDefBlockLen;
      aCheckType        := bcNone;
      aCurProtocol      := Ascii;
      sCRTransMode      := awaDefCRTranslate;
      sLFTransMode      := awaDefLFTranslate;

    end;
  end;

  function spInit(var P : PProtocolData; H : TApdCustomComPort; Options : Cardinal) : Integer;
  {-Allocates and initializes a protocol control block with Options}
  begin
    {Check for adequate output buffer size}
    if H.OutBuffUsed + H.OutBuffFree < 1024 then begin
      spInit := ecOutputBufferTooSmall;
      Exit;
    end;

    {Allocate block for protocol}
    if apInitProtocolData(P, H, Options) <> ecOk then begin
      spInit := ecOutOfMemory;
      Exit;
    end;

    {Get a protocol DataBlock}
    with P^ do begin
      aDataBlock := AllocMem(SizeOf(TDataBlock));

      {Can't fail after this}
      spInit := ecOK;

      spInitData(P);
    end;
  end;

  function spReinit(P : PProtocolData) : Integer;
    {-Allocates and initializes a protocol control block with Options}
  begin
    {Get a protocol DataBlock}
    with P^ do begin
      aDataBlock := AllocMem(SizeOf(TDataBlock));

      {Can't fail after this}
      spReinit := ecOK;
      spInitData(P);
      apResetReadWriteHooks(P);
    end;
  end;

  procedure spDonePart(P : PProtocolData);
    {-Disposes of P}
  begin
    with P^ do begin
      FreeMem(aDataBlock, SizeOf(TDataBlock));
    end;
  end;

  procedure spDone(var P : PProtocolData);
    {-Disposes of P}
  begin
    spDonePart(P);
    apDoneProtocol(P);
  end;

  function spSetDelays(P : PProtocolData;
                       CharDelay, LineDelay : Cardinal) : Integer;
    {-Set the delay (in ms) between each character and each line}

    function Cvt2Ticks(MS : Cardinal) : Cardinal;
      {-Convert to ticks rounding up}
    begin
      if MS mod 55 = 0 then
        Cvt2Ticks := MS div 55
      else
        Cvt2Ticks := (MS div 55) + 1;
    end;

  begin
    with P^ do begin
      if aCurProtocol <> Ascii then
        spSetDelays := ecBadProtocolFunction
      else begin
        spSetDelays := ecOK;
        sInterCharDelay := CharDelay;
        sInterLineDelay := LineDelay;
        sInterCharTicks := Cvt2Ticks(sInterCharDelay);
        sInterLineTicks := Cvt2Ticks(sInterLineDelay);
      end;
    end;
  end;

  function spSetEOLChar(P : PProtocolData; C : Char) : Integer;
    {-Set the character used to mark the end of line}
  begin
    with P^ do
      if aCurProtocol <> Ascii then
        spSetEOLChar := ecBadProtocolFunction
      else begin
        spSetEOLChar := ecOK;
        sEOLChar := C;
      end;
  end;

  function spGetLineNumber(P : PProtocolData) : LongInt;
    {-Return the current line number}
  begin
    with P^ do
      if aCurProtocol <> Ascii then
        spGetLineNumber := 0
      else
        spGetLineNumber := P^.aBlockNum;
  end;

  function spSetEOLTranslation(P : PProtocolData; CR, LF : Cardinal) : Integer;
    {-Set the translation modes for CR/LF translations}
  begin
    with P^ do
      if aCurProtocol <> Ascii then
        spSetEOLTranslation := ecBadProtocolFunction
      else begin
        spSetEOLTranslation := ecOK;
        sCRTransMode := CR;
        sLFTransMode := LF;
      end;
  end;

  function spSetEOFTimeout(P : PProtocolData; NewTimeout : LongInt) : Integer;
    {-Set the EOF timeout, in ticks}
  begin
    with P^ do
      if aCurProtocol <> Ascii then
        spSetEOFTimeout := ecBadProtocolFunction
      else begin
        spSetEOFTimeout := ecOK;
        aRcvTimeout := NewTimeout;
      end;
  end;

  procedure spCancel(P : PProtocolData);
    {-Cancel the Ascii protocol}
  begin
    with P^ do
      if aHC.Open then                                                 
        {Flush anything that might be left in the output buffer}
        aHC.FlushOutBuffer;
  end;

  function spSendBlockPart(P : PProtocolData; var Block : TDataBlock) : Boolean;
    {-Send part of the block, return True when finished}
  var
    AccumDelay : Cardinal;
    C : Char;
    Finished : Boolean;

    procedure SendChar(C : Char);
      {-Send current character and increment count}
    begin
      with P^ do begin
        {Send the character}
        aHC.PutChar(C);
        Inc(aBytesTransferred);
        Dec(aBytesRemaining);
      end;
    end;

  begin
    with P^ do begin
      {Assume not finished}
      spSendBlockPart := False;

      {Send as much data as we can}
      AccumDelay := 0;
      Finished := sSendIndex >= aLastBlockSize;
      while not Finished do begin
        {Get next character to send}
        Inc(sSendIndex);
        C := Block[sSendIndex];

        {Check character before sending}
        case C of
          {^Z : if FlagIsSet(aFlags, apAsciiSuppressCtrlZ) then begin} 
                 {spSendBlockPart := True;}