إنشاء خادم FTP

الكود التالي يستعمل لإنشاء خادم لتحويل الملفات باستخدام بروتوكول 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;

- يمكن تحميل الكود على الرابط التالي :
تحميل الكود
يمكن تحميل البرنامج على الرابط التالي:تحميل التطبيق