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

السلام عليكم
- عندي خادم محلي أنشأت فيه موقع FTP
ارسل اليه ملفات في شبكة محلية
أستخدم دلفي 2010
السؤال كيف أتحقق من وجود الملف قبل الارسال و أحذف الملف القديم و أعوضه بالجديد ؟

كود :
procedure TForm1.ButtonSendImageClick(Sender: TObject);
var
  ImagePath, RemotePath: string;
begin
  // عرض مربع حوار لاختيار ملف الصورة
  if OpenDialog1.Execute then
  begin
    ImagePath := OpenDialog1.FileName;
    RemotePath := '/bkh/' + ExtractFileName(ImagePath);

    try
      IdFTP1.Host := '192.168.1.66';
      IdFTP1.Username := EditUsername.Text;
      IdFTP1.Password := EditPassword.Text;

      IdFTP1.Connect;

      // Check if the connection was successful
      if IdFTP1.Connected then
      begin
        // تأكيد وجود المسار على الخادم
        if not DirectoryExists('/bkh/') then
          IdFTP1.MakeDir('/bkh/');

        // قم بنقل الملف إلى الخادم
        IdFTP1.Put(ImagePath, RemotePath);

        MemoLog.Lines.Add('Image sent successfully');

        IdFTP1.Disconnect;
      end
      else
      begin
        MemoLog.Lines.Add('Failed to connect to FTP server');
      end;
    except
      on E: Exception do
        MemoLog.Lines.Add('Error: ' + E.Message);
    end;
  end;
end;

السلام عليكم ورحمة الله

هذا جزء من برنامج يقوم تقريبا بنفس الفكرة

كود :
procedure TfrMain.CreateOrOpenDirectoryOnFTPServer;
var
  I: Integer;
  myYear: string;
  myMonth: string;
  myDate: string;
  IsDirectoryExists: Boolean;
begin
  IsDirectoryExists := False;

  if IdFTP1.Connected then
  begin
    Memo1.Lines.Add('Connected to ' + IdFTP1.Host);
    Memo1.Lines.Add('Start check if the remote folders exists');
    myYear := IntToStr(YearOf(Date));

    myMonth := FormatSettings.LongMonthNames[MonthOf(Date)];

    myDate := FormatDateTime('YYYYMMDD', Date);

    IdFTP1.List;
    for I := 0 to IdFTP1.DirectoryListing.Count - 1 do
    begin
      if IdFTP1.DirectoryListing.Items[I].FileName = myYear then
      begin
        IsDirectoryExists := True;
        Break;
      end;
    end;

    if not IsDirectoryExists then
    begin
      IdFTP1.MakeDir(myYear);
    end;

    IsDirectoryExists := False;
    IdFTP1.ChangeDir(myYear);
    IdFTP1.List;

    for I := 0 to IdFTP1.DirectoryListing.Count - 1 do
    begin
      if IdFTP1.DirectoryListing.Items[I].FileName = myMonth then
      begin
        IsDirectoryExists := True;
        Break;
      end;
    end;

    if not IsDirectoryExists then
    begin
      IdFTP1.MakeDir(myMonth);
    end;

    IsDirectoryExists := False;
    IdFTP1.ChangeDir(myMonth);
    IdFTP1.List;

    for I := 0 to IdFTP1.DirectoryListing.Count - 1 do
    begin
      if IdFTP1.DirectoryListing.Items[I].FileName = myDate then
      begin
        IsDirectoryExists := True;
        Break;
      end;
    end;

    if not IsDirectoryExists then
    begin
      IdFTP1.MakeDir(myDate);
    end;

    IdFTP1.ChangeDir(myDate);

  end;
end;

ملحوظة البرنامج كله مفتوح المصدر اذا اردت الاطلاع عليه اخبرنى

السلام عليكم

عند التنفيذ يضهر رسالة الخطأ
No FTP list parsers have been registered
يبدو أن list لا ترجع القائمة

السلام عليكم
الكود التالي يعمل بشكل صحيح

كود :
function FTPFileExists(AFTPClient: TIdFTP; const ADirectory, AFile: string): Boolean;
var
  AOldDir: string;
  FolderList: TStringList;
begin
  Result := False;
  try
    if not AFTPClient.Connected then
      AFTPClient.Connect();
  except
    Exit;
  end;
  try
    FolderList := TStringList.Create;
    AOldDir := AFTPClient.RetrieveCurrentDir;
    try
      AFTPClient.ChangeDir(ADirectory);
      try
        AFTPClient.List(FolderList, '', False);
      finally
        Result := FolderList.IndexOf(AFile) > -1;
      end;
    except
    end;
  finally
    AFTPClient.ChangeDir(AOldDir);
    FolderList.Free;
  end;
end;


procedure TForm1.CheckFTPFileExistence;
var
  FTPDirectory, FTPFileName: string;
  TargetFile: string;

begin
  // تعيين معلومات الاتصال بالخادم FTP

  FTPDirectory := '/bkh/';
  FTPFileName := '1111.jpg';

  // تحديد المسار المستهدف للتنزيل الملف
  TargetFile := ExtractFilePath(Application.ExeName) + FTPFileName;

try
    // التحقق من وجود الملف
    if FTPFileExists(IdFTP1, FTPDirectory, FTPFileName) then
      ShowMessage('الملف موجود على الخادم FTP.')
    else
      ShowMessage('الملف غير موجود على الخادم FTP.');

  finally
    // قم بفصل الاتصال بالخادم FTP بغض النظر عن نجاح أو فشل
  end;
end;

شكرا على التفاعل .

ماشاء الله -- الله ينور

السلام عليكم ورحمة الله وبركاته

هذا الكود كامل لمشروع قمت ببرمجته سابقا

PHP كود :
https://github.com/Shoulah/FTP-Uploader-and-archiver 

bibill

justnick

bibill

bibill

justnick

justnick