• ¡Welcome to Square Theme!
  • This news are in header template.
  • Please ignore this message.
مهمان عزیز خوش‌آمدید. ورود عضــویت


امتیاز موضوع:
  • 18 رای - 2.61 میانگین
  • 1
  • 2
  • 3
  • 4
  • 5
Title: سورس کد دانلود فایل از طریق Ftp (دلفی)
حالت موضوعی
#1
با تابع زیر میتونید با قرارا دادن یوزر و پسوورد و همچنین ادرس ftp وارد محل اف تی پی سایت مورد نظر شید و فایل مرد نظر خودتون رو دانلود کنید.



تابع زیر از توابع wininet.dll هم استفاده میکند و برای اجرا نیاز به کنترل TProgressBar و Tlabel دارید.



سورس کد :





کد:
uses

  WinInet, ComCtrls;



function FtpDownloadFile(strHost, strUser, strPwd: string;

  Port: Integer; ftpDir, ftpFile, TargetFile: string;

  ProgressBar: TProgressBar): Boolean;



  function FmtFileSize(Size: Integer): string;

  begin

    if Size >= $F4240 then

      Result := Format('%.2f', [Size / $F4240]) + ' Mb'

    else

    if Size < 1000 then

      Result := IntToStr(Size) + ' bytes'

    else

      Result := Format('%.2f', [Size / 1000]) + ' Kb';

  end;



const

  READ_BUFFERSIZE = 4096;  // or 256, 512, ...

var

  hNet, hFTP, hFile: HINTERNET;

  buffer: array[0..READ_BUFFERSIZE - 1] of Char;

  bufsize, dwBytesRead, fileSize: DWORD;

  sRec: TWin32FindData;

  strStatus: string;

  LocalFile: file;

  bSuccess: Boolean;

begin

  Result := False;



  { Open an internet session }

  hNet := InternetOpen(

    'Program_Name', // Agent

    INTERNET_OPEN_TYPE_PRECONFIG, // AccessType

    nil,  // ProxyName

    nil,  // ProxyBypass

    0     // or INTERNET_FLAG_ASYNC / INTERNET_FLAG_OFFLINE

  );



  {

    Agent contains the name of the application or

    entity calling the Internet functions

  }



  { See if connection handle is valid }

  if hNet = nil then

  begin

    ShowMessage('Unable to get access to WinInet.Dll');

    Exit;

  end;



  { Connect to the FTP Server }

  hFTP := InternetConnect(

    hNet, // Handle from InternetOpen

    PChar(strHost), // FTP server

    port, // (INTERNET_DEFAULT_FTP_PORT),

    PChar(StrUser), // username

    PChar(strPwd),  // password

    INTERNET_SERVICE_FTP, // FTP, HTTP, or Gopher?

    0, // flag: 0 or INTERNET_FLAG_PASSIVE

    0  // User defined number for callback

  );



  if hFTP = nil then

  begin

    InternetCloseHandle(hNet);

    ShowMessage(Format('Host "%s" is not available',[strHost]));

    Exit;

  end;



  { Change directory }

  bSuccess := FtpSetCurrentDirectory(hFTP, PChar(ftpDir));



  if not bSuccess then

  begin

    InternetCloseHandle(hFTP);

    InternetCloseHandle(hNet);

    ShowMessage(Format('Cannot set directory to %s.',[ftpDir]));

    Exit;

  end;



  { Read size of file }

  if FtpFindFirstFile(hFTP, PChar(ftpFile), sRec, 0, 0) <> nil then

  begin

    fileSize := sRec.nFileSizeLow;

    // fileLastWritetime := sRec.lastWriteTime

  end else

  begin

    InternetCloseHandle(hFTP);

    InternetCloseHandle(hNet);

    ShowMessage(Format('Cannot find file ',[ftpFile]));

    Exit;

  end;



  { Open the file }

  hFile := FtpOpenFile(

    hFTP, // Handle to the ftp session

    PChar(ftpFile), // filename

    GENERIC_READ, // dwAccess

    FTP_TRANSFER_TYPE_BINARY, // dwFlags

    0 // This is the context used for callbacks.

  );



  if hFile = nil then

  begin

    InternetCloseHandle(hFTP);

    InternetCloseHandle(hNet);

    Exit;

  end;



  { Create a new local file }

  AssignFile(LocalFile, TargetFile);

  {$i-}

  Rewrite(LocalFile, 1);

  {$i+}



  if IOResult <> 0 then

  begin

    InternetCloseHandle(hFile);

    InternetCloseHandle(hFTP);

    InternetCloseHandle(hNet);

    Exit;

  end;



  dwBytesRead := 0;

  bufsize := READ_BUFFERSIZE;



  while (bufsize > 0) do

  begin

    Application.ProcessMessages;



    if not InternetReadFile(

      hFile,

      @buffer, // address of a buffer that receives the data

      READ_BUFFERSIZE, // number of bytes to read from the file

      bufsize // receives the actual number of bytes read

    ) then Break;



    if (bufsize > 0) and (bufsize <= READ_BUFFERSIZE) then

      BlockWrite(LocalFile, buffer, bufsize);

    dwBytesRead := dwBytesRead + bufsize;



    { Show Progress }

    ProgressBar.Position := Round(dwBytesRead * 100 / fileSize);

    Form1.Label1.Caption :=

      Format(

        '%s of %s / %d %%',

        [

          FmtFileSize(dwBytesRead),

          FmtFileSize(fileSize),

          ProgressBar.Position

        ]

      );

  end;



  CloseFile(LocalFile);



  InternetCloseHandle(hFile);

  InternetCloseHandle(hFTP);

  InternetCloseHandle(hNet);

  Result := True;

end;
گروه دور همی پارسی کدرز
https://t.me/joinchat/GxVRww3ykLynHFsdCvb7eg
 
پاسخ
  


موضوعات مشابه ...
موضوع نویسنده پاسخ بازدید آخرین ارسال
  سورس کد انتقال فایل به سطل اشغال ( دلفی) Amin_Mansouri 1 1,838 10-08-2022، 06:21 PM
آخرین ارسال: sonusood
  سورس بدست اوردن کلیپ برد ( دلفی ) Amin_Mansouri 1 1,939 10-08-2022، 05:49 PM
آخرین ارسال: sonusood
  دلفی و تلگرام h_mohamadi 2 2,640 04-24-2017، 12:14 AM
آخرین ارسال: shilanaseri
  رسم نمودار در اکسل از طریق دلفی Saeed7007 1 4,408 08-14-2014، 06:11 PM
آخرین ارسال: Amin_Mansouri
  سورس کد بدست اوردن اطلاعات هارد دیسک (دلفی) Amin_Mansouri 1 6,794 07-30-2014، 05:45 PM
آخرین ارسال: dehqan_mehdi
  ۳۵۰ سورس کد دلفی (دلفی رو از ابتدا تا حرفه ای شدن یاد بگیرید) Amin_Mansouri 11 26,962 01-31-2014، 04:27 PM
آخرین ارسال: Amin_Mansouri
  بارگذاری و یا نمایش تصویر فرمت jpg (دلفی) Amin_Mansouri 2 8,709 08-23-2013، 10:06 PM
آخرین ارسال: mo_coders
  بدست اوردن لیست درایورهای موجود بر روی سیستم توسط API (دلفی) Amin_Mansouri 0 3,606 08-17-2013، 09:56 AM
آخرین ارسال: Amin_Mansouri
  دانلود سورس کد استفاده از نقشه گوگل در دلفی Amin_Mansouri 0 5,447 08-17-2013، 09:44 AM
آخرین ارسال: Amin_Mansouri
  سورس کد شناسایی مرورگرهای نصب شده بر روی سیستم عامل (دلفی) Amin_Mansouri 0 3,767 08-17-2013، 09:35 AM
آخرین ارسال: Amin_Mansouri

پرش به انجمن:


Browsing: 1 مهمان