Written by xinyiman Febbraio 17, 2014, 05:10:00 pm21468 ViewsRating: 0 (0 Rates)Print
Con questo articolo vedremo come realizzare un semplice socket server, utilizzando le librerie synapse. Diamo per scontato che abbiamo installato e configurato tali librerie. Apriamo Lazarus e creiamo una nuova applicazione console che salveremo con il nome "serverSock" e andiamo a sostituire le unit presenti con le seguenti
procedure TMyServer.DoRun; var ErrorMsg: String; app: TTCPEchoDaemon; begin // quick check parameters ErrorMsg:=CheckOptions('h','help'); if ErrorMsg'' then begin ShowException(Exception.Create(ErrorMsg)); Terminate; Exit; end;
// parse parameters if HasOption('h','help') then begin WriteHelp; Terminate; Exit; end;
{ add your program here } app:=TTCPEchoDaemon.create; app.Execute; // stop program loop Terminate; end;
constructor TMyServer.Create(TheOwner: TComponent); begin inherited Create(TheOwner); StopOnException:=True; end;
destructor TMyServer.Destroy; begin inherited Destroy; end;
procedure TMyServer.WriteHelp; begin { add your help code here } writeln('Usage: ',ExeName,' -h'); end;
var Application: TMyServer; begin Application:=TMyServer.Create(nil); Application.Title:='My Server Test'; Application.Run; Application.Free; end.
Constructor TTCPEchoDaemon.Create; begin inherited create(false); sock:=TTCPBlockSocket.create; FreeOnTerminate:=true; end;
Destructor TTCPEchoDaemon.Destroy; begin Sock.free; end;
procedure TTCPEchoDaemon.Execute; var ClientSock:TSocket; Porta: string; Host: string; begin Porta:='2408'; Host:='0.0.0.0'; with sock do begin CreateSocket; setLinger(true,10000); bind(Host,Porta); listen; repeat if terminated then break; if canread(1000) then begin ClientSock:=accept; if lastError=0 then TTCPEchoThrd.create(ClientSock); end; until false; end; end;
{ TEchoThrd }
Constructor TTCPEchoThrd.Create(Hsock:TSocket); begin inherited create(false); Csock := Hsock; FreeOnTerminate:=true; end;
procedure TTCPEchoThrd.Execute; var s: string; begin sock:=TTCPBlockSocket.create; try Sock.socket:=CSock; sock.GetSins; with sock do begin repeat if terminated then break; s := RecvPacket(60000); //devo eliminare i caratteri di andata a capo, altrimenti sono //nella stringa letta e non riesco a fare i controlli s:=stringReplace(s, #13 , '', [RfReplaceAll]); s:=stringReplace(s, #10 , '', [RfReplaceAll]); if lastError0 then break;
if s='GETDATE' then begin GetDate(sock); end else if s='GETHOUR' then begin GetHour(sock); end else if s='GETMENU' then begin GetMenu(sock); end else begin SendString('Comando non valido: ' + s + System.LineEnding); SendString('Comandi validi: ' + System.LineEnding); SendString('GETDATE' + System.LineEnding); SendString('GETHOUR' + System.LineEnding); SendString('GETMENU' + System.LineEnding); end; writeln(Sock.GetRemoteSinIP + ': '+ IntToStr(Sock.GetRemoteSinPort) + ' (' + IntToStr(Self.ThreadID) + ')--> ' + s);
if lastError0 then break; until false; end; finally Sock.Free; end; end;
end.
Per prima cosa andiamo ad impostare i dati essenziali per la messa online del server e quindi cerchiamo le seguenti righe
Porta:='2408'; Host:='0.0.0.0';
e modifichiamole come più ci aggrada. In seconda battuta prendiamo atto che la procedura da personalizzare in funzione delle nostre esigenze ha il seguente nome:
procedure TTCPEchoThrd.Execute;
All'interno di tale procedura notiamo che la prima cosa che si fa è mettersi in ascolto in attesa di una stringa, alla quale andiamo ad eliminare i caratteri tipici del tasto "INVIO" o "ENTER"
s := RecvPacket(60000); //devo eliminare i caratteri di andata a capo, altrimenti sono //nella stringa letta e non riesco a fare i controlli s:=stringReplace(s, #13 , '', [RfReplaceAll]); s:=stringReplace(s, #10 , '', [RfReplaceAll]);
if s='GETDATE' then begin GetDate(sock); end else if s='GETHOUR' then begin GetHour(sock); end else if s='GETMENU' then begin GetMenu(sock); end else begin SendString('Comando non valido: ' + s + System.LineEnding); SendString('Comandi validi: ' + System.LineEnding); SendString('GETDATE' + System.LineEnding); SendString('GETHOUR' + System.LineEnding); SendString('GETMENU' + System.LineEnding); end;
Che ha lo scopo di interpretare il comando ricevuto precedentemente, nel caso il comando coincida con GETDATE o con GETTIME o GETMENU allora il server effettua l'operazione corrispondente, diversamente il server ritorna al client (che può essere anche una sessione telnet) la lista dei comandi validi. Poi troviamo la seguente riga
che ha lo scopo di scrivere sullo standard output del server l'indirizzo ip del client seguito dal numero di porta, dall'identificativo del thread che può essere usato come identificativo di sessione e poi il comando ricevuto dal client.
procedure GetDate(var sock: TTCPBlockSocket); begin with sock do begin SendString(DateToStr(Date) + System.LineEnding); end; end;
procedure GetHour(var sock: TTCPBlockSocket); begin with sock do begin SendString(TimeToStr(Time) + System.LineEnding); end; end;
procedure GetMenu(var sock: TTCPBlockSocket); begin with sock do begin SendString('-------------------------------------' + System.LineEnding); SendString('| PROVA DI UN |' + System.LineEnding); SendString('| SEMPLICE |' + System.LineEnding); SendString('| MENU |' + System.LineEnding); SendString('| !!! |' + System.LineEnding); SendString('-------------------------------------' + System.LineEnding); end; end;
end.
Quest'ultima unit contiene il codice che risponde ai comandi validi del server, con GETDATE inviamo al client la data attuale sul server, con GETTIME inviamo l'ora e con GETMENU inviamo un simil menù con aspetto retrò.
Per far funzionare il tutto dobbiamo
Progetto -> Opzioni progetto -> Varie
e in Opzioni Personalizzate inseriamo la seguente stringa: -dUseCThreads
Ora compiliamo, e avviamo l'eseguibile dal Terminale/Console/Prompt, poi avviamo un altro Terminale/Console/Prompt e digitiamo (nel caso Host e Porta non siamo cambiati) il comando: telnet localhost 2408 Ovviamente se cambiate il numero di porta agite di conseguenza nel parametrizzare la sessione telnet.
About the author
xinyiman registered at Italian community of Lazarus and Free Pascal on Ottobre 14, 2011, 10:56:28 pm and has posted 3263 posts in the boards since then. Last visit was Oggi alle 09:12:20 am.
Questo blog non rappresenta una testata giornalistica poiché viene
aggiornato senza alcuna periodicità. Non può pertanto considerarsi un
prodotto editoriale ai sensi della legge n. 62/2001.
Questo sito utilizza cookie, anche di terze parti, per offriti servizi in linea con le tue preferenze. Chiudendo questo banner, scorrendo questa pagina, cliccando su un link o proseguendo la navigazione in altra maniera, acconsenti all’uso dei cookie.