DS Unix TCP/IP-Client in Delphi

{
  PASCAL-Source-Beispiel für die Verwendung von winsock.dll
  Client-Programm, zugehöriges Server-Programm für Unix 'DS_UnixServer.txt'
  Von: Daniel Schwamm (www.daniel-schwamm.de; dschwamm@henrys.de)
}

{
  Sende einen String 'cmdtxt' zu Server;
  im Fehlerfall enthält 'cmdtxt' Fehlermeldung,
  daher 'cmdtxt' ausreichend dimensionieren
}
function SendStringToServer(cmdtxt:pchar):integer;
var
  rc:integer;
  sockfd:tsocket;
begin
  rc:=0;

  {kontakiere server}
  if ConnectCNS(sockfd,cmdtxt)<0 then begin
    result:=-1;
    exit;
  end;

  {versende 'cmdtxt'}
  if SendCMD(sockfd,cmdtxt)<0 then begin
    result:=-1;
    exit;
  end;

  {hole antwort vom server}
  if GetCMD(sockfd,cmdtxt)<0 then begin
    result:=-1;
    exit;
  end;

  {schlie0e verbindung}
  DisconnectCNS(sockfd,cmdtxt);

  result:=rc;
end;


{------- TCP/IP-Service-Fuktionen ------------------------------}

{Eigene Konstanten, restl. Konstanten in winsock.h}
const
  _PORTNR = 4500;
  _IPADRESSE = '193.158.55.18';


{
  Aufbereitung von Fehlermeldungen nach 'cmdtxt'
  'et' enthält Errormessage
  ==> et-Text (Winsockfehlernummer)
}
function MkErrTxt(var sockfd:longint;cmdtxt,et:pchar):longint;
var
  str:array[0..10] of char;
  sp:string[10];
begin
  strcopy(cmdtxt,et);
  strcat(cmdtxt,' (');
  sp:=inttostr(WSAGetLastError)+#0;
  strpcopy(str,sp);
  strcat(cmdtxt,str);
  strcat(cmdtxt,')');
  disconnectcns(sockfd,cmdtxt);
  result:=-1;
end;

{
Kontakte Server mit IP _IPADRESSE, der auf Port _PORTNR lauscht;
es ist egal, ob Server unter UNIX, Windows oder sonstwas läuft
}
function ConnectCNS(var sockfd:longint;cmdtxt:pchar):longint;
var
  data:TWSADATA;
  rc:integer;
  servaddr:TSockAddrIn;
  i:integer;
begin
  {initialisiere winsock.dll}
  rc:=WSAStartup($0101,data);
  if rc<>0 then begin
    result:=MkErrTxt(
      sockfd,cmdtxt,'WSAStartup misslungen (Winsock Version 1.1)'
    );
    exit;
  end;

  {
    bereite TCP/IP-verbindung vor (nicht UDP/IP);
    falls IP-Adresse vom Server nicht bekannt oder dynamisch,
    dann winsock-Funktion 'getserverbyname()' verwenden
  }
  servaddr.sin_family:=AF_INET;
  servaddr.sin_port:=htons(_PORTNR);
  servaddr.sin_addr.s_addr:=inet_addr(_IPADRESSE);
  if servaddr.sin_addr.s_addr=INADDR_NONE then begin
    result:=MkErrTxt(sockfd,cmdtxt,'Server-Adresse nicht zuweisbar');
    exit;
  end;
  for i:=0 to 7 do begin
    servaddr.sin_zero[i]:=#0;
  end;

  {öffne lokalen Socket}
  sockfd:=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
  if sockfd<0 then begin
    result:=MkErrTxt(sockfd,cmdtxt,'Kann Socket-Stream nicht öffnen');
    exit;
  end;

  {
    kontaktiere server; kann ein paar sekunden dauern;
    timeout bei winsock ca. 1 Minute
  }
  rc:=connect(sockfd,@TSockAddr(servaddr),sizeof(servaddr));
  if rc<0 then begin
    result:=MkErrTxt(
      sockfd,
      cmdtxt,
      'Kann Server nicht kontaktieren. Fehlernummer: '
    );
    exit;
  end;
  result:=rc;
end;

{Sende Kommandostring 'cmdtxt' an CN-Server}
function SendCMD(var sockfd:longint;cmdtxt:pchar):longint;
var
  n,m:integer;
begin
  result:=0;
  n:=strlen(cmdtxt);
  m:=send(sockfd,cmdtxt,n,0);
  if m<>n then begin
    result:=MkErrTxt(sockfd,cmdtxt,'SendCMD: Zuwenig Bytes übertragen');
  end;
end;

{Hole Kommandostring 'cmdtxt' vom Server}
function GetCMD(var sockfd:longint;cmdtxt:pchar):longint;
var
  n:integer;
  wrdtxt:array[0..100]of char;
begin
  result:=0;
  n:=recv(sockfd,cmdtxt,_MAXSTR,0);
  if n<0 then begin
    result:=MkErrTxt(sockfd,cmdtxt,'Konnte Kommando nicht empfangen');
    exit;
  end;
  cmdtxt[n]:=#0;
end;

{schliesse verbindung}
function DisconnectCNS(var sockfd:longint;cmdtxt:pchar):longint;
begin
  if sockfd>0 then begin
    closesocket(sockfd);
  end;
  result:=WSACleanup;
end;