?
Solved

FTP server

Posted on 2003-11-22
7
Medium Priority
?
2,161 Views
Last Modified: 2010-04-05
am looking for code to make a FTP server .Thanks
0
Comment
Question by:rihab
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
7 Comments
 
LVL 2

Accepted Solution

by:
TheLeader earned 1000 total points
ID: 9802813
if you would like, I can send it to you by email
anyway, this is the example using indy:
unit mainf;

interface

uses
  Windows, Messages, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls,
  Menus,  SysUtils, Classes, IdIntercept, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdFTP, IdAntiFreezeBase, IdAntiFreeze, IdLogBase, IdLogDebug, IdGlobal,
  IdLogEvent, IdFTPCommon, IdFTPList;

type
  TMainForm = class(TForm)
    DirectoryListBox: TListBox;
    IdFTP1: TIdFTP;
    DebugListBox: TListBox;
    Panel1: TPanel;
    FtpServerEdit: TEdit;
    ConnectButton: TButton;
    Splitter1: TSplitter;
    Label1: TLabel;
    UploadOpenDialog1: TOpenDialog;
    Panel3: TPanel;
    SaveDialog1: TSaveDialog;
    StatusBar1: TStatusBar;
    TraceCheckBox: TCheckBox;
    CommandPanel: TPanel;
    UploadButton: TButton;
    AbortButton: TButton;
    BackButton: TButton;
    DeleteButton: TButton;
    DownloadButton: TButton;
    UserIDEdit: TEdit;
    PasswordEdit: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    IdAntiFreeze1: TIdAntiFreeze;
    ProgressBar1: TProgressBar;
    UsePassive: TCheckBox;
    CurrentDirEdit: TEdit;
    ChDirButton: TButton;
    CreateDirButton: TButton;
    PopupMenu1: TPopupMenu;
    Download1: TMenuItem;
    Upload1: TMenuItem;
    Delete1: TMenuItem;
    N1: TMenuItem;
    Back1: TMenuItem;
    IdLogEvent1: TIdLogEvent;
    HeaderControl1: THeaderControl;
    procedure ConnectButtonClick(Sender: TObject);
    procedure UploadButtonClick(Sender: TObject);
    procedure DirectoryListBoxDblClick(Sender: TObject);
    procedure DeleteButtonClick(Sender: TObject);
    procedure IdFTP1Disconnected(Sender: TObject);
    procedure AbortButtonClick(Sender: TObject);
    procedure BackButtonClick(Sender: TObject);
    procedure IdFTP1Status(axSender: TObject; const axStatus: TIdStatus;
      const asStatusText: String);
    procedure TraceCheckBoxClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure DirectoryListBoxClick(Sender: TObject);
    procedure IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure IdFTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
    procedure UsePassiveClick(Sender: TObject);
    procedure ChDirButtonClick(Sender: TObject);
    procedure CreateDirButtonClick(Sender: TObject);
    procedure IdLogEvent1Received(ASender: TComponent; const AText,
      AData: String);
    procedure IdLogEvent1Sent(ASender: TComponent; const AText,
      AData: String);
    procedure DebugListBoxDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure DirectoryListBoxDrawItem(Control: TWinControl;
      Index: Integer; Rect: TRect; State: TOwnerDrawState);
    procedure HeaderControl1SectionResize(HeaderControl: THeaderControl;
      Section: THeaderSection);
  private
    { Private declarations }
    AbortTransfer: Boolean;
    TransferrignData: Boolean;
    BytesToTransfer: LongWord;
    STime: TDateTime;
    procedure ChageDir(DirName: String);
    procedure SetFunctionButtons(AValue: Boolean);
    procedure SaveFTPHostInfo(Datatext, header: String);
    function GetHostInfo(header: String): String;
    procedure PutToDebugLog(Operation, S1: String);
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

Uses
  IniFiles;   { using the inifiles to put the up in it }

Var
  AverageSpeed: Double = 0;

procedure TMainForm.SetFunctionButtons(AValue: Boolean);
Var
  i: Integer;
begin
  with CommandPanel do
    for i := 0 to ControlCount - 1 do
      if Controls[i].Name <> 'AbortButton' then Controls[i].Enabled := AValue;

  with PopupMenu1 do
    for i := 0 to Items.Count - 1 do Items[i].Enabled := AValue;

  ChDirButton.Enabled := AValue;
  CreateDirButton.Enabled := AValue;
end;

procedure TMainForm.ConnectButtonClick(Sender: TObject);
begin
  ConnectButton.Enabled := false;
  if IdFTP1.Connected then try
    if TransferrignData then IdFTP1.Abort;
    IdFTP1.Quit;
  finally
    CurrentDirEdit.Text := '/';
    DirectoryListBox.Items.Clear;
    SetFunctionButtons(false);
    ConnectButton.Caption := 'Connect';
    ConnectButton.Enabled := true;
    ConnectButton.Default := true;
  end
  else with IdFTP1 do try
    Username := UserIDEdit.Text;
    Password := PasswordEdit.Text;
    Host := FtpServerEdit.Text;
    Connect;
    Self.ChageDir(CurrentDirEdit.Text);
    SetFunctionButtons(true);
    SaveFTPHostInfo(FtpServerEdit.Text, 'FTPHOST');
  finally
    ConnectButton.Enabled := true;
    if Connected then begin
      ConnectButton.Caption := 'Disconnect';
      ConnectButton.Default := false;
    end;
  end;
end;

procedure TMainForm.UploadButtonClick(Sender: TObject);
begin
  if IdFTP1.Connected then begin
    if UploadOpenDialog1.Execute then try
      SetFunctionButtons(false);
      IdFTP1.TransferType := ftBinary;
     
      IdFTP1.Put(UploadOpenDialog1.FileName, ExtractFileName(UploadOpenDialog1.FileName));
      ChageDir(idftp1.RetrieveCurrentDir);
    finally
      SetFunctionButtons(true);
    end;
  end;
end;

procedure TMainForm.ChageDir(DirName: String);
Var
  LS: TStringList;
begin
  LS := TStringList.Create;
  try
    SetFunctionButtons(false);
    IdFTP1.ChangeDir(DirName);
    IdFTP1.TransferType := ftASCII;

    CurrentDirEdit.Text := IdFTP1.RetrieveCurrentDir;

    DirectoryListBox.Items.Clear;
    IdFTP1.List(LS);
    DirectoryListBox.Items.Assign(LS);
    if DirectoryListBox.Items.Count > 0 then
      if AnsiPos('total', DirectoryListBox.Items[0]) > 0 then DirectoryListBox.Items.Delete(0);
  finally
    SetFunctionButtons(true);
    LS.Free;
  end;
end;

procedure TMainForm.DirectoryListBoxDblClick(Sender: TObject);
Var
  Name{, Line}: String;
begin
  if not IdFTP1.Connected then exit;
  //Line := DirectoryListBox.Items[DirectoryListBox.ItemIndex];
  Name := IdFTP1.DirectoryListing.Items[DirectoryListBox.ItemIndex].FileName;
  if IdFTP1.DirectoryListing.Items[DirectoryListBox.ItemIndex].ItemType = ditDirectory then begin
    // Change directory
    SetFunctionButtons(false);
    ChageDir(Name);
    SetFunctionButtons(true);
  end
  else begin
    try
      SaveDialog1.FileName := Name;
      if SaveDialog1.Execute then begin
        SetFunctionButtons(false);

        IdFTP1.TransferType := ftBinary;
        BytesToTransfer := IdFTP1.Size(Name);

        if FileExists(Name) then begin
          case MessageDlg('File aready exists. Do you want to resume the download operation?',
            mtConfirmation, mbYesNoCancel, 0) of
            mrYes: begin
              BytesToTransfer := BytesToTransfer - FileSizeByName(Name);
              IdFTP1.Get(Name, SaveDialog1.FileName, false, true);
            end;
            mrNo: begin
              IdFTP1.Get(Name, SaveDialog1.FileName, true);
            end;
            mrCancel: begin
              exit;
            end;
          end;
        end
        else begin
          IdFTP1.Get(Name, SaveDialog1.FileName, false);
        end;
      end;
    finally
      SetFunctionButtons(true);
    end;
  end;
end;

procedure TMainForm.DeleteButtonClick(Sender: TObject);
Var
  Name: String;
begin
  if not IdFTP1.Connected then exit;
  Name := IdFTP1.DirectoryListing.Items[DirectoryListBox.ItemIndex].FileName;
  if IdFTP1.DirectoryListing.Items[DirectoryListBox.ItemIndex].ItemType = ditDirectory then try
    SetFunctionButtons(false);
    idftp1.RemoveDir(Name);
    ChageDir(idftp1.RetrieveCurrentDir);
  finally
  end
  else
  try
    SetFunctionButtons(false);
    idftp1.Delete(Name);
    ChageDir(idftp1.RetrieveCurrentDir);
  finally
  end;
end;

procedure TMainForm.IdFTP1Disconnected(Sender: TObject);
begin
  StatusBar1.Panels[1].Text := 'Disconnected.';
end;

procedure TMainForm.AbortButtonClick(Sender: TObject);
begin
  AbortTransfer := true;
end;

procedure TMainForm.BackButtonClick(Sender: TObject);
begin
  if not IdFTP1.Connected then exit;
  try
    ChageDir('..');
  finally end;
end;

procedure TMainForm.IdFTP1Status(axSender: TObject; const axStatus: TIdStatus;
  const asStatusText: String);
begin
  DebugListBox.ItemIndex := DebugListBox.Items.Add(asStatusText);
  StatusBar1.Panels[1].Text := asStatusText;
end;

procedure TMainForm.TraceCheckBoxClick(Sender: TObject);
begin
  if TraceCheckBox.Checked then
    IdFtp1.Intercept := IdLogEvent1
  else
    IdFtp1.Intercept := nil;

  DebugListBox.Visible := TraceCheckBox.Checked;
  if DebugListBox.Visible then Splitter1.Top := DebugListBox.Top + 5;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  SetFunctionButtons(false);

  IdFtp1.Intercept := IdLogEvent1;

  FtpServerEdit.Text := GetHostInfo('FTPHOST');

  ProgressBar1.Parent := StatusBar1;
  ProgressBar1.Top := 2;
  ProgressBar1.Left := 1;
  ProgressBar1.Align := alClient;
end;

procedure TMainForm.DirectoryListBoxClick(Sender: TObject);
begin
  if not IdFTP1.Connected then exit;
  if DirectoryListBox.ItemIndex > -1 then begin
  if IdFTP1.DirectoryListing.Items[DirectoryListBox.ItemIndex].ItemType = ditDirectory then DownloadButton.Caption := 'Change dir'
    else DownloadButton.Caption := 'Download';
  end;
end;

procedure TMainForm.IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
Var
  S: String;
  TotalTime: TDateTime;
//  RemainingTime: TDateTime;
  H, M, Sec, MS: Word;
  DLTime: Double;
begin
  TotalTime :=  Now - STime;
  DecodeTime(TotalTime, H, M, Sec, MS);
  Sec := Sec + M * 60 + H * 3600;
  DLTime := Sec + MS / 1000;
  if DLTime > 0 then
    AverageSpeed := {(AverageSpeed + }(AWorkCount / 1024) / DLTime{) / 2};

  if AverageSpeed > 0 then begin
    Sec := Trunc(((ProgressBar1.Max - AWorkCount) / 1024) / AverageSpeed);

    S := Format('%2d:%2d:%2d', [Sec div 3600, (Sec div 60) mod 60, Sec mod 60]);

    S := 'Time remaining ' + S;
  end
  else S := '';

  S := FormatFloat('0.00 KB/s', AverageSpeed) + '; ' + S;
  case AWorkMode of
    wmRead: StatusBar1.Panels[1].Text := 'Download speed ' + S;
    wmWrite: StatusBar1.Panels[1].Text := 'Uploade speed ' + S;
  end;

  if AbortTransfer then IdFTP1.Abort;

  ProgressBar1.Position := AWorkCount;
  AbortTransfer := false;
end;

procedure TMainForm.IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  TransferrignData := true;
  AbortButton.Visible := true;
  AbortTransfer := false;
  STime := Now;
  if AWorkCountMax > 0 then ProgressBar1.Max := AWorkCountMax
  else ProgressBar1.Max := BytesToTransfer;
  AverageSpeed := 0;
end;

procedure TMainForm.IdFTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
  AbortButton.Visible := false;
  StatusBar1.Panels[1].Text := 'Transfer complete.';
  BytesToTransfer := 0;
  TransferrignData := false;
  ProgressBar1.Position := 0;
  AverageSpeed := 0;
end;

procedure TMainForm.UsePassiveClick(Sender: TObject);
begin
  IdFTP1.Passive := UsePassive.Checked;
end;

procedure TMainForm.ChDirButtonClick(Sender: TObject);
begin
  SetFunctionButtons(false);
  ChageDir(CurrentDirEdit.Text);
  SetFunctionButtons(true);
end;

procedure TMainForm.CreateDirButtonClick(Sender: TObject);
Var
  S: String;
begin
  S := InputBox('Make new directory', 'Name', '');
  if S <> '' then
    try
      SetFunctionButtons(false);
      IdFTP1.MakeDir(S);
      ChageDir(CurrentDirEdit.Text);
    finally
      SetFunctionButtons(true);
    end;
end;

procedure TMainForm.SaveFTPHostInfo(Datatext, header: String);
var
  ServerIni: TIniFile;
begin
  ServerIni := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'FtpHost.ini');
  ServerIni.WriteString('Server', header, Datatext);
  ServerIni.UpdateFile;
  ServerIni.Free;
end;

function TMainForm.GetHostInfo(header: String): String;
var
  ServerName: String;
  ServerIni: TIniFile;
begin
  ServerIni := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'FtpHost.ini');
  ServerName := ServerIni.ReadString('Server', header, header);

  ServerIni.Free;
  result := ServerName;
end;

procedure TMainForm.PutToDebugLog(Operation, S1: String);
Var
  S: String;
begin
  while Length(S1) > 0 do begin
    if Pos(#13, S1) > 0 then begin
      S := Copy(S1, 1, Pos(#13, S1) - 1);
      Delete(S1, 1, Pos(#13, S1));
      if S1[1] = #10 then Delete(S1, 1, 1);
    end
    else
      S := S1;

    DebugListBox.ItemIndex := DebugListBox.Items.Add(Operation + S);
  end;
end;

procedure TMainForm.IdLogEvent1Received(ASender: TComponent; const AText,
  AData: String);
begin
  PutToDebugLog('<<- ', AData);
end;

procedure TMainForm.IdLogEvent1Sent(ASender: TComponent; const AText,
  AData: String);
begin
  PutToDebugLog('->> ', AData);
end;

{$IFDEF Linux}
procedure TMainForm.DebugListBoxDrawItem(Sender: TObject; Index: Integer;
  Rect: TRect; State: TOwnerDrawState; var Handled: Boolean);
{$ELSE}
procedure TMainForm.DebugListBoxDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
{$ENDIF}
begin
  if Pos('>>', DebugListBox.Items[index]) > 1 then
    DebugListBox.Canvas.Font.Color := clRed
  else
    DebugListBox.Canvas.Font.Color := clBlue;

  if odSelected in State then begin
    DebugListBox.Canvas.Brush.Color := $00895F0A;
    DebugListBox.Canvas.Font.Color := clWhite;
  end
  else
    DebugListBox.Canvas.Brush.Color := clWindow;

  DebugListBox.Canvas.FillRect(Rect);

  DebugListBox.Canvas.TextOut(Rect.Left, Rect.Top, DebugListBox.Items[index]);
end;

{$IFDEF Linux}
procedure TMainForm.DirectoryListBoxDrawItem(Sender: TObject; Index: Integer;
  Rect: TRect; State: TOwnerDrawState; var Handled: Boolean);
{$ELSE}
procedure TMainForm.DirectoryListBoxDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
{$ENDIF}
Var
  R: TRect;
begin
  if odSelected in State then begin
    DirectoryListBox.Canvas.Brush.Color := $00895F0A;
    DirectoryListBox.Canvas.Font.Color := clWhite;
  end
  else
    DirectoryListBox.Canvas.Brush.Color := clWindow;

  if Assigned(IdFTP1.DirectoryListing) and (IdFTP1.DirectoryListing.Count > Index) then begin
    DirectoryListBox.Canvas.FillRect(Rect);
    with IdFTP1.DirectoryListing.Items[Index] do begin
      DirectoryListBox.Canvas.TextOut(Rect.Left, Rect.Top, FileName);
      R := Rect;

      R.Left := Rect.Left + HeaderControl1.Sections.Items[0].Width;
      R.Right := R.Left + HeaderControl1.Sections.Items[1].Width;
      DirectoryListBox.Canvas.FillRect(R);
      DirectoryListBox.Canvas.TextOut(R.Left, Rect.Top, IntToStr(Size));

      R.Left := R.Right;
      R.Right := R.Left + HeaderControl1.Sections.Items[2].Width;
      DirectoryListBox.Canvas.FillRect(R);

      if ItemType = ditDirectory then begin
        DirectoryListBox.Canvas.TextOut(R.Left, Rect.Top, 'Directory');
      end
      else
        DirectoryListBox.Canvas.TextOut(R.Left, Rect.Top, 'File');

      R.Left := R.Right;
      R.Right := R.Left + HeaderControl1.Sections.Items[3].Width;
      DirectoryListBox.Canvas.FillRect(R);
      DirectoryListBox.Canvas.TextOut(R.Left, Rect.Top, FormatDateTime('mm/dd/yyyy hh:mm', ModifiedDate));

      R.Left := R.Right;
      R.Right := R.Left + HeaderControl1.Sections.Items[4].Width;
      DirectoryListBox.Canvas.FillRect(R);
      DirectoryListBox.Canvas.TextOut(R.Left, Rect.Top, GroupName);

      R.Left := R.Right;
      R.Right := R.Left + HeaderControl1.Sections.Items[5].Width;
      DirectoryListBox.Canvas.FillRect(R);
      DirectoryListBox.Canvas.TextOut(R.Left, Rect.Top, OwnerName);

      R.Left := R.Right;
      R.Right := R.Left + HeaderControl1.Sections.Items[6].Width;
      DirectoryListBox.Canvas.FillRect(R);
      DirectoryListBox.Canvas.TextOut(R.Left, Rect.Top, OwnerPermissions + GroupPermissions + UserPermissions);
    end;
  end;
end;

{$IFDEF Linux}
procedure TMainForm.HeaderControl1SectionResize(HeaderControl: TCustomHeaderControl;
     Section: TCustomHeaderSection);
{$ELSE}
procedure TMainForm.HeaderControl1SectionResize(
  HeaderControl: THeaderControl; Section: THeaderSection);
{$ENDIF}
begin
  DirectoryListBox.Repaint;
end;


end.

hope it helped.
0
 
LVL 1

Expert Comment

by:FeralCTO
ID: 9803152
If you're not interested in programming an FTP server from scratch, download Indy and the sample projects. Indy has an FTP server component. Essentially what that component is, it's a TCP server that has been subclassed and the FTP protocol has been implemented. If you're going to spend any time working with Indy you might want to purchase the "Indy in Depth" ebook. I use Indy and I think it's great. But there's a learning curve and the ebook helped me with that.

http://www.indyproject.org 
http://www.atozedsoftware.com/indy/Book/index.iwp 
0
 
LVL 2

Expert Comment

by:TheLeader
ID: 9844339
"rihab" accept an answer or leave a comment !!!
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 

Author Comment

by:rihab
ID: 9845046
Sorry for not replying cause I have no internet access(Tech pb).
I got the Indy package but it does not contain FTP server it contains TFTP one.
Please  TheLeader  can u send it by mail.
With respect
rihab
0
 
LVL 2

Expert Comment

by:TheLeader
ID: 9845141
you can download it from here, its free
http://www.indyproject.org/download/Indy9.html
0
 
LVL 2

Expert Comment

by:TheLeader
ID: 9845149
if you want the project, write your email
So I can send it to you.
0
 
LVL 4

Expert Comment

by:k4hvd77
ID: 10025702
TheLeader,
the code you posted seems to be a FTP Client not Server!!!!
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
NetCrunch network monitor is a highly extensive platform for network monitoring and alert generation. In this video you'll see a live demo of NetCrunch with most notable features explained in a walk-through manner. You'll also get to know the philos…
In this video, Percona Solution Engineer Rick Golba discuss how (and why) you implement high availability in a database environment. To discuss how Percona Consulting can help with your design and architecture needs for your database and infrastr…
Suggested Courses
Course of the Month15 days, 8 hours left to enroll

741 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question