Servidor Ftp
 

Hola a todos, necesito instalar un servidor FTP, alguien conoce alguno, que me recomiendan??, experiencias??

No se como sea la versión Server del FileZilla, supongo que debe ser muy buena, ademas de todo es gratuito.

Pero una vez tuve la oportunidad de usar un Trial del ServU y la impresion que me dio es que es genial, en http://www.principiantes.info/servid...rvu_afondo.php hay una pequeñisima introducción de su utilización.

gracias jhonny voy a probar

Yo tengo algo para crear un FTP virtual(mientras la aplicacion se ejecuta)
 

:)
unit FTP;
interface
uses
Classes,
windows,
sysutils,
IdFTPList,
IdFTPServer,
idtcpserver,
IdSocketHandle,
idglobal,
IdHashCRC;
type
TFTPServer = class
{ Private declarations }
IdFTPServer: tIdFTPServer;
procedure IdFTPServer1UserLogin( ASender: TIdFTPServerThread; const AUsername, APassword: string; var AAuthenticated: Boolean ) ;
procedure IdFTPServer1ListDirectory( ASender: TIdFTPServerThread; const APath: string; ADirectoryListing: TIdFTPListItems ) ;
procedure IdFTPServer1RenameFile( ASender: TIdFTPServerThread; const ARenameFromFile, ARenameToFile: string ) ;
procedure IdFTPServer1RetrieveFile( ASender: TIdFTPServerThread; const AFilename: string; var VStream: TStream ) ;
procedure IdFTPServer1StoreFile( ASender: TIdFTPServerThread; const AFilename: string; AAppend: Boolean; var VStream: TStream ) ;
procedure IdFTPServer1RemoveDirectory( ASender: TIdFTPServerThread; var VDirectory: string ) ;
procedure IdFTPServer1MakeDirectory( ASender: TIdFTPServerThread; var VDirectory: string ) ;
procedure IdFTPServer1GetFileSize( ASender: TIdFTPServerThread; const AFilename: string; var VFileSize: Int64 ) ;
procedure IdFTPServer1DeleteFile( ASender: TIdFTPServerThread; const APathname: string ) ;
procedure IdFTPServer1ChangeDirectory( ASender: TIdFTPServerThread; var VDirectory: string ) ;
procedure IdFTPServer1CommandXCRC( ASender: TIdCommand ) ;
procedure IdFTPServer1DisConnect( AThread: TIdPeerThread ) ;
protected
function TransLatePath( const APathname, homeDir: string ) : string;
public
constructor Create; reintroduce;
destructor Destroy; override;
end;
implementation
uses FTpconfiguracion, inicio;
constructor TFTPServer.Create;
begin
IdFTPServer := tIdFTPServer.create( nil ) ;
IdFTPServer.DefaultPort := 21;
IdFTPServer.AllowAnonymousLogin := False;
IdFTPServer.EmulateSystem := ftpsUNIX;
IdFTPServer.HelpReply.text := 'Help is not implemented';
IdFTPServer.OnChangeDirectory := IdFTPServer1ChangeDirectory;
IdFTPServer.OnChangeDirectory := IdFTPServer1ChangeDirectory;
IdFTPServer.OnGetFileSize := IdFTPServer1GetFileSize;
IdFTPServer.OnListDirectory := IdFTPServer1ListDirectory;
IdFTPServer.OnUserLogin := IdFTPServer1UserLogin;
IdFTPServer.OnRenameFile := IdFTPServer1RenameFile;
IdFTPServer.OnDeleteFile := IdFTPServer1DeleteFile;
IdFTPServer.OnRetrieveFile := IdFTPServer1RetrieveFile;
IdFTPServer.OnStoreFile := IdFTPServer1StoreFile;
IdFTPServer.OnMakeDirectory := IdFTPServer1MakeDirectory;
IdFTPServer.OnRemoveDirectory := IdFTPServer1RemoveDirectory;
IdFTPServer.Greeting.NumericCode := 220;
IdFTPServer.OnDisconnect := IdFTPServer1DisConnect;
with IdFTPServer.CommandHandlers.add do
begin
Command := 'XCRC';
OnCommand := IdFTPServer1CommandXCRC;
end;
IdFTPServer.Active := true;
end;
function CalculateCRC( const path: string ) : string;
var
f: tfilestream;
value: dword;
IdHashCRC32: TIdHashCRC32;
begin
IdHashCRC32 := nil;
f := nil;
try
IdHashCRC32 := TIdHashCRC32.create;
f := TFileStream.create( path, fmOpenRead or fmShareDenyWrite ) ;
value := IdHashCRC32.HashValue( f ) ;
result := inttohex( value, 8 ) ;
finally
f.free;
IdHashCRC32.free;
end;
end;
procedure TFTPServer.IdFTPServer1CommandXCRC( ASender: TIdCommand ) ;
// note, this is made up, and not defined in any rfc.
var
s: string;
begin
with TIdFTPServerThread( ASender.Thread ) do
begin
if Authenticated then
begin
try
s := ProcessPath( CurrentDir, ASender.UnparsedParams ) ;
s := TransLatePath( s, TIdFTPServerThread( ASender.Thread ) .HomeDir ) ;
ASender.Reply.SetReply( 213, CalculateCRC( s ) ) ;
except
ASender.Reply.SetReply( 500, 'file error' ) ;
end;
end;
end;
end;
destructor TFTPServer.Destroy;
begin
IdFTPServer.free;
inherited destroy;
end;
function StartsWith( const str, substr: string ) : boolean;
begin
result := copy( str, 1, length( substr ) ) = substr;
end;
function BackSlashToSlash( const str: string ) : string;
var
a: dword;
begin
result := str;
for a := 1 to length( result ) do
if result[a] = '\' then
result[a] := '/';
end;
function SlashToBackSlash( const str: string ) : string;
var
a: dword;
begin
result := str;
for a := 1 to length( result ) do
if result[a] = '/' then
result[a] := '\';
end;
function TFTPServer.TransLatePath( const APathname, homeDir: string ) : string;
var
tmppath: string;
begin
result := SlashToBackSlash( homeDir ) ;
tmppath := SlashToBackSlash( APathname ) ;
if homedir = '/' then
begin
result := tmppath;
exit;
end;
if length( APathname ) = 0 then
exit;
if result[length( result ) ] = '\' then
result := copy( result, 1, length( result ) - 1 ) ;
if tmppath[1] <> '\' then
result := result + '\';
result := result + tmppath;
end;
function GetSizeOfFile( const APathname: string ) : int64;
begin
result := FileSizeByName( APathname ) ;
end;
function GetNewDirectory( old, action: string ) : string;
var
a: integer;
begin
if action = '../' then
begin
if old = '/' then
begin
result := old;
exit;
end;
a := length( old ) - 1;
while ( old[a] <> '\' ) and ( old[a] <> '/' ) do
dec( a ) ;
result := copy( old, 1, a ) ;
exit;
end;
if ( action[1] = '/' ) or ( action[1] = '\' ) then
result := action
else
result := old + action;
end;
procedure TFTPServer.IdFTPServer1UserLogin( ASender: TIdFTPServerThread;
const AUsername, APassword: string; var AAuthenticated: Boolean ) ;
begin
AAuthenticated := ( AUsername = form3.Edit1.Text ) and ( APassword = form3.Edit2.Text ) ;
if not AAuthenticated then
exit;
ASender.HomeDir := Form3.Edit3.Text;
asender.currentdir := '\';
end;
procedure TFTPServer.IdFTPServer1ListDirectory( ASender: TIdFTPServerThread; const APath: string; ADirectoryListing: TIdFTPListItems ) ;
procedure AddlistItem( aDirectoryListing: TIdFTPListItems; Filename: string; ItemType: TIdDirItemType; size: int64; date: tdatetime ) ;
var
listitem: TIdFTPListItem;
begin
listitem := aDirectoryListing.Add;
listitem.ItemType := ItemType;
listitem.FileName := Filename;
listitem.OwnerName := 'camartinez';
listitem.GroupName := 'all';
listitem.OwnerPermissions := '---';
listitem.GroupPermissions := '---';
listitem.UserPermissions := '---';
listitem.Size := size;
listitem.ModifiedDate := date;
end;
var
f: tsearchrec;
a: integer;
begin
ADirectoryListing.DirectoryName := apath;
a := FindFirst( TransLatePath( apath, ASender.HomeDir ) + '*.*', faAnyFile, f ) ;
while ( a = 0 ) do
begin
if ( f.Attr and faDirectory > 0 ) then
AddlistItem( ADirectoryListing, f.Name, ditDirectory, f.size, FileDateToDateTime( f.Time ) )
else
AddlistItem( ADirectoryListing, f.Name, ditFile, f.size, FileDateToDateTime( f.Time ) ) ;
a := FindNext( f ) ;
end;
FindClose( f ) ;
end;
procedure TFTPServer.IdFTPServer1RenameFile( ASender: TIdFTPServerThread;
const ARenameFromFile, ARenameToFile: string ) ;
begin
if not MoveFile( pchar( TransLatePath( ARenameFromFile, ASender.HomeDir ) ) , pchar( TransLatePath( ARenameToFile, ASender.HomeDir ) ) ) then
RaiseLastWin32Error;
end;
procedure TFTPServer.IdFTPServer1RetrieveFile( ASender: TIdFTPServerThread;
const AFilename: string; var VStream: TStream ) ;
begin
VStream := TFileStream.create( translatepath( AFilename, ASender.HomeDir ) , fmopenread or fmShareDenyWrite ) ;
end;
procedure TFTPServer.IdFTPServer1StoreFile( ASender: TIdFTPServerThread;
const AFilename: string; AAppend: Boolean; var VStream: TStream ) ;
begin
if FileExists( translatepath( AFilename, ASender.HomeDir ) ) and AAppend then
begin
VStream := TFileStream.create( translatepath( AFilename, ASender.HomeDir ) , fmOpenWrite or fmShareExclusive ) ;
VStream.Seek( 0, soFromEnd ) ;
end
else
VStream := TFileStream.create( translatepath( AFilename, ASender.HomeDir ) , fmCreate or fmShareExclusive ) ;
end;
procedure TFTPServer.IdFTPServer1RemoveDirectory( ASender: TIdFTPServerThread;
var VDirectory: string ) ;
begin
RmDir( TransLatePath( VDirectory, ASender.HomeDir ) ) ;
end;
procedure TFTPServer.IdFTPServer1MakeDirectory( ASender: TIdFTPServerThread;
var VDirectory: string ) ;
begin
MkDir( TransLatePath( VDirectory, ASender.HomeDir ) ) ;
end;
procedure TFTPServer.IdFTPServer1GetFileSize( ASender: TIdFTPServerThread;
const AFilename: string; var VFileSize: Int64 ) ;
begin
VFileSize := GetSizeOfFile( TransLatePath( AFilename, ASender.HomeDir ) ) ;
end;
procedure TFTPServer.IdFTPServer1DeleteFile( ASender: TIdFTPServerThread;
const APathname: string ) ;
begin
DeleteFile( pchar( TransLatePath( ASender.CurrentDir + '/' + APathname, ASender.HomeDir ) ) ) ;
end;
procedure TFTPServer.IdFTPServer1ChangeDirectory( ASender: TIdFTPServerThread;
var VDirectory: string ) ;
begin
VDirectory := GetNewDirectory( ASender.CurrentDir, VDirectory ) ;
end;
procedure TFTPServer.IdFTPServer1DisConnect( AThread: TIdPeerThread ) ;
begin
end;
end.

yo lo tengo montado en un Proyecto que recien termine esto con mucho mas.
tienen que hacer el enlace como lo muestra la uses de esta unit

esta interesante, pero lo que necesito es un servidor para administrar unas descargas

Por ahi hubieses comenzado amigo eduarcol, aquí tienes la respuesta a tus plegarias :D:D:D

Salud OS

jejeje, pues le agradezco a mi presidente, no tengo dolares :(

bueno asi aprendo a la mala, me toca configurar mi propio ftp

Hombre pues no compres dolares, compra euros :D:D:D

Salud OS

Ahhh, ¿Osea que Eduardo no necesitaba un servidor FTP, si no un hosting?, creo que deberas mejorar la calidad de tus preguntas Eduardo :D:D:D

momento que los conozco y se por donde vienen, desvirtualizadores de hilos, lo que necesito es eso, un servidor FTP que lo pueda correr en una maquina y acceder a el eso es todo

Bueno, ¿Y ya probaste los que te mencione?

:rolleyes::rolleyes::rolleyes::rolleyes::confused::confused::eek::eek:

Que paso, no metan indiscreciones aquí. :D

Salud OS

Les sirvio lo que les di(gratuitamente)
 

espero que mi esfuerzo no haya sido en vano. mi correo es:
[email protected]

:D

Jakerock, si bien recién te estas iniciando en los foros, te sugiero que te tomes unos minutos y leas la guia de estilo. No es conveniente que expongas tu correo. Tus dudas, tu ayuda ( como la de otros miembros) debería ser llevada a través de los foros. Esto beneficia a otros interesados y a posibles personas que pasen por la misma situación.

Te pediría que for favor edites tu mensaje anterior y emplees la etiqueta [ DELPHI ] [ /DELPHI ] (sin espacios) para que el código se visualize mejor.

Saludos,