uses Forms, URLMon, Wininet, IdHTTP, IdComponent; type TEventHandler = class procedure HttpWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer); end; var ProgressBar1: TProgressBar; Form1: TForm; procedure TEventHandler.HttpWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer); var Http: TIdHTTP; ContentLength: Int64; Percent: Integer; origin : cardinal; begin Http := TIdHTTP(ASender); if not InternetGetConnectedState(@origin,0) then begin Application.MessageBox('Connection lost!','Warning',MB_OK+MB_ICONWARNING); Abort; end; ContentLength := Http.Response.ContentLength; if (Pos('chunked', LowerCase(Http.Response.ResponseText)) = 0) and (ContentLength > 0) then begin Percent := 100*AWorkCount div ContentLength; ProgressBar1.Position := Round(Percent); Form1.Refresh; end else begin Percent := 99; ProgressBar1.Position := Round(Percent); Form1.Refresh; end; end; function DownloadFile(SourceFile, DestFile: string): Boolean; const RECV_BUFFER_SIZE = 32768; var HttpClient: TIdHttp; FileSize: Int64; Buffer: TMemoryStream; handler: TEventHandler; origin : cardinal; begin HttpClient := TIdHttp.Create(nil); try if not InternetGetConnectedState(@origin,0) then begin Application.MessageBox('No internet connection available!','Warning',MB_OK+MB_ICONWARNING); Abort; end; try HttpClient.Head(SourceFile); except Application.MessageBox('No internet connection available!','Warning',MB_OK+MB_ICONWARNING); Abort; end; FileSize := HttpClient.Response.ContentLength; Buffer := TMemoryStream.Create; try Form1 := TForm.Create(nil); Form1.Width := 400; Form1.Height := 200; Form1.Caption := 'Download file'; Form1.Position := poDesktopCenter; ProgressBar1 := TProgressBar.Create(Form1); ProgressBar1.Parent := Form1; ProgressBar1.Width := 300; ProgressBar1.Height := 40; ProgressBar1.Left := 20; ProgressBar1.Top := 50; ProgressBar1.Max := 100; Form1.Show; while Buffer.Size < FileSize do begin HttpClient.Request.ContentRangeStart := Buffer.Size; if Buffer.Size + RECV_BUFFER_SIZE < FileSize then HttpClient.Request.ContentRangeEnd := Buffer.Size + RECV_BUFFER_SIZE - 1 else HttpClient.Request.ContentRangeEnd := FileSize; handler := TEventHandler.Create; HttpClient.OnWork:= handler.HttpWork; HttpClient.Get(HttpClient.URL.URI, Buffer); // wait until it is done Buffer.SaveToFile(DestFile); ProgressBar1.Position := 99; ProgressBar1.Refresh; Form1.Refresh; Sleep(2000); end; finally Buffer.Free; ProgressBar1.Free; Form1.Free; end; finally HttpClient.Free; end; end;
ON THIS BLOG, DELPHI PROGRAMMERS CAN FIND FREE USEFUL FUNCTIONS AND PROCEDURES
Download file with Delphi
Categories:
Files functions
Subscribe to:
Posts (Atom)