دخول

bibill · 18-12-2023, 09:57 AM

السلام عليكم
- عندي خادم محلي أنشأت فيه موقع 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;

justnick · 18-12-2023, 08:10 PM

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

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

كود :
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;

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

bibill · 19-12-2023, 09:04 AM

السلام عليكم

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

bibill · 19-12-2023, 11:41 AM

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

كود :
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;

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

justnick · 19-12-2023, 04:40 PM

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

justnick · 29-01-2024, 05:43 PM

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

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

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

دخول
اسم المستخدم/البريد الالكتروني :
كلمة المرور :	فقدت كلمة المرور ؟
	تذكرني بالمرة القادمة