delphi4arab منتديات دلفي للعرب

السلام عليكم ورحمة الله وبركاته
هدا سورس برنامج بسيط للمبتدئين لتحميل الصور من المواقع وضعته بعد ان لاحظت وجود كود سورس في هدا المنتدى ولكن البعض لا يعرف اين يضعه .
قبل كل شيئ انشىء هدا المسار C:\temp في القرص c الدي ستحفظ فيه صورك المحملة بعدها انشئ برنامج جديد في دالفي واضف URLMon, ShellApi; الى uses البرنامج وزر للتحميل وكدلك بعض الاكواد وسيظهر معك الكود سورس بهدا الشكل :

PHP كود :
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,URLMon, ShellApi, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
 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
  // رابط الصورة التي تريد تحميلها  
  SourceFile = 'http://www.google.com/intl/de/images/home_title.gif';
  // مكان حفظ الصورة 
  DestFile = 'c:\temp\google-image.gif';
begin
  if DownloadFile(SourceFile, DestFile) then
  begin
    ShowMessage('Download succesful!');// اظهار رسالةنجاح  تحميل الصورة
    // مشاهدة الصورة المحملة في المتصفح
    ShellExecute(Application.Handle, PChar('open'), PChar(DestFile),
      PChar(''), nil, SW_NORMAL)
  end
  else // اظهار رسالة فشل التحميل
    ShowMessage('Error while downloading ' + SourceFile)
end;

end. 

البرنامج بسيط جدا يمكن تطويره باظافة edittext للصق رابط الصورة الدي تريد تحميلها وكدلك انشاء المسار السابق برمجيا وكدلك اختيار مكان الحفظ برمجيا اردت فقط تبين الفكرة والبقية لكم.
ان كان هناك خطا نبهوني اليه وشكرا
اتمنى الاستفادة من الجميع
و لا تنسونا بصالح دعائكم

هدا الكود غير فعال نوعا ما يعني جربته ملف بي دي ف لكن لا يحمل

هدا كود اخر لكن لم اعرف كيف انفده

كود :
Download a file from the Internet with progress indicator


uses ExtActns, ...

type
   TfrMain = class(TForm)
   ...
   private
     procedure URL_OnDownloadProgress
        (Sender: TDownLoadURL;
         Progress, ProgressMax: Cardinal;
         StatusCode: TURLDownloadStatus;
         StatusText: String; var Cancel: Boolean) ;
   ...

implementation
...

procedure TfrMain.URL_OnDownloadProgress;
begin
   ProgressBar1.Max:= ProgressMax;
   ProgressBar1.Position:= Progress;
end;

function DoDownload;
begin
   with TDownloadURL.Create(self) do
   try
     URL:='http://0.tqn.com/6/g/delphi/b/index.xml';
     FileName := 'c:\ADPHealines.xml';
     OnDownloadProgress := URL_OnDownloadProgress;

     ExecuteTarget(nil) ;
   finally
     Free;
   end;
end;

{
Note:
URL property points to Internet
FileName is the local file





/CODE]


وهذا بالاندي 

Download file using Indy HTTP.pas

[CODE]



begin
 windows.setFileAttributes(pFileName,NONE);//clear file attributes
 result:=windows.deleteFile(pFileName);    //then delete the file
end;

function downloadFile(pUrl,pFileName:pChar):boolean;
var fs:TFileStream;
begin
 result:=false;
 if (pUrl=nil) or (pFileName=nil) then exit;                     //Check arguments
 if fileAge(pFileName)>-1 then forceDeleteFile(pFileName);       //Delete existing file
 try fs:=TFileStream.Create(pFileName,fmCreate) except exit end; //Create file stream
 with TIdHttp.Create(nil) do begin                               //Create http object
  request.userAgent:=INET_USERAGENT;                             //Define user agent
  redirectMaximum:=INET_REDIRECT_MAX;                            //Redirect maxumum
  handleRedirects:=INET_REDIRECT_MAX<>NONE;                      //Handle redirects
  try get(pUrl,fs);result:=fs.size>NONE except end;              //Do the request
  free                                                           //Free the http object
 end;fs.free;                                                    //Free the file stream
end;

//..

function boolToStr(bl:boolean):ansiString;
begin
 if bl then result:='yes' else result:='no';
end;

procedure TForm1.FormCreate(Sender: TObject);
var aUrl,aFileName:ansiString;
begin
 aUrl      := 'http://www.mortenbs.com/music/qual4.gif';
 aFileName := 'C:\qual4.gif';
 caption:=boolToStr(downloadFile(pAnsiChar(aUrl),pAnsiChar(aFileName)));
end;

انا لم يصلح معي ولا واحد

ممكن واحد يتحفنا ببرنامج بالكود سورس

السورس الدي وضعته لتحميل الصور كما قلت لم اجرب ملفات pdf على كل حال جاري الاطلاع على الكود الدي وضعته انت

bassem_43

panchho1

bassem_43