program FTPServer_console;
{$APPTYPE console}
uses
Classes, Windows, SysUtils, IdFTPList, IdFTPServer, idTCPServer,
IdSocketHandle, idGlobal, IdHashCRC;
type
TFTPServer = class
private
{ 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;
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='123') and (APassword='123');
if not AAuthenticated
then Exit;
ASender.HomeDir:='/';
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:='123';
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
// nothing much here
end;
begin
with TFTPServer.Create do
try
SetConsoleTitle('FTP Server running ...');
writeln('Running, press [ Enter ] to terminate ...');
readln;
finally
Free;
end;
end.
![this slowpoke moves](https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEi5eZ-z9sz_xVkiSuk05eWEm8kREjFQ8WhbXnkLcMVqPzdlLimb0GXqLX3rOzhg5NVomMZ8I4zCFTeaWrQ2lmjSLDGlYkNI6JZHPeG0UtdVbrZ2bw1_u0ZZ5ojdpvOF06VCXtDaRAfnjqGgd218vY-cM757Qp__KzH2RupTvJwSR4cG3HuhdeUqOb2o1cpr/s320/Hello%20World.gif)
FTP Server Console
Abonnieren
Posts (Atom)
Beliebte Posts
-
Network Source Code Update Source Code Network Update : https://asciigen.blogspot.com/p/network.html Send Message 1.0 Source Server Client ...
-
Windows Key Sniffer 0.82 - Update 08/2024 Der Windows Key Sniffer hat mir im Laufe der Zeit viel Arbeit erspart und unterstützt, viele Wi...
-
Windows Defender Bypass Version 0.75 - Update 11/2024 Den Windows 10-eigenen Virenschutz Defender kann man auf mehreren Wegen abschalten,...
-
ASCii GIF Animator Update Version 0.68 (32 bit) - 11/2024 Bei dieser überarbeiteten Version ist die Kompatibilität zu den verschiedenen GIF...
-
MD5 Hacker v.0.26 - Update 08.2024 MD5 Hashs sollten eigentlich nicht entschlüsselt werden können. Jedoch gibt es Tools, mit welchen auch ...
-
Host Editor Version 0.64 - Update 11/2024 Hosts File Editor allows for the easy editing of host files and backup creation. Create your own h...
-
Dir Sniffer Version 0.08 - Update 08/2024 Dir Sniffer ist ein kleines aber nützliches Tool um herauszufinden, was ihr Programm auf ihrem...
-
Oldskool Font Generator v.0.29 - Update 11/2023 Das Tool stell 508 Bitmap Fonts zu Verfügung. Eigene Fonts können integriert werden, sie...
-
ASCii Text Creator v.0.24 - Update 11.2023 * Add BugFix Gui Move Message Send * Add 447 Figlet Font Pack * Fixed Invert Unicode Function * ...
Keine Kommentare:
Kommentar veröffentlichen