FAQ DelphiConsultez toutes les FAQ

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread); 
begin 
  with AThread.Connection do 
  try 
    try 
//Travail à effectuer 
    except 
//Notification d'une erreur au client 
on E : Exception do 
  WriteLn(Format('ERROR : %s',[e.Message])); 
    end; 
  finally 
    Disconnect; //Fermeture de la connexion 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
procedure ShutdownServer(const AHost : string; const APort : integer); 
begin 
  with IdTCPClient do 
  begin 
    Port := APort; 
    Host := AHost; 
    try 
      Connect; //connecte 
      Try 
  IdTCPClient.WriteLn('shutdown -h -t 00'); //envoie la ligne de commande 
  if IdTCPClient.ReadLn()<>'OK' then //attend la réponse. Si <> de OK, erreur : 
    MessageDlg('Erreur : l''exécution a été refusée par le serveur.', 
  mtInformation, [mbOK], 0); 
      finally 
  Disconnect; //dans tous les cas, se déconnecter 
      end; 
    except 
      MessageDlg('Une erreur est survenue durant l''envoi de commandes', mtError, [mbOK], 0); 
    end; 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
procedure TForm1.IdTCPServerExecute(AThread: TIdPeerThread); 
var 
  Line, Command, Args : String; 
begin 
  Line := AThread.Connection.ReadLn(); //Lire une ligne 
  AThread.Connection.WriteLn('OK'); //Signifie que la demande a été correctement reçue. 
  //On pourrait renvoyer autre chose pour notifier un refus d'exécution. 
  if Pos(' ',Line)>0 then 
  begin //Il y a un/des paramètre(s), il faut extraire Commande et Arguments 
    Command := Copy(Line,1,Pred(Pos(' ',Line))); 
    Args := Copy(Line,Succ(Pos(' ',Line)),Length(Line)) 
  end else 
  begin //Aucun paramètre. Commande = toute la ligne reçue 
    Command := Line; 
    Args := ''; 
  end; 
  //Exécuter la ligne de commande 
  ShellExecute(Handle,nil,PChar(Command),PChar(Args),nil,SW_SHOWNORMAL); 
end;

1
2
3
4
5
6
7
8
procedure TForm1.IdTCPServerConnect(AThread: TIdPeerThread); 
begin 
with (AThread.Connection) do 
begin 
    Intercept := TIdCompressionIntercept.Create(nil); // Créer le "compresseur" 
    TIdCompressionIntercept(Intercept).CompressionLevel := 9; // Niveau de compression 
end; 
end;

1
2
3
4
5
6
7
8
9
10
11
procedure TForm1.IdTCPServerDisconnect(AThread: TIdPeerThread); 
begin 
  with (AThread.Connection) do  
  begin 
    if Assigned(Intercept) then // Assigné ? 
    begin 
      Intercept.Free; // On libère... 
      Intercept := nil;  
    end; 
  end; 
end;

1
2
3
4
5
  TClient  = record 
      Nom : string[50]; 
      Adresse : string[200]; 
      CodeVille : integer; 
  end;

IdTCPClient.WriteBuffer(ARecord,sizeof(ARecord),true);

AThread.Connection.ReadBuffer(Recv,Sizeof(Recv));

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
function TForm1.SendFile(const AFileName: string; 
  ATcpClient: TIdTCPClient) : Boolean; 
  var 
    Fs : TFileStream; 
begin 
  Result := False; 
  ATcpClient.Connect(); //Connecte. Les propriétés Host et Port doivent être remplies. 
  try 
    Fs := TFileStream.Create(AFileName,fmOpenRead,fmShareDenyWrite); //Créer le flux 
    try 
      ATcpClient.WriteLn(Format('TRANS %s',[ExtractFileName(AFileName)])); //demander transfert 
      try 
        ATcpClient.WriteInteger(Fs.Size); //Ecrire la taille 
        ATcpClient.WriteStream(Fs); //Ecrit le flux 
      except 
        MessageDlg('Erreur pendant l''envoi du fichier.', mtError, [mbOK], 0); 
      end; 
    finally 
      FreeAndNil(Fs); //Libérer le flux 
      Result := ATcpClient.ReadLn()='OK'; //OK uniquement si le serveur a renvoyé "OK" 
    end; 
  finally 
    ATcpClient.Disconnect; //Déconnecter à la fin. 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
procedure TForm1.IdTCPServerExecute(AThread: TIdPeerThread); 
var 
  Line, FileName : String; 
  i, FileSize : integer; 
  Fs : TFileStream; 
begin 
  with AThread.Connection do 
  try 
    Line := ReadLn(); //Attends une commande de la forme TRANS suivi du nom de fichier 
    i := Pos(' ',Line); 
    if (i>0) and (LowerCase(Copy(Line,1,Pred(i)))='trans') then 
    begin 
      FileName := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) 
      + Copy(Line,Succ(i),Length(Line)); //Copier nom de fichier 
      Fs := TFileStream.Create(FileName,fmCreate); //Créer le flux 
      try 
        try 
          FileSize := ReadInteger(); //Lire la taille 
          ReadStream(Fs,FileSize,False); //Lire le flux 
          WriteLn('OK'); //Signaler succès 
        except 
          WriteLn('ERR'); //Signaler une erreur 
        end; 
      finally 
        FreeAndNil(Fs); //Libérer le flux dans tous les cas 
      end; 
    end 
    else 
      WriteLn('ERR'); //Commande incomprise 
  finally 
    Disconnect; //A la fin, on déconnecte 
  end; 
end;

1
2
3
4
5
6
7
8
9
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  IdTCPClient.Host := 'localhost'; //Hôte 
  IdTCPClient.Port := 1985; //Le serveur doit aussi écouter sur le port 1985 
  if SendFile('c:\setup.exe',IdTCPClient) then 
    MessageDlg('Ok !', mtInformation, [mbOK], 0) 
  else 
    MessageDlg('Erreur...', mtInformation, [mbOK], 0) 
end;

1
2
3
4
  TFtpClient = class(TObject) 
    RootPath : String; // L'information à mémoriser 
    Thread : Pointer; // Pointe vers le thread client 
  end;

1
2
3
4
5
6
7
8
9
procedure TMainForm.IdFTPServerAfterUserLogin(ASender: TIdFTPServerThread); 
var 
  AClient : TFtpClient; 
begin 
  AClient := TFtpClient.Create; // Création 
  AClient.Thread := ASender; // Association Objet->Thread attaché 
  AClient.RootPath := 'Donnée à mémoriser';  
  ASender.Data := AClient; // Associer l'objet au thread 
end;

1
2
3
4
5
procedure TMainForm.IdFTPServerMakeDirectory(ASender: TIdFTPServerThread; 
  var APath : string; 
begin 
  APath := StrGetRealPathName(TFTPClient(ASender.Data).RootPath,ASender.CurrentDir,VDirectory); 
  ...

1
2
3
4
5
6
7
8
9
10
11
procedure TMainForm.IdFTPServerDisconnect(AThread: TIdPeerThread); 
var 
  AClient : TFtpClient; 
begin 
  AClient := TFtpClient(AThread.Data); // On récupère l'objet 
  if AClient <> nil then // Si le client a une structure associée... 
  begin 
    FreeAndNil(AClient); // on la détruit 
    AThread.Data := nil;  
  end; 
end;

IdUDPClt.Send('Host', 'Port', 'Le message à envoyer');

1
2
3
4
5
6
7
8
9
10
11
12
13
procedure TForm1.UDPSrvUDPRead(Sender: TObject; AData: TStream; 
  ABinding: TIdSocketHandle); 
var 
  DataStringStream: TStringStream; 
begin 
  DataStringStream := TStringStream.Create(''); 
  try 
    DataStringStream.CopyFrom(AData, AData.Size); 
    ShowMessage('Reçu : "' + DataStringStream.DataString + '" De : ' + ABinding.PeerIP + ' sur le port : ' + IntToStr(ABinding.PeerPort)); 
  finally 
    DataStringStream.Free; 
  end; 
end;