FAQ DelphiConsultez toutes les FAQ

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
  
procedure DownloadHTTP(const AUrl : string; out DestStream: TStream); 
begin 
  with TIdHTTP.Create(Application) do 
  try 
    try 
      Get(AUrl, DestStream); 
    except 
      on e: Exception do 
        MessageDlg(Format('Erreur : %s',[e.Message]), mtInformation, [mbOK], 0); 
    end; 
  finally 
    Free; 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
procedure TForm1.Button1Click(Sender: TObject); 
var 
  Fs : TFileStream; 
begin 
  Fs := TFileStream.Create('c:\test.txt', fmCreate); 
  try 
    DownloadHTTP('http://www.developpez.com', TStream(fs)); 
  finally 
    Fs.Free; 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
procedure TForm1.Button1Click(Sender: TObject); 
var 
  Fs : TFileStream; 
begin 
  Fs := TFileStream.Create(IncludeTrailingBackslash( 
    ExtractFilePath(Application.ExeName))+'document.txt', fmCreate); 
  try 
    with IdHTTP do 
    begin 
      Host := '192.168.0.3'; // Hôte 
      Request.Username := 'abc'; // Utilisateur 
      Request.Password := 'abc'; // Mot de passe 
      Request.BasicAuthentication := True; // Auth. BASIC 
      Get('192.168.0.3/', Fs); // Demande le fichier 
    end; 
  finally 
    Fs.Free; 
  end; 
end;

1
2
3
4
5
6
7
8
9
procedure TForm1.IdHTTPWorkBegin(Sender: TObject; AWorkMode: TWorkMode; 
  const AWorkCountMax: Integer); 
begin 
  if AWorkMode = wmRead then // Uniquement quand le composant reçoit des données 
  begin 
    ProgressBar.Max := AWorkCountMax; // Maximum = taille de l'élément 
    ProgressBar.Position := 0; // Position à zéro 
  end; 
end;

1
2
3
4
5
6
procedure TForm1.IdHTTPWork(Sender: TObject; AWorkMode: TWorkMode; 
  const AWorkCount: Integer); 
begin 
  if AWorkMode=wmRead then // Uniquement quand le composant reçoit des données 
    ProgressBar.Position := AWorkCount; 
end;

1
2
3
4
procedure TForm1.IdHTTPWorkEnd(Sender: TObject; AWorkMode: TWorkMode); 
begin 
  ProgressBar.Position := 0; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
procedure TForm1.btnDownloadClick(Sender: TObject); 
var 
  Fs : TFileStream; 
begin 
  Fs := TFileStream.Create(ExtractFilePath(Application.ExeName) 
    +'demo.exe', fmCreate); // Nom du fichier local 
  with IdHTTP do 
  try 
    try 
      // URL du fichier à télécharger 
      Get('http://rabusier.free.fr/mirrors/astase/ultrabackup_setup.exe', Fs);  
    except 
      On E : EIdException do 
        ShowMessage(Format('Erreur durant le téléchargement : %s',[E.Message])); 
      On E : Exception do 
        ShowMessage(Format('Erreur inconnue : %s',[E.Message])); 
    end; 
  finally 
    Fs.Free; //Liberer le flux 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
procedure TForm1.IdHTTPWorkBegin(Sender: TObject; AWorkMode: TWorkMode; 
  const AWorkCountMax: Integer); 
begin 
  if AWorkMode = wmRead then // Uniquement quand le composant reçoit des données 
  begin 
    Label1.Caption := 'Vous téléchargez à 0 Ko/s '; // Init. label 
    FStartDate := Now; // Stocker la date 
    Application.ProcessMessages; // Demander la MAJ. 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
procedure TForm1.IdHTTPWork(Sender: TObject; AWorkMode: TWorkMode; 
  const AWorkCount: Integer); 
var ElapsedTime : Cardinal; 
begin 
  if AWorkMode = wmRead then // Uniquement pendant la réception de données 
  begin 
    ElapsedTime := SecondsBetween(Now, FStartDate); // Calculer le temps de téléchargement 
    if ElapsedTime > 0 then 
    begin 
      Label1.Caption := Format('Vous téléchargez à %s Ko/s', 
        [FormatFloat('0.00', (AWorkCount/1024)/ElapsedTime)]); // MAJ Label. 
      Application.ProcessMessages; 
    end; 
  end; 
end;

IdHttp1.Get('http://localhost/myscript.php?param1=valeur1¶m2=valeur2');

1
2
3
IdHttp1.Get(Format('http://www.mysite.com/cgi-bin/submit.cgi?nom=%s&prenom=%s', 
  [IdHTTP1.URL.PathEncode(EditNom.Text), 
  IdHTTP1.URL.PathEncode(EditPrenom.Text)]));

1
2
3
4
5
6
7
8
9
10
11
12
13
14
procedure TForm1.Button1Click(Sender: TObject); 
var 
  Ts : TStringList; 
begin 
  Ts := TStringList.Create; 
  try 
    Ts.Add('Param1=Valeur1');  
    Ts.Add('Param2=Valeur2'); 
    IdHTTP1.Request.ContentType := 'application/x-www-form-urlencoded';        
    IdHTTP1.Post('http://localhost/myscript.php', Ts); 
  finally 
    Ts.free; 
  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
34
  
procedure GetLinksInHTMLDoc(URL : string; Links : TStrings);  
var HTTP : TIdHTTP;  
    Content, Link : string;  
    Position : integer;  
    BeginPos : Integer; 
begin  
  HTTP := TIdHTTP.Create(nil);  
  try  
    Links.Clear;  
    Content := HTTP.Get(URL);  
  
    Position := 0;  
    while True do  
    begin  
      Position := PosEx('href', Content, Position+1);  
      if Position = 0 then Break;  
      inc(Position, 4);  
      while (Position < Length(Content)) and (Content[Position] in [#0, #10, #13, ' ']) do inc(Position);  
      if Content[Position] <> '=' then Continue;  
      inc(Position);  
      while (Position < Length(Content)) and (Content[Position] in [#0, #10, #13, ' ']) do inc(Position);  
      if Content[Position] <> '"' then Continue;  
      inc(Position);  
      BeginPos := Position;  
      while (Position <= Length(Content)) and (Content[Position] <> '"') do inc(Position);  
  
      Link := Copy(Content, BeginPos, Position-BeginPos);  
      if (Link <> '') and (Links.IndexOf(Link) = -1) then Links.Add(Link);  
    end;  
  finally  
    HTTP.Free;  
  end;  
end;

1
2
3
4
5
6
7
8
  
  TTestForm = class(TForm) 
  private 
    ... 
    FRunning : Boolean; 
  public 
    { Public declarations } 
  end;

1
2
3
4
5
6
7
8
9
10
  
procedure TTestForm.IdHTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; 
  AWorkCountMax: Integer); 
begin 
  if AWorkMode = wmRead then 
  begin 
    FRunning := True; 
    ... 
  end; 
end;

1
2
3
4
5
  
procedure TTestForm.btnStopClick(Sender: TObject); 
begin 
  FRunning := not FRunning; 
end;

1
2
3
4
5
6
7
8
  
procedure TTestForm.IdHTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer); 
begin 
  ... 
  Application.ProcessMessages; 
  if not Frunning then 
    IdHTTP.IOHandler.CloseGracefully; 
end;