برمجة وبرامج


أهلا وسهلا بك زائرنا الكريم, أنت لم تقم بتسجيل الدخول بعد! يشرفنا أن تقوم بالدخول أو التسجيل إذا رغبت بالمشاركة في المنتدى

منتدى هواة البرامج » المنتدى التقني » نصوص برمجية بلغة الدلفي » إنشاء خادم FTP

إنشاء خادم FTP

اذهب الى الأسفل  رسالة [صفحة 1 من اصل 1]

1 إنشاء خادم FTP في الأحد مارس 01, 2015 8:06 pm

sol2121

avatar
مشارك
الكود التالي يستعمل لإنشاء خادم لتحويل الملفات باستخدام بروتوكول FTP .
البرنامج مكتوب بلغة الدلفي وباستعمال المكتبة Indy10.
وهذه صورة للبرناج :

- البرنامج يحتوي : على العناصر التالية :
الكود:
IdFTPServer1: TIdFTPServer;
    btnClose: TButton;
    moNotes: TMemo;

- لتحويل الملفات عن طريق هذا الخادم يمكن استخدام أي كلمة المرور وأي اسم مستخدم . على المنفذ 21.
- وهذا نص الكود بكامله :
- الإجراء : IdFTPServer1UserLogin ويستعمل لتسجيل دخول المستخدم :
الكود:
procedure TForm1.IdFTPServer1UserLogin(ASender: TIdFTPServerContext;
  const AUsername, APassword: string; var AAuthenticated: Boolean);
begin
  // We just set AAuthenticated to true so any username//password is accepted
   You should check them here - AUsername and APassword//
  AAuthenticated := True;
end;
-الإجراء IdFTPServer1RemoveDirectory لحذف مجلد :
الكود:
procedure TForm1.IdFTPServer1RemoveDirectory(ASender: TIdFTPServerContext;
  var VDirectory: string);
Var
  LFile: String;
begin
  LFile := ReplaceChars(AppDir + VDirectory);
  // You should delete the directory here.
  // TODO
end;
- الإجراء IdFTPServer1MakeDirectory لإنشاء مجلد :
الكود:
procedure TForm1.IdFTPServer1MakeDirectory(ASender: TIdFTPServerContext;
  var VDirectory: string);
begin
  if not ForceDirectories(ReplaceChars(AppDir + VDirectory)) then
  begin
    Raise Exception.Create('لا يمكن إنشاء مجلد');
  end;
end;
- الإجراء التالي لعرض قائمة المجلدات :
الكود:
procedure TForm1.IdFTPServer1ListDirectory(ASender: TIdFTPServerContext;
  const APath: string; ADirectoryListing: TIdFTPListOutput;
  const ACmd, ASwitches: string);
var
  LFTPItem: TIdFTPListItem;
  SR: TSearchRec;
  SRI: Integer;
begin
  ADirectoryListing.DirFormat := doUnix;
  SRI := FindFirst(AppDir + APath + '\*.*', faAnyFile - faHidden -
    faSysFile, SR);
  While SRI = 0 do
  begin
    LFTPItem := ADirectoryListing.Add;
    LFTPItem.FileName := SR.Name;
    LFTPItem.Size := SR.Size;
    LFTPItem.ModifiedDate := FileDateToDateTime(SR.Time);
    if SR.Attr = faDirectory then
      LFTPItem.ItemType := ditDirectory
    else
      LFTPItem.ItemType := ditFile;
    SRI := FindNext(SR);
  end;
  FindClose(SR);
  SetCurrentDir(AppDir + APath + '\..');
end;
- الإجراء التالي لحفظ الملفات :
الكود:
procedure TForm1.IdFTPServer1StoreFile(ASender: TIdFTPServerContext;
  const AFileName: string; AAppend: Boolean; var VStream: TStream);
begin
  if not AAppend then
    VStream := TFileStream.Create(ReplaceChars(AppDir + AFileName), fmCreate)
  else
    VStream := TFileStream.Create(ReplaceChars(AppDir + AFileName), fmOpenWrite)
end;
- الكود التالي لعرص حجم الملف  :
الكود:
procedure TForm1.IdFTPServer1GetFileSize(ASender: TIdFTPServerContext;
  const AFileName: string; var VFileSize: Int64);
Var
  LFile: String;
begin
  LFile := ReplaceChars(AppDir + AFileName);
  try
    If FileExists(LFile) then
      VFileSize := GetSizeOfFile(LFile)
    else
      VFileSize := 0;
  except
    VFileSize := 0;
  end;
end;
الكود التالي لاستقبال ملف وحفظه :
الكود:
procedure TForm1.IdFTPServer1RetrieveFile(ASender: TIdFTPServerContext;
  const AFileName: string; var VStream: TStream);
begin
  VStream := TFileStream.Create(ReplaceChars(AppDir + AFileName), fmOpenRead);
end;
الإجراء التالي لإيقاف  الخادم :
الكود:
procedure TForm1.btnCloseClick(Sender: TObject);
begin
  IdFTPServer1.Active := false;
  close;
end;
- يمكن تحميل الكود على الرابط التالي :
تحميل الكود
يمكن تحميل البرنامج على الرابط التالي:تحميل التطبيق

معاينة صفحة البيانات الشخصي للعضو

الرجوع الى أعلى الصفحة  رسالة [صفحة 1 من اصل 1]

صلاحيات هذا المنتدى:
لاتستطيع الرد على المواضيع في هذا المنتدى