dxftpservercore.pas

来自「Well known and usefull component for del」· PAS 代码 · 共 887 行 · 第 1/3 页

   fOnCommandTYPE:=Value;
   AddBasicEvent('TYPE',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandSTRU(value:FTPTBasicEvent);
Begin
   fOnCommandSTRU:=Value;
   AddBasicEvent('STRU',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandMODE(value:FTPTBasicEvent);
Begin
   fOnCommandMODE:=Value;
   AddBasicEvent('MODE',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandRETR(value:FTPTBasicEvent);
Begin
   fOnCommandRETR:=Value;
   AddBasicEvent('RETR',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandSTOR(value:FTPTBasicEvent);
Begin
   fOnCommandSTOR:=Value;
   AddBasicEvent('STOR',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandSTOU(value:FTPTSimpleEvent);
Begin
   fOnCommandSTOU:=Value;
   AddSimpleEvent('STOU',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandAPPE(value:FTPTBasicEvent);
Begin
   fOnCommandAPPE:=Value;
   AddBasicEvent('APPE',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandALLO(value:FTPTComplexEvent);
Begin
   fOnCommandALLO:=Value;
   AddComplexEvent('ALLO',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandREST(value:FTPTBasicEvent);
Begin
   fOnCommandREST:=Value;
   AddBasicEvent('REST',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandRNFR(value:FTPTBasicEvent);
Begin
   fOnCommandRNFR:=Value;
   AddBasicEvent('RNFR',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandRNTO(value:FTPTBasicEvent);
Begin
   fOnCommandRNTO:=Value;
   AddBasicEvent('RNTO',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandABOR(value:FTPTSimpleEvent);
Begin
   fOnCommandABOR:=Value;
   AddSimpleEvent('ABOR',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandDELE(value:FTPTBasicEvent);
Begin
   fOnCommandDELE:=Value;
   AddBasicEvent('DELE',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandRMD(value:FTPTBasicEvent);
Begin
   fOnCommandRMD:=Value;
   AddBasicEvent('RMD',Value);
   AddBasicEvent('XRMD',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandMKD(value:FTPTBasicEvent);
Begin
   fOnCommandMKD:=Value;
   AddBasicEvent('MKD',Value);
   AddBasicEvent('XMKD',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandPWD(value:FTPTSimpleEvent);
Begin
   fOnCommandPWD:=Value;
   AddSimpleEvent('PWD',Value);
   AddSimpleEvent('XPWD',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandLIST(value:FTPTBasicEvent);
Begin
   fOnCommandLIST:=Value;
   AddBasicEvent('LIST',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandNLST(value:FTPTBasicEvent);
Begin
   fOnCommandNLST:=Value;
   AddBasicEvent('NLST',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandSITE(value:FTPTBasicEvent);
Begin
   fOnCommandSITE:=Value;
   AddBasicEvent('SITE',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandSIZE(value:FTPTBasicEvent);
Begin
   fOnCommandSIZE:=Value;
   AddBasicEvent('SIZE',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandSYST(value:FTPTSimpleEvent);
Begin
   fOnCommandSYST:=Value;
   AddSimpleEvent('SYST',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandSTAT(value:FTPTBasicEvent);
Begin
   fOnCommandSTAT:=Value;
   AddBasicEvent('STAT',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandHELP(value:FTPTBasicEvent);
Begin
   fOnCommandHELP:=Value;
   AddBasicEvent('HELP',Value);
End;

Procedure TDXFTPServerCore.SetOnCommandNOOP(value:FTPTSimpleEvent);
Begin
   fOnCommandNOOP:=Value;
   AddSimpleEvent('NOOP',Value);
End;

///////////////////////////////////////////////////////////////////////////////
//SAYHELLO:
//         A built-in Routine to Call in your "onNewConnect", reduces problems
//         if you do not know how the protocols work. Simply call this routine
//         with a TStringList of your "Server Header", and a TStringList of your
//         "Message of the DAY". Both are optional, if both a NIL this routine
//         will just respond to the client "FTP Server (Ready)", and the client
//         will begin login.
///////////////////////////////////////////////////////////////////////////////
procedure TDXFTPServerCore.SayHello(ClientThread:TDXClientThread;Header:TStrings);
Var
   Loop:Integer;
   Ws:String;

Begin
   If Assigned(Header) then Begin
      ClientThread.Socket.Writeln('220-');
      For Loop:=1 to Header.Count do Begin
         Ws:='220-'+Header[Loop-1];
         ClientThread.Socket.Writeln(Ws);
      End;
   End;
   ClientThread.Socket.Writeln(ErrorText(220)+' '+fGetLocalHostName+' FTP Server (ready).');
End;

///////////////////////////////////////////////////////////////////////////////
//SAYGOODBYE:
//           A built-in Routine to Call at the end of your "onNewConnect", this
//           will send a String "Footer", or the defacto "Goodbye." to the
//           client program. This should be the last piece of code in your
//           onNewConnect. Remember the onDisconnect is not a good place to
//           send any output - as the client could have disconnected already!
///////////////////////////////////////////////////////////////////////////////
procedure TDXFTPServerCore.SayGoodbye(ClientThread:TDXClientThread;Footer:TStrings);
Var
   Loop:Integer;
   Ws:String;

Begin
   If Assigned(Footer) then Begin
      ClientThread.Socket.Writeln('221-');
      For Loop:=1 to Footer.Count do Begin
         Ws:='221-'+Footer[Loop-1];
         ClientThread.Socket.Writeln(Ws);
      End;
   End;
   ClientThread.Socket.Writeln(ErrorText(221));
End;

///////////////////////////////////////////////////////////////////////////////
//PROCESSSESSION:
//               If you want this CORE to process the parsing, you should call
//               this from your "OnNewConnect" implementation. This should be
//               right after your call to SayHello (optional).
///////////////////////////////////////////////////////////////////////////////
procedure TDXFTPServerCore.ProcessSession(ClientThread:TDXClientThread;MOTD:TStrings);
var
  s, sCmd: string;
  WasHandled: Boolean;
  Loop,Loop2:Integer;
  MOTDShown:Boolean; // 2.0
  OutData:Pointer;


begin
   MOTDShown:=False;
   fbForceAbort:=False;
   with ClientThread.Socket do begin
      while Connected do begin
         If fbForceAbort then Exit;
         S:=ReadLn(Timeout);
         While Copy(S,1,1)=#255 do Delete(S,1,2); // Dec 19
         If LastReadTimeout or (not Connected) then Begin
            If LastReadTimeout and Assigned(fOnCommandTimeout) then
               fOnCommandTimeout(ClientThread);
            Exit;
         End;
         if S='' then continue;
         if assigned({$IFDEF TLS_EDITION}OnReadFilter{$ELSE}OnFilter{$ENDIF}) then begin
            Loop:=FilterRead(@S[1],OutData,Length(S),ClientThread);
            SetLength(S,Loop);
            If Assigned(Outdata) then Begin
               FastMove(TDXBSArray(OutData^),S[1],Loop);
{$IFDEF TLS_EDITION}OnReadFilter{$ELSE}OnFilter{$ENDIF}(ddFreePointer,nil,OutData,Loop,Loop,WasHandled,ClientThread) ;
            End;
         End;
         sCmd:=UpperCase(Fetch(S,#32,False));
         Loop:=0;
         WasHandled:=False;
         While (Loop<fEventArray.Count) and (Not WasHandled) do Begin
            If PFTPBasicEvent(fEventArray[Loop]).Command=sCMD then Begin
               Case PFTPBasicEvent(fEventArray[Loop]).Tag of
                  1:if Assigned(PFTPBasicEvent(fEventArray[Loop]).EventProcedure) then
                       FTPTBasicEvent(PFTPBasicEvent(fEventArray[Loop]).EventProcedure)(ClientThread,S);
                  2:if Assigned(PFTPSimpleEvent(fEventArray[Loop]).EventProcedure) then
                       FTPTSimpleEvent(PFTPSimpleEvent(fEventArray[Loop]).EventProcedure)(ClientThread);
                  3:if Assigned(PFTPComplexEvent(fEventArray[Loop]).EventProcedure) then
                       FTPTComplexEvent(PFTPComplexEvent(fEventArray[Loop]).EventProcedure)(ClientThread,Fetch(S,#32,False),S);
                  4:Begin
                    Washandled:=False;
                    if Assigned(PFTPPassEvent(fEventArray[Loop]).EventProcedure) then
                       FTPTPassEvent(PFTPPassEvent(fEventArray[Loop]).EventProcedure)(ClientThread,S,WasHandled);
                    If WasHandled then Begin
                       If Not MOTDShown then Begin
                          If Assigned(MOTD) then Begin
                             Writeln('230-');
                             For Loop2:=1 to MOTD.Count do Begin
                                S:='230-'+MOTD[Loop2-1];
                                Writeln(S);
                             End;
                             Writeln(ErrorText(230));
                             MOTD.Clear;
                          End;
                          MOTDShown:=True;
                       End;
                    End;
                  End;
               End;
               WasHandled:=True;
            End
            Else Inc(Loop);
         End;
         If sCMD='QUIT' then Exit;
         If Not WasHandled then Begin
            if assigned(OnCommandOther) then
               OnCommandOther(ClientThread,sCmd,s,WasHandled);
         end;
         if not WasHandled then
            Writeln(ErrorText(500));
      end;
   end;
end;

// Dec 19
function TDXFTPServerCore.ErrorText (StatusCode:Integer) :string;
var
   Loop:Integer;

begin
   Loop:=MaxStatusCodes;
   while StatusCodes[Loop].Code>StatusCode do Dec (Loop) ;
   if StatusCodes[Loop].Code=StatusCode then
      Result:=IntegerToString (StatusCode) +#32+StatusCodes[Loop].Msg
   else
      Result:='500 Internal Server Error';
end;

end.