A finger implementation in Pascal using Trumpet TCP in DOS. Retrieved from http://www.pld.ttu.ee/~priidu/library/net/trumpet.html

tcpfing.pas

program TCPFing;
uses
  DOS, TrumpTCP, Crt, StrTools;


CONST
  NulAddr: TIPAddr = (S_B1:0; S_B2:0; S_B3:0; S_B4:0);

var Result: Byte;
    TmpAddr: TIPAddr;
    TmpPort: Word;
    TmpLong: LongInt;
    I : Integer;
    A, Key : String;
    B : String;

procedure ShowStatus(CurrentSession: TTCPSessionREC);
begin
  Write(HexB(CurrentSession.Handle)+' ');
  Write('FROM:'+IPtoA(DriverInfo.MyIP)+':');
  if CurrentSession.TcpSrc=0 then
    Write('[',CurrentSession.LocalPort,']')
  else
    Write(CurrentSession.TcpSrc);
  Write('      =>  TO:  '+IPtoA(CurrentSession.IPDst)+':');
  Writeln(CurrentSession.TcpDst,'     ',
    TcpState[CurrentSession.Status.State]);

  Writeln('State         : ',CurrentSession.Status.State);
  Write  ('BytesReady    : ',CurrentSession.Status.BytesReady);
  Writeln('    BytesGoing    : ',CurrentSession.Status.BytesGoing);
  Write  ('Source IP     : ',IPtoA(CurrentSession.Status.IPSrc));
  Writeln('    Destination IP: ',IPtoA(CurrentSession.Status.IPDst));
  Writeln(' IP Prot      : ',CurrentSession.Status.IPProt);
  Writeln(' A C T I V E? : ',CurrentSession.Status.Active);
  Writeln;
end;

function Finger (UserID: String; Host: TIPAddr; HostString: String): Integer;
var
  CurSession: TTCPSessionRec;
begin
  TmpPort := 120 {ECHO_PORT};

  Write (IPtoA(DriverInfo.MyIP)+':');
  Write (CurSession.LocalPort);
  Write (' attempting to connect to ',IPtoA(host));
  Writeln (':',TmpPort);
  if TCP_Open (CurSession, 0, TmpPort, host, 450, 0) then
    Writeln ('Connection Established');

  if not TCP_Status (CurSession,0) then
  begin
    if TCPError = tcpTimeout then
    begin
      Write ('No response from ');
    end
    else
      Write ('Error ', TrumpetError (TCPError), ' opening ');
    Writeln (IPtoA (CurSession.IPDst));
    Halt;
  end;

  AddBuffer (CurSession.Buffer, UserID + #13#10 + 'Blaah, blaah, blaah'
    + #13#10 + 'Hello world siin me oleme....Ñìî≥ƒ'+#13#10, 0);

  if TCP_Send (CurSession, 500, 4) then
    Writeln ('Remote system is looking up user...',#34,userid,#34);

  Tcp_Status (CurSession,0);
  If CurSession.Status.Active then
  begin
    repeat
      if KeyPressed then
        Key := ReadKey
      else
        Key := #0;
      if Key = '?' then
      begin
        {Tcp_Status(CurrentSession,0);}
        ShowStatus(CurSession);
      end;
                                              {   PktsInputQueue:=Regs.AX; }
                                              {   PktsOutputQueue:=Regs.CX;}
      if not TCP_Recv (CurSession, 350, 1) then
      begin
        Writeln ('Blaah...', TrumpetError (TCPError));
      end;

      if CurSession.Buffer.Length<>0 then
      begin
        for I := 0 to CurSession.Buffer.Length-1 do
        begin
          if CurSession.Buffer.Buffer[I]= Byte(#10) then
            Write(#13);
          Write(Chr (CurSession.Buffer.Buffer[I]));
        end;
      end;
    until ((CurSession.Status.State <> 4) and
           (CurSession.Status.BytesReady=0)) or
           (CurSession.Result <> 0) or (key=#27);
  end;

  TCP_Close(CurSession, 350, 0);
  Finger:=-1;
end;




BEGIN
  Writeln;
  Writeln('Turbo Pascal 7.0 - TCP/IP FINGER using Trumpet''s TCP/IP interface for DOS');
  Writeln;
 { TmpAddr[0]:=198; TmpAddr[1]:=164; TmpAddr[2]:=230; TmpAddr[3]:=1; }  {Gateway's Linux}

  if not DriverPresent then
  begin
    Writeln ('TCP Driver not present');
    Halt;
  end;

  FillChar (TmpAddr, SizeOf (TmpAddr), 0);
  TmpAddr.S_B1:=193; TmpAddr.S_B2:=40; TmpAddr.S_B3:=246; TmpAddr.S_B4:=10;

  B:=ParamStr(1);
  if pos('@',B)<1 then
  begin
    Writeln('FINGER userid@server');
    Halt(3);
  end;

  A:=Copy(B, pos('@',B)+1, Length(B)-pos('@',B) );
  B:=Copy(B, 1, pos('@',B)-1);
  if not AtoIP (A, TmpAddr) then
  begin
    Writeln ('Error in host name: ', B);
    Halt;
  end;
  TmpLong:=0;
  Move(TmpAddr,TmpLong,4);
  if TmpLong=0 then
  begin
    Writeln;
    Writeln('Invalid Address was specified: '+#34,A,#34);
    Halt(2);
  end;
  Result:=Finger(B,TmpAddr,A);
  if Result=0 then Writeln('Finger Ok');
END.