Results 1 to 11 of 11

Thread: [DELPHI] - Download Files

Threaded View

  1. #1

    Thread Starter
    Supreme User Madboy's Avatar
    Join Date
    Oct 2003
    Location
    England
    Posts
    3,253

    [DELPHI] - Download Files

    UPDATED WITH NEW METHOD

    Code:
    unit Unit1;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, WinInet;
    
    type
      TForm1 = class(TForm)
        Button1: TButton;
        procedure Button1Click(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    
    function GetInetFile(const fileURL, FileName: String): boolean;
    const BufferSize = 1024;
    var
      hSession, hURL: HInternet;
      Buffer: array[1..BufferSize] of Byte;
      BufferLen: DWORD;
      f: File;
      sAppName: string;
    begin
    Result:=False;
    sAppName := ExtractFileName(Application.ExeName);
    hSession := InternetOpen(PChar(sAppName),
                    INTERNET_OPEN_TYPE_PRECONFIG,
                   nil, nil, 0);
    try
      hURL := InternetOpenURL(hSession,
                PChar(fileURL),
                nil,0,0,0);
      try
       AssignFile(f, FileName); 
       Rewrite(f,1); 
       repeat
        InternetReadFile(hURL, @Buffer, 
                         SizeOf(Buffer), BufferLen);
        BlockWrite(f, Buffer, BufferLen) 
       until BufferLen = 0;
       CloseFile(f); 
       Result:=True;
      finally 
       InternetCloseHandle(hURL)
      end 
    finally
      InternetCloseHandle(hSession) 
    end
    end;
    
    procedure TForm1.Button1Click(Sender: TObject);
    var
      InternetFile,LocalFile: string;
    begin
    InternetFile:='http://www.vbforums.com/images/icons/icon6.gif';
    LocalFile:='D:/Cool.gif';
    
    if GetInetFile(InternetFile,LocalFile)=True then
       ShowMessage('download')
    else
      ShowMessage('Can not download the files');
    end;
    
    end.
    Code:
    Uses
    
    URLMon, ShellApi;
    
    function DownloadFile(SourceFile, DestFile: string): Boolean;
    begin
      try
        Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0, nil) = 0;
      except
        Result := False;
      end;
    end;
    
    procedure TForm1.Button1Click(Sender: TObject);
    const
      // URL Location
      SourceFile = 'http://www.vbforums.com/member.php?u=45760';
      // Where to save the file
      DestFile = 'C:\Image.gif';
    begin
      if DownloadFile(SourceFile, DestFile) then
        ShowMessage('Download succesful!');
      else
        ShowMessage('Error while downloading ' + SourceFile)
    end;
    Last edited by Madboy; Jul 22nd, 2005 at 02:59 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width