adprotcl.pas

Async Professional 4.04

    property AsciiCharDelay;
    property AsciiLineDelay;
    property AsciiEOLChar;
    property AsciiCRTranslation;
    property AsciiLFTranslation;
    property AsciiEOFTimeout;
    property UpcaseFileNames;
    property OnProtocolAccept;
    property OnProtocolError;
    property OnProtocolFinish;
    property OnProtocolLog;
    property OnProtocolNextFile;
    property OnProtocolResume;
    property OnProtocolStatus;
  end;

  {.Z+}
  {A list of active TApdProtocol objects}
  PProtocolWindowNode = ^TProtocolWindowNode;
  TProtocolWindowNode = record
    pwWindow   : TApdHwnd;
    pwProtocol : TApdCustomProtocol;
  end;

  {Miscellaneous functions}
  function CheckNameString(const Check : TBlockCheckMethod) : String;
  function FormatMinSec(const TotalSecs : LongInt) : String;
  {.Z-}
  function ProtocolName(const ProtocolType : TProtocolType) : String;

  {Component registration procedure}

implementation

{$IFDEF TRIALRUN}
  {$I TRIAL03.INC}
  {$I TRIAL02.INC}
  {$I TRIAL01.INC}
{$ENDIF}

const
  FileSkipMask = $80;   {Skip file if dest doesn't exist}
  FileRecover  = $03;   {Resume interrupted file transfer}

const
  {Table of protocol preparation procedures}
  PrepProcs : array[ptNoProtocol..ptAscii, Boolean] of TPrepareProc = (
    (nil, nil),                               {NoProtocol}
    (xpPrepareReceive, xpPrepareTransmit),    {Xmodem}
    (xpPrepareReceive, xpPrepareTransmit),    {XmodemCRC}
    (xpPrepareReceive, xpPrepareTransmit),    {Xmodem1K}
    (xpPrepareReceive, xpPrepareTransmit),    {Xmodem1KG}
    (ypPrepareReceive, ypPrepareTransmit),    {Ymodem}
    (ypPrepareReceive, ypPrepareTransmit),    {YmodemG}
    (zpPrepareReceive, zpPrepareTransmit),    {Zmodem}
    (kpPrepareReceive, kpPrepareTransmit),    {Kermit}
    (spPrepareReceive, spPrepareTransmit));    {Ascii}

  {Table of protocol functions}
  ProtFuncs : array[ptNoProtocol..ptAscii, Boolean] of TProtocolFunc = (
    (nil, nil),                   {NoProtocol}
    (xpReceive, xpTransmit),      {Xmodem}
    (xpReceive, xpTransmit),      {XmodemCRC}
    (xpReceive, xpTransmit),      {Xmodem1K}
    (xpReceive, xpTransmit),      {Xmodem1KG}
    (ypReceive, ypTransmit),      {Ymodem}
    (ypReceive, ypTransmit),      {YmodemG}
    (zpReceive, zpTransmit),      {Zmodem}
    (kpReceive, kpTransmit),      {Kermit}
    (spReceive, spTransmit));      {Ascii}

var
  ProtList : TList;

{General purpose routines}

  function LeftPad(const S : String; Len : Byte) : String;
    {-Return a string left-padded to length len}
  var
    o : String;
    SLen : Byte;
  begin
    SLen := Length(S);
    if SLen >= Len then
      LeftPad := S
    else if SLen < 255 then begin
      {$IFDEF Win32}
      SetLength(o, Len);
      {$ELSE}
      o[0] := Chr(Len);
      {$ENDIF}
      Move(S[1], o[Succ(Cardinal(Len))-SLen], SLen);
      FillChar(o[1], Len-SLen, ' ');
      LeftPad := o;
    end;
  end;

  function SearchStatusDisplay(const C : TComponent) : TApdAbstractStatus;
    {-Search for a status display in the same form as TComponent}

    function FindStatusDisplay(const C : TComponent) : TApdAbstractStatus;
    var
      I  : Integer;
    begin
      Result := nil;
      if not Assigned(C) then
        Exit;

      {Look through all of the owned components}
      for I := 0 to C.ComponentCount-1 do begin
        if C.Components[I] is TApdAbstractStatus then begin
          {...and it's not assigned}
          if not Assigned(TApdAbstractStatus(C.Components[I]).FProtocol) then begin
            Result := TApdAbstractStatus(C.Components[I]);
            Exit;
          end;
        end;

        {If this isn't one, see if it owns other components}
        Result := FindStatusDisplay(C.Components[I]);
      end;
    end;

  begin
    {Search the entire form}
    Result := FindStatusDisplay(C);
  end;

  function SearchProtocolLog(const C : TComponent) : TApdProtocolLog;
    {-Search for a protocol log in the same form as TComponent}

    function FindProtocolLog(const C : TComponent) : TApdProtocolLog;
    var
      I  : Integer;
    begin
      Result := nil;
      if not Assigned(C) then
        Exit;

      {Look through all of the owned components}
      for I := 0 to C.ComponentCount-1 do begin
        if C.Components[I] is TApdProtocolLog then begin
          {...and it's not assigned}
          if not Assigned(TApdProtocolLog(C.Components[I]).FProtocol) then begin
            Result := TApdProtocolLog(C.Components[I]);
            Exit;
          end;
        end;

        {If this isn't one, see if it owns other components}
        Result := FindProtocolLog(C.Components[I]);
      end;
    end;

  begin
    {Search the entire form}
    Result := FindProtocolLog(C);
  end;

{Message handler window}

  function FindProtocol(Handle : TApdHwnd) : TApdCustomProtocol;
    {-Return protocol object for this window handle}
  var
    I : Integer;
  begin
    for I := 0 to ProtList.Count-1 do begin
      with PProtocolWindowNode(ProtList.Items[I])^ do begin
        if pwWindow = Handle then begin
          Result := pwProtocol;
          Exit;
        end;
      end;
    end;
    Result := nil;
  end;

  function MessageHandler(hWindow : TApdHwnd; Msg, wParam : Integer;
                          lParam : Longint) : Longint;
    {$IFDEF Win32} stdcall; export; {$ELSE} export; {$ENDIF}
    {-Window function for all apw_ProtXxx messages}
  var
    P : TApdCustomProtocol;
    Accept : Boolean;
    FName : TPassString;
    Temp : TWriteFailAction;

  begin
    Result := 0;
    P := FindProtocol(hWindow);
    if Assigned(P) then begin
      with P do begin
        case Msg of
          APW_PROTOCOLSTATUS      :
            apwProtocolStatus(P, wParam);
          APW_PROTOCOLLOG         :
            apwProtocolLog(P, wParam);
          APW_PROTOCOLNEXTFILE    :
            begin
              FName := '';
              apwProtocolNextFile(P, FName);
              if FName <> '' then begin
                StrPCopy(PChar(lParam), FName);
                Result := 1;
              end else
                Result := 0;
            end;
          APW_PROTOCOLACCEPTFILE  :
            begin
              FName := StrPas(PChar(lParam));
              apwProtocolAccept(P, Accept, FName);
              if Accept then begin
                if FileName <> '' then
                  StrPCopy(PChar(lParam), FName);
                Result := 1;
              end else
                Result := 0;
            end;
          APW_PROTOCOLFINISH      :
            apwProtocolFinish(P, SmallInt(wParam));
          APW_PROTOCOLRESUME      :
            begin
              Temp := TWriteFailAction(wParam);
              apwProtocolResume(P, Temp);
              MessageHandler := wParam;
            end;
          APW_PROTOCOLERROR       :
            apwProtocolError(P, SmallInt(wParam));
          else
            MessageHandler := DefWindowProc(hWindow, Msg, wParam, lParam);
        end;
      end;
    end else
      MessageHandler := DefWindowProc(hWindow, Msg, wParam, lParam);
  end;

  procedure RegisterMessageHandlerClass;
  const
    Registered : Boolean = False;
  var
    XClass: TWndClass;
  begin
    if Registered then
      Exit;
    Registered := True;

    with XClass do begin
      Style         := 0;
      lpfnWndProc   := @MessageHandler;
      cbClsExtra    := 0;
      cbWndExtra    := 0;
      {$IFDEF VERSION3}
      if ModuleIsLib and not ModuleIsPackage then
        hInstance   := SysInit.hInstance
      else
        hInstance   := System.MainInstance;
      {$ELSE}
      hInstance     := System.hInstance;
      {$ENDIF}                                                      
      hIcon         := 0;
      hCursor       := 0;
      hbrBackground := 0;
      lpszMenuName  := nil;
      lpszClassName := MessageHandlerClassName;
    end;
    WinProcs.RegisterClass(XClass);
  end;

{TApdProtocol}

  procedure TApdCustomProtocol.CreateMessageHandler;
    {-Create message handler window}
  var
    Node : PProtocolWindowNode;
    hInstance : THandle;
  begin
    {$IFDEF VERSION3}
    if ModuleIsLib and not ModuleIsPackage then
      hInstance   := SysInit.hInstance
    else
      hInstance   := System.MainInstance;
    {$ELSE}
    hInstance := System.hInstance;
    {$ENDIF}                                                        
    FMsgHandler :=
      CreateWindow(MessageHandlerClassName,   {window class name}
      '',                         {caption}
      0,                          {window style}
      0,                          {X}
      0,                          {Y}
      0,                          {width}
      0,                          {height}
      0,                          {parent}
      0,                          {menu}
      hInstance,
      nil);

    if FMsgHandler = 0 then
      raise EInternal.Create(ecInternal, False);

    ShowWindow(FMsgHandler, sw_Hide);

    {Add to global list}
    Node := nil;
    try
      New(Node);
      Node^.pwWindow := FMsgHandler;
      Node^.pwProtocol := Self;
      ProtList.Add(Node);
      apSetProtocolWindow(PData, FMsgHandler);
    except
      on EOutOfMemory do begin
        if Node <> nil then
          Dispose(Node);
        raise;
      end;
    end;
  end;

  procedure TApdCustomProtocol.CheckPort;
    {-Set port's comhandle or raise exception}
  begin
    {Make sure comport is open, pass handle to protocol}
    if Assigned(FComPort) then
      apSetProtocolPort(PData, FComPort)
    else
      raise EPortNotAssigned.Create(ecPortNotAssigned, False);
  end;

  procedure TApdCustomProtocol.Notification(AComponent : TComponent;
                                            Operation : TOperation);
  begin
    inherited Notification(AComponent, Operation);

    if Operation = opRemove then begin
      {Owned components going away}
      if AComponent = FComPort then
        ComPort := nil;
      if AComponent = FStatusDisplay then
        StatusDisplay := nil;
      if AComponent = FProtocolLog then
        ProtocolLog := nil;
    end else if Operation = opInsert then begin
      {Check for new comport}
      if AComponent is TApdCustomComPort then
        if not Assigned(FComPort) then
          ComPort := TApdCustomComPort(AComponent);

      {Check for new status component}
      if AComponent is TApdAbstractStatus then begin
        if not Assigned(FStatusDisplay) then
          if not Assigned(TApdAbstractStatus(AComponent).FProtocol) then
            StatusDisplay := TApdAbstractStatus(AComponent);
      end;

      {Check for new protocol log component}
      if AComponent is TApdProtocolLog then begin
        if not Assigned(FProtocolLog) then begin
          if not Assigned(TApdProtocolLog(AComponent).FProtocol) then begin
            ProtocolLog := TApdProtocolLog(AComponent);
            ProtocolLog.FProtocol := Self;
          end;
        end;
      end;
    end;
  end;