Function MessageErreurSocket( ErrorEvent: TErrorEvent; var ErrorCode: Integer):String;
var
ErrorMsg: string;
begin
// définition du message d'erreur en fonction du code d'erreur
case ErrorCode of
10004: ErrorMsg:= '. Chiamata di Funzione interrotta';
10013: ErrorMsg:= 'Autorizzazione negata.';
10014: ErrorMsg:= '. Indirizzo sbagliato';
10022: ErrorMsg:= '. Invalides Arguments';
10024: ErrorMsg:= 'Troppi file aperti.';
10035: ErrorMsg:= 'Risorsa temporaneamente non disponibile.';
10036: ErrorMsg:= '. Operazione in corso';
10037: ErrorMsg:= '. Operazione già in corso';
10038: ErrorMsg:= 'operazione Socket sulla non-presa.';
10039: ErrorMsg:= '. Indirizzo di destinazione richiesto';
10040: ErrorMsg:= 'Messaggio troppo lungo.';
10041: ErrorMsg:= 'Protocollo tipo sbagliato di socket per.';
10042: ErrorMsg:= '. Variante di protocollo Bad';
10043: ErrorMsg:= 'Protocollo non supportato.';
10044: ErrorMsg:= '. Tipo di socket non supportato';
10045: ErrorMsg:= 'Operazione non supportata.';
10046: ErrorMsg:= '. Famiglia Protocollo non supportato';
10047: ErrorMsg:= 'famiglia indirizzi non supportata dalla famiglia di protocolli.';
10048: ErrorMsg:= 'Indirizzo già in uso.';
10049: ErrorMsg:= 'Non è possibile assegnare richiesto indirizzo.';
10050: ErrorMsg:= 'rete non funziona.';
10051: ErrorMsg:= 'rete è irraggiungibile.';
10052: ErrorMsg:= 'Network caduto il collegamento on reset.';
10053: ErrorMsg:= 'Software causato interruzione di connessione.';
10054: ErrorMsg:= 'Connessione ripristinata dal peer.';
10055: ErrorMsg:= 'Nessuno spazio buffer disponibile.';
10056: ErrorMsg:= '. Socket è già collegato';
10057: ErrorMsg:= 'Socket non è collegato.';
10058: ErrorMsg:= 'Impossibile inviare dopo l'arresto del socket.';
10060: ErrorMsg:= 'Connessione scaduta.';
10061: ErrorMsg:= 'Connessione rifiutata.';
10064: ErrorMsg:= 'Host è giù.';
10065: ErrorMsg:= 'No route to host.';
10067: ErrorMsg:= 'troppi processi.';
10091: ErrorMsg:= 'sottosistema di rete non è disponibile.';
10092: ErrorMsg:= '. WINSOCK.DLL Versione fuori campo';
10093: ErrorMsg:= '. WSAStartup successo non ancora eseguita';
10094: ErrorMsg:= '. Arresto regolare in progress';
11001: ErrorMsg:= '. Host non trovato';
11002: ErrorMsg:= 'ospite non autorevole non trovato.';
11003: ErrorMsg:= 'Questo è un errore non recuperabile.';
11004: ErrorMsg:= '. Nome valido, nessun record di dati di tipo richiesto';
else
// Errore sconosciuto
ErrorMsg := 'Errore di presa sconosciuto.';
end;
// Formattazione il significato dell'errore
ErrorMsg := 'Socket Errore n°' + IntToStr(ErrorCode) + ' : ' + ErrorMsg;
// L'errore viene trattato
ErrorCode := 0;
// Imposta il tipo di errore
case ErrorEvent of
eeSend : ErrorMsg := 'Writing ' + ErrorMsg;
eeReceive : ErrorMsg := 'Reading ' + ErrorMsg;
eeConnect : ErrorMsg := 'Connecting ' + ErrorMsg;
eeDisconnect : ErrorMsg := 'Disconnecting ' + ErrorMsg;
eeAccept : ErrorMsg := 'Accepting ' + ErrorMsg;
else
// Errore sconosciuto
ErrorMsg := 'Unknown ' + ErrorMsg;
end;
Result:=ErrorMsg;
end;
//
//**************************************************************************************
//**************************************************************************************
// Struttura telaio utilizzato per il trading
//
Const
TailleBloc = 256;
Type
TIPTrame=Packed Record
Case ttType:Integer Of // ttType specifica il tipo di telaio
// = 1 quando si tratta di un nome di file
// = 2 quando è un file di song
1:(
ttNomFichier:String[255]; // Nome Del File
);
2:( ttDebut : Integer; // indirizzo iniziale dei dati nel file
ttLong : Integer; // Lunghezza dei dati inviati
ttDatas : Array[0..TailleBloc-1] Of Byte ) // I dati inviati
End;
//
//**************************************************************************************
//**************************************************************************************
// SERVER
// Questa sezione si applica solo al server
Var
ServeurEnReception : Boolean = False; // = True quando la ricezione è di essere
ServeurAdresseClient : String = ''; // Indirizzo di client connesso
ServeurFichier : File; // File utilizzato per pezzi di backup
procedure TForm1.btnOpenClick(Sender: TObject);
begin
// Bouton de mise en écoute du serveur, c'est tout simple
Serveur.Open;
MemoServeur.Lines.Add('Serveur en écoute');
end;
procedure TForm1.btnCloseClick(Sender: TObject);
begin
// Bouton de fermeture du serveur, c'est aussi tout simple
If ServeurEnReception
And (MessageDlg('Un transfert est en cours, fermer le serveur ?',mtConfirmation,[mbYes,mbNo],0)=mrYes)
Then Begin
Serveur.Close;
MemoServeur.Lines.Add('Serveur desactivé');
End;
end;
//
// évènements du socket serveur
//
procedure TForm1.ServeurClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
// C'est juste pour signaler
MemoServeur.Lines.Add('OnConnect:'+Socket.RemoteAddress);
end;
procedure TForm1.ServeurClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
MemoServeur.Lines.Add('OnDisconnect:'+Socket.RemoteAddress);
// Le client se deconnecte => ou ferme le fichier en cours si besoin
If ServeurEnReception
Then Begin
CloseFile(ServeurFichier);
ServeurEnReception:=False;
End;
end;
procedure TForm1.ServeurClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
// On ne fait que signaler l'erreur
MemoServeur.Lines.Add('OnClientError:'+Socket.RemoteAddress+#13+MessageErreurSocket(ErrorEvent,ErrorCode));
end;
procedure TForm1.ServeurClientRead(Sender: TObject;
Socket: TCustomWinSocket);
Var Buffer:TIPTrame;
Erreur:Integer;
Recus :Integer;
begin
// C'est ici la partie principale du serveur
// Cette procédure est appelée à chaque écriture d'un client
Erreur :=0;
Recus :=Socket.ReceiveLength; // Longueur reçue ( en octets )
MemoServeur.Lines.Add('OnRead'+Socket.RemoteAddress+' reçus '+IntToStr(Recus));
If Recus<= SizeOf(Buffer) // On vérifie que la longueur reçue tient dans la trame
// sinon attention au plantage !!!
Then With Buffer Do Begin
// Lecture de la trame reçue
Socket.ReceiveBuf(Buffer,Recus);
// En fonction du type de la trame on effectue les traitements
Case ttType Of
1:Begin
// C'est une nouvelle demande, on vérifie le nom du fichier
// La longueur de la trame doit être au minimumu de
// 4 ( taille de ttType ) + 1 ( longueur de la chaine ttNomFichier ) + Length(ttNomFichier)
If (Recus>=5)And(Recus>=(5+Length(ttNomFichier)))
Then Begin
// La longueur est bonne, on accepte la demande
MemoServeur.Lines.Add(ttNomFichier);
// On ferme le fichier précédent au cas ou
If ServeurEnReception Then CloseFile(ServeurFichier);
// On ouvre le fichier de réception en écriture
AssignFile(ServeurFichier,ExtractFilePath(ParamStr(0))+ttNomFichier);
Try
Rewrite(ServeurFichier,1);
ServeurEnReception:=True;
Erreur:=0;
Except
Erreur:=5; // Erreur de création du fichier
End;
End
Else Erreur:=2; // La longueur reçue est trop courte
End;
2:Begin
// On reçoit un morceau de fichier
// La longueur de la trame doit être au minimumu de
// 4 ( taille de ttType ) + 4 ( taille de ttDebut ) + 4 ( taille de ttLong )
// + ttLong ( nombre de données envoyées )
If (Recus>=12)And(Recus>=(12+ttLong))
Then Begin
// Le morceau n'est accepté que si une demande est en cours
If ServeurEnReception
Then Begin
// Le morceau n'est accepté que si le début du fichier à déjà été reçu
If (ttDebut>=0)And(ttDebut<=FileSize(ServeurFichier))
Then Begin
Try
// Si tout est bon on écrit le morceau dans le fichier
Seek(ServeurFichier,ttDebut);
BlockWrite(ServeurFichier,ttDatas,ttLong);
Erreur:=0; // C'est bon
Except
Erreur:=6; // Erreur d'écriture du fichier
End;
End
Else Erreur:=4; // La position 'début' n'est pas correcte
End
Else Erreur:=3; // On n'a pas reçue de demande
End
Else Erreur:=2; // La longueur reçue est trop courte
End;
End;// fin du case
End
Else Erreur:=1; // La longueur reçue est trop grande
// Dans tout les cas on envoie le code d'erreur au client
Socket.SendBuf(Erreur,4);
MemoServeur.Lines.Add(' Code de retour :'+IntToStr(Erreur));
end;
