{
  Joachim Deckers
  Anlage zur 2. Staatsexamensarbeit / 28.5.96

  Unit zur einfachereren Handhabung von TCP unter Turbo Pascal.
  Auf Folie SO (siehe Anhang der Arbeit) beschreibe ich die Typen,
  Funktionen und Prozeduren dieser Unit.

  Mit dieser Unit wird es SEHR einfach, TCP-Verbindungen aufzubauen.
  Natürlich steht die Funktionalität der Winsock.dll hier nur sehr
  eingeschränkt zur Verfügung - aber sie kann ggf. auch gleichzeitig
  genutzt werden.

  Eine WINSOCK.DLL muß zur Ausführung dieses Programmes installiert sein.
  Getestet habe ich es mit Trumpet Winsock Version 2.1f. 
}

unit sockets;

INTERFACE

uses winsock, strings, wincrt;

type PHostInfo  = Phostent; { Zeiger auf Informations-Record eines Hosts }
     Portnummer = Word;     { Nummer eines Ports }
     SocketAdresseIF = sockaddr_in; { Socket-Adresse mit IP-Nr. im Internet-Format }



procedure InitialisiereWinsock;
  { Muß am Anfang jeder Internet-Applikation aufgerufen werden }
procedure CleanUp;
  { Muß am Ende jeder Internet-Applikation aufgerufen werden }

procedure ZeigeWinsockInfos;
  { Gibt Informationen über die verwendete Winsock.DLL aus }

procedure WriteHostIP(Host: PHostInfo);
  { Gibt die IP-Adresse eines Hosts aus }
procedure SendeText(Socket: TSocket; s : string);
  { Sendet einen Text über einen verbundenen Socket } 

function EmpfangeText(Socket: TSocket; var s: string) : boolean;
  { Empfängt einen Text über einen verbundenen Socket
    Rückgabe: TRUE = kein Fehler, FALSE = ein Fehler ist aufgetreten }
function SucheHost(name: string): PHostInfo;
  { Sucht nach Existenz und Adresse eines Rechners im Internet (via DNS)  
    Rückgabe: Zeiger auf einen Verbund mit den Hostinformationen (PHostInfo)
              Falls ein Fehler aufgetreten ist: nil }
function SucheServicePortNummer(dienst, protokoll: string): Word;
  { Sucht die Portnummer eines Standarddienstes über ein Standardprotokoll  
    Rückgabe: Nummer des Protokolls. Falls Fehler: 0 }
function ErzeugeSocket: tSOCKET;
  { Erzeugt einen neuen (unverbundenen) Socket 
    Rückgabe: Nummer des Sockets. Falls Fehler: 0 }
procedure BindeSocket(s: tSOCKET; p: Portnummer; var RemoteAdresse:sockaddr_in);
  { Bindet den Socket s an den Port p. Benutzt die Variable RemoteAdresse,
    um dort die Adresse/Port eines verbindenden Clients zu speichern. }
function AkzeptiereVerbindung(s: tSOCKET; RemoteAdresse:sockaddr_in): tSOCKET;
  { Akzeptiert eine Verbindung am Socket s }

function VerbindungAufbauen(Host: PHostInfo; Port: Portnummer; Socket: TSocket): boolean;
  { Baut eine Verbindung mit dem angegebenen Host und über den angegebenen Port
    auf und identifiziert den Socket mit dieser Verbindung 
    Rückgabe: TRUE = kein Fehler, FALSE = ein Fehler ist aufgetreten }
procedure VerbindungAbbauen(Socket: TSocket);
  { Baut die mit dem Socket identifizierte Verbindung wieder ab }

procedure Abbruch(Meldung: String);
  { Bricht das Programm mit einer Fehlermeldung ab }
procedure Fehler(Meldung: String);
  { Gibt eine Fehlermeldung aus }

IMPLEMENTATION


const benWSVersion : Word = $0101; { Versionsnummer der benötigten Winsock.dll }
                                   { = Version 1.1 }
      BufSize             = 255;  { Größe des Buffers für gesendete/empfangene Nachrichten }

var
  WSADaten     : WSADATA;    { Daten der Winsock-Applikation }
  buffer       :             { Allgemeiner Buffer für PChar-Operationen
                               (Ein PChar ist ein Zeiger auf einen
                                nullterminierten String) }
                 array[0..BufSize] of char;



function hibyte(w: word): byte;  { Die internen Funktionen liefern hier }
begin                            { falsche Ergebnisse bei TPW 1.5 }
  hibyte := w shr 8 
end;

function lobyte(w: word): byte;
begin
  lobyte := w and $ff
end;

{$I ERROR.INC}                   { Fehlermeldungen im Klartext einbinden }


procedure InitialisiereWinsock;
begin
  if WSAStartup(benWSVersion,@WSADaten) <>0 then  { Infos zu WinSock holen }
    Abort('InitialisiereWinsock');
end;


procedure ZeigeWinsockInfos;
begin
  Writeln('Gefundene Winsock Version : ',lobyte(WSADaten.wVersion),'.',lobyte(WSADaten.wHighVersion));
  Writeln('Beschreibung              : ',WSADaten.szDescription);
  Writeln('Systemstatus              : ',WSADaten.szSystemStatus);
  Write  ('Name des lokalen Rechners : ');
  if (gethostname(@buffer,BufSize) <> 0) then { Name des lokalen Hosts lesen }
    Writeln('---unbekannt---')
  else
    Writeln(buffer); 
end;


procedure WriteHostIP(Host: Phostent);  { Gibt eine IP-Adresse aus }
begin
  with Host^ do
  Write( byte(h_addr[0]),'.',
         byte(h_addr[1]),'.',
         byte(h_addr[2]),'.',
         byte(h_addr[3]))
end;


function SucheHost(name: string): Phostent;
var RemoteHost: Phostent;
begin
  { Pascal-Strings müssen immer in nullterminierte Strings umgewandelt werden }
  StrPCopy(buffer, name);
  { Daten des RemoteHost aus der Datenbank des DNS holen }
  RemoteHost := gethostbyname(buffer);
  if RemoteHost <> nil then
    with RemoteHost^ do 
      h_addr := h_addr_list^  { Host soll adressiert werden über die erste
                                Adresse in der Liste aller Adressen }
  else begin
    Error('SucheHost');
    writeln('Der Host ',name,' wurde nicht gefunden!');
  end;
  SucheHost := RemoteHost;                                           
end;


function SucheServicePortNummer(dienst, protokoll: string): Word;
var pSE : pServEnt; { Ein Record ServEnt enthält Informationen zu dem
                      Namen, Protokoll und Port eines Services, wie er
                      in der Datei services. definiert ist }
    buffer2: array[0..20] of char;                   
begin
  StrPCopy(buffer,dienst);
  StrPCopy(buffer2,Copy(protokoll,1,20));
  pSE := getservbyname(buffer,buffer2);
  if pSE = nil then begin
    SucheServicePortNummer := 0;
    Error('SucherServicePortNummer');
    Writeln;
    Writeln('Der Dienst ',dienst,' ist nicht bekannt.'); 
    Writeln('Dienstetabelle in der Datei services. prüfen!');
  end
  else
    { Portnummer vom Host- in das Netzwerkformat umsetzen }
    SucheServicePortNummer := htons(pSE^.s_port);
end;


function ErzeugeSocket: tSOCKET;
var s: tSOCKET;
begin
  s :=socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
  { Socket erzeugen mit den Daten:
    Internet-Verbindung, Socket Stream, IP als Verbindungsprotokoll }
  If s = INVALID_SOCKET then
    Abort('Kann keinen Socket erzeugen...');
  ErzeugeSocket:=s;
end;

procedure BindeSocket(s: tSOCKET; p: Portnummer; var RemoteAdresse:sockaddr_in);
begin
  with RemoteAdresse do begin
    { Socketadresse festlegen }
    sin_family := PF_INET;           { Internet-Verbindung } 
    sin_port   := htons(p);          { Port im Netzwerkformat }
    sin_addr.s_addr := INADDR_ANY;   { Verbindung mit jeder beliebigen Adresse }
  end;

  { Socket binden }
  if bind(s, sockaddr(RemoteAdresse), SizeOf(RemoteAdresse)) <> 0 then
  begin
    CloseSocket(s); { bei erfolglosem Bindeversuch alles schließen }
    Abort('Konnte Socket nicht binden...');
  end;
end;

function AkzeptiereVerbindung(s: tSOCKET; RemoteAdresse:sockaddr_in): tSOCKET;
  { Akzeptiert eine Verbindung am Socket s }
var  MeineAdrLaenge: Integer;
     MeineSocketAdr: Sockaddr;
     sa: tSOCKET;
begin
  MeineAdrLaenge := SizeOf(RemoteAdresse);
  MeineSocketAdr := SockAddr(RemoteAdresse);
  { Verbindung akzeptieren }
  sa := accept(s, @MeineSocketAdr, @MeineAdrLaenge);
  if sa=INVALID_SOCKET  then
    Fehler('Konnte Socket-Verbindung nicht akzeptieren...');
  AkzeptiereVerbindung:=sa;
end;

procedure VerbindungAbbauen(Socket: tSOCKET);
begin
  CloseSocket(Socket)
end;


function VerbindungAufbauen(Host: Phostent; Port: Word; Socket: tSOCKET): boolean;
var RemoteAdresse: sockaddr_in;
begin
  with RemoteAdresse do begin
    { Socketadresse des Hosts festlegen }
    sin_family := PF_INET;             { Internet-Verbindung }
    sin_port   := htons(Port);         { Port im Netzwerkformat }
    with Host^ do begin
      sin_addr.S_un_b.s_b1:=h_addr[0]; { Hostadresse aus der HostEnt-  }
      sin_addr.S_un_b.s_b2:=h_addr[1]; { Struktur in die Socketadresse }
      sin_addr.S_un_b.s_b3:=h_addr[2]; { kopieren (byteweise)          }
      sin_addr.S_un_b.s_b4:=h_addr[3];
    end
  end;
  { Verbindung herstellen } 
  if connect(Socket, sockaddr(RemoteAdresse), SizeOf(RemoteAdresse)) <> 0 then
  begin
    CloseSocket(Socket); { bei erfolglosem Verbindungsaufbau alles schließen }
    Error('VerbindungAufbauen');
    VerbindungAufbauen:=FALSE
  end
  else
    VerbindungAufbauen:=TRUE
end;


procedure SendeText(Socket: tSOCKET; s : string);
begin
  StrPCopy(buffer,s);
  if send(Socket, buffer, StrLen(buffer),0) < StrLen(buffer) then
    Error('SendeText');
end;


function EmpfangeText(Socket: tSOCKET; var s: string) : boolean;
var fehler,i : integer;
begin
  EmpfangeText := True;
  s:='';
  fehler := recv(Socket, buffer, bufsize, 0);
  if (fehler>0) then buffer[fehler]:=#0;
  s:=StrPas(buffer);
  if fehler = SOCKET_ERROR then begin
    EmpfangeText := False;
    Error('Empfangs-');
  end
  else if fehler = 0 then 
    EmpfangeText := False;
end;


procedure CleanUp;
begin
  if WSACleanup <> 0 then Error('Cleanup');
end;


procedure Abbruch(Meldung: string);
begin
  Abort(Meldung)
end;

procedure Fehler(Meldung: String);
begin
  Error(Meldung)
end;

begin
end.