dxftpbaseserver.pas

Well known and usefull component for delphi 7

   DoLog( ClientThread, 'DELE' , Filename , fullfname );
   // here is where you need to check security too.
   if SysUtils.DeleteFile(fullFName) then
        ClientThread.Socket.WriteLn( ErrorText(250))
   else
        ClientThread.Socket.WriteLn( ErrorText(450));
end;
{-----------------------------------------------------------------------------}
procedure TDXFTPBaseServer.DoCommandRNTO(ClientThread: TDXClientThread; Parm: String);
begin
   if not CheckAuthorized( ClientThread, 'RNTO' ) then exit;

   DoLog( ClientThread, 'RNTO' , Parm);

   If RenameFile(PUserSession(ClientThread.fpSessionData)^.RNFO,Parm) then
      ClientThread.Socket.Writeln(ErrorText(250))
   Else
      ClientThread.Socket.Writeln(ErrorText(550));
   PUserSession(ClientThread.fpSessionData)^.RNFO:='';
end;
{-----------------------------------------------------------------------------}
procedure TDXFTPBaseServer.DoCommandRNFR(ClientThread: TDXClientThread; Parm: String);
begin
   if not CheckAuthorized( ClientThread, 'RNFR' ) then exit;

   DoLog( ClientThread, 'RNFR' , Parm);

   If FileExists(Parm) then Begin
      PUserSession(ClientThread.fpSessionData)^.RNFO:=Parm;
      ClientThread.Socket.Writeln(ErrorText(350));
   End
   Else ClientThread.Socket.Writeln(ErrorText(550));
end;
{-----------------------------------------------------------------------------}
procedure TDXFTPBaseServer.DoCommandABOR( ClientThread: TDXClientThread);
begin
   DoLog( ClientThread, 'ABOR', '');

   PUserSession(ClientThread.fpSessionData)^.Abort := True ;
   ClientThread.Socket.Writeln('250 ABOR command successful.');


   // You will have to set an abort variable in the fpSessionData record
   // and if you are doing something abort it! Simple enough.
//   ## Need example on how to abort a transfer
end;
{-----------------------------------------------------------------------------}
procedure TDXFTPBaseServer.DoCommandAPPE(ClientThread: TDXClientThread; FileName: String);
begin
   if not CheckAuthorized( ClientThread, 'APPE' ) then exit;
   DoLog( ClientThread, 'APPE',FileName );

   StoreFile( ClientThread , FileName , TRUE ) ;
end;
{
// Merged into StoreFile
var
   FileToRetr:String;
   FileHandle:Integer;
   Tries:Integer;

begin
   with PUserSession(ClientThread.fpSessionData)^ do Begin
      FileToRetr:=CurrentDir+Parm;
      NewConnect.ipAddress:=PeerIPAddress;
      If PASV or DataSocket.Connect(NewConnect) then Begin
         if not FileExists(FileToRetr) then
            ClientThread.Socket.WriteLn(ErrorText(502))
         Else Begin
            FileHandle:=FileOpen(FileToRetr,fmOpenWrite);
            FileSeek(FileHandle, 0, 2);
            ClientThread.Socket.Writeln(ErrorText(150)+#32+
               Parm+' to '+PeerIPAddress+'.');
            RestPos:=0;
            Tries:=0;
            DataSocket.RestartCharactersPerSecondTimer;
            While DataSocket.Connected do Begin
               If Tries>100 then Begin
                  Break;
               End;
               If DataSocket.Readable then Begin
                  If DataSocket.CharactersToRead=0 then begin
                     Break; // dropped connection
                  end;
                  DataSocket.SaveTo(Filehandle,500);
                  Tries:=0;
               End
               Else Begin
                  DoSleepEx(10);
                  ProcessWindowsMessageQueue;
                  Inc(Tries);
               End;
            End;

         DoLog( ClientThread, FileToRetr+' @ '+DXString.SizeStamp(DataSocket.CharactersPerSecondReceived));

            FileClose(FileHandle);
            DataSocket.Disconnect;
            ClientThread.Socket.Writeln(ErrorText(226));
         End;
      End
      Else ClientThread.Socket.Writeln(ErrorText(450));
   end;
end;
}
{-----------------------------------------------------------------------------}
procedure TDXFTPBaseServer.DoCommandPASV(ClientThread: TDXClientThread);
Var
   WS:String;
   NewListen :PNewListen;
   tries : integer ;
   PasvBound : Boolean ;
begin
   if not CheckAuthorized( ClientThread, 'PASV' ) then exit;

   If fUseNatAddr then
      Ws:=fNatAddress
   Else
      Ws:=ClientThread.Socket.LocalIPAddress;

   PUserSession(ClientThread.fpSessionData)^.PASV:=True;
   PUserSession(ClientThread.fpSessionData)^.Abort := False ;

   New(NewListen);

   with NewListen^ do begin
         Port:=NextDataPort;
         UseNAGLE:=True;
         UseBlocking:= True;
         UseUDP:=False;
         WinsockQueue:= 1;
         ConnectionLess:= False;
   end;
   PasvBound:= False ;
   tries := 100 ;
   while ( tries > 0)  do begin
     PasvBound := PUserSession(ClientThread.fpSessionData)^.DataSocket.Listen(NewListen);
     CalcNextDataPort ;
     if PasvBound then Break ;
     NewListen^.Port:=NextDataPort;
     Dec( tries );
   end;

   Ws:=StringReplace(Ws,'.',',',[rfReplaceAll])+','+inttostr( trunc(NewListen^.Port div 256) )+','+inttostr( NewListen^.Port -(trunc(NewListen^.Port div 256)*256) );

   if PasvBound then Begin
      ClientThread.Socket.Writeln(ErrorText(227)+' ('+Ws+').');
      DoLog( ClientThread, 'PASV', '('+Ws+')');
      DoSleepEx(250); // give "INTERNET" time to digest!
      tries:=16; // waits upto 8 seconds:
      while not PUserSession(ClientThread.fpSessionData)^.DataSocket.Accept(
         PUserSession(ClientThread.fpSessionData)^.DataSocket) do Begin
         dec( tries ) ;
         if tries = 0 then begin
            DoLog( ClientThread, 'PASV [no client!]','');
            ClientThread.Socket.Writeln(ErrorText(550));
            break;
         end;
         DoSleepEx(500) ;
      end;
   end
   else begin
      DoLog( ClientThread, 'PASV' , '[listen failed]');
      ClientThread.Socket.Writeln(ErrorText(550));
   End;
   Dispose(NewListen);
   If PUserSession(ClientThread.fpSessionData)^.DataSocket.Connected then Begin
      DoLog( ClientThread, 'PASV' ,  '[Client Connected OK]');
   end
   Else Begin
      PUserSession(ClientThread.fpSessionData)^.PASV:=False;
   End;
end;

{-----------------------------------------------------------------------------}
procedure TDXFTPBaseServer.DoCommandPASS(ClientThread: TDXClientThread;
  password: String; var SuccessfulLogin: Boolean);
begin
   DoLog( ClientThread, 'PASS', Password );

   // Here is where you do the user lookup
   // If not found:  331 Password required for 'USER'.
   with PUserSession(ClientThread.fpSessionData)^ do Begin
      AuthorizedState:=False;
      If User='' then Begin
         ClientThread.Socket.Writeln(ErrorText(503));
         Exit;
      End;

      if not ValidateUser(ClientThread , User , Password ) then begin
         SuccessfulLogin:=False;
         ClientThread.Socket.Writeln(ErrorText(530));
         ClientThread.Socket.Disconnect;
      end
      else begin
         Pass:=Password;
         AuthorizedState:=True;
         CurrentDir:=HomeDir;
         HomeDir:=HomeDir;
{ UNCOMMENT IF MOTD IS NOT USED IN .PROCESSSESSION() in ONNEWCONENCT
         ClientThread.Socket.Writeln('230 "'+
            PUserSession(ClientThread.fpSessionData).User+
            '" user logged in.');
}
     // Once the user lookup is done, you should set the "security level/group"
     // and root directory in the Session Data!
         SuccessfulLogin:=True; // Enabled the MOTD, if it was false
                            // you would need to write something to the socket!!
                            // If MOTD is disabled, then you would have to write
                            // something to the socket too!
         if Assigned( fAftervalidUser ) then
             SuccessfulLogin:=fAfterValidUser( ClientThread , User , Password );
         if not SuccessfulLogin then
            ClientThread.Socket.Disconnect;
      end;
   end; {with}
end;
{-----------------------------------------------------------------------------}
{
procedure TDXFTPBaseServer.DoCommandSIZE(ClientThread: TDXClientThread;Parm: String);
//Var
//   MySRec: PSRec;
var
siz : int64 ;
begin
   if not CheckAuthorized( ClientThread, 'SIZE' ) then exit;
   DoLog( ClientThread, 'SIZE',PARM );
   FileSize()

   MySRec:=DXFileAllocationTable1.FileInformation(PUserSession(ClientThread.fpSessionData)^.CurrentDir+Parm);
   ## FileSize
   If MySRec<>Nil then Begin
      ClientThread.Socket.Writeln(ErrorText(213)+#32+IntToStr(MySRec^.FileSize))
   End
   Else
      ClientThread.Socket.Writeln(ErrorText(550));
end;
}
{-----------------------------------------------------------------------------}
function TDXFTPBaseServer.ValidateUser(ClientThread: TDXClientThread;
  Username, Password: string): boolean;
begin
  if Assigned( fValidateUser ) then
    result:= fValidateUser(ClientThread, Username, Password)
  else
    result := true;
end;
{-----------------------------------------------------------------------------}


{-----------------------------------------------------------------------------}

procedure TDXFTPBaseServer.DoDataSocketOnRead(xClientThread: TThread;
  BytesToRead, Readbytes: integer; var AbortXfer: boolean);
begin
//
   if Assigned( xClientThread ) then begin

      Inc(PUserSession(TDXClientThread(xClientThread).fpSessionData)^.BytesRcv , ReadBytes );
      CalcSpeed( TDXClientThread(xClientThread) , ReadBytes );
      if Assigned( feDataSocketOnRead )  then
        FeDaTaSocketOnRead( TDXClientThread(xClientThread) , -1 , BytesToRead , ReadBytes , AbortXfer);
   end;
end;

procedure TDXFTPBaseServer.DoDataSocketOnWrite(xClientThread: TThread;
  TotalBytes, BytesLeft, BytesSent: integer; var AbortXfer: boolean);
begin
   if Assigned( xClientThread ) then begin
      Inc( PUserSession(TDXClientThread(xClientThread).fpSessionData)^.BytesSnd, BytesSent );

      
      CalcSpeed( TDXClientThread(xClientThread) , BytesSent );

      if Assigned( feDataSocketOnWrite ) then
        FeDaTaSocketOnWrite( TDXClientThread(xClientThread) ,
            TotalBytes ,
             ABs(TotalBytes-Bytesleft),BytesSent, AbortXfer);
   end;
end;

procedure TDXFTPBaseServer.CalcSpeed(ClientThread: TDXClientThread;
  BytesXfer : integer);
var
  anow : TDateTime ;
  diff : int64 ;
begin
   anow:= Now ;
   with PUserSession(ClientThread.fpSessionData)^ do begin
      if SpeedStartTS = 0 then begin
          SpeedStartTs  := aNow ;
          CurrSpeed     := 0  ;
          SpeedBytesXfer := 0 ;
      end;

      Inc( SpeedBytesXfer  , BytesXfer );
      diff := MilliSecondsBetween(aNow, SpeedStartTS) ;
//      diff :=aNow -  SpeedStartTS ;

      if ( diff > 3000) then begin // reset every 3 seconds
          if ( diff > 10000 ) then begin //Restart data from last transfer
             SpeedStartTs  := aNow ;
             CurrSpeed     := 0 ;
             SpeedBytesXfer := BytesXfer;
          end
          else begin
             SpeedStartTs := aNow ;
             CurrSpeed    := SpeedBytesXfer div Max((diff div 1000),1) ;
             SpeedBytesXfer := BytesXfer;
          end;
{      end
      else if (diff < 100) and ( diff > 0 ) then begin
       // Don磘 do anything
      end
      else begin // Calc speed
//          CurrSpeed    := SpeedBytesXfer div Max((diff div 1000),1) ;
}      end;
   end;
end;

end.