idfsp.pas

photo.163.com 相册下载器 多线程下载

end;

function DateTimeToUnix(ADateTime: TDateTime): Cardinal;
begin
  //example: DateTimeToUnix(now);
  Result := Round((ADateTime - UnixStartDate) * 86400);
end;

procedure ParseStatInfo(const AData : TIdBytes; VL : TIdFSPStatInfo; var VI : Cardinal);
var LC : Cardinal;
begin
  //we don't parse the file type because there is some variation between CC_GET_DIR and CC_STAT
   LC := ((AData[VI] shl 8) or (AData[VI+1] and $FF)) shl 16;
   LC := LC or ((AData[VI+2] and $FF) shl 8) or (AData[VI+3] and $FF);
   VL.FModifiedDateGMT := UnixDateTimeToDelphiDateTime(LC);
   VL.FModifiedDate := VL.FModifiedDateGMT + OffSetFromUTC;
   VI := VI + 4;
   LC := ((AData[VI] shl 8) or (AData[VI+1] and $FF)) shl 16;
   LC := LC or ((AData[VI+2] and $FF) shl 8) or (AData[VI+3] and $FF);
   VL.Size := LC;
   VI := VI + 5;     //we want to skip over the type byte we processed earlier
 
end;

{ TIdFSP }

procedure TIdFSP.Connect;
begin
  FSequence := 1;
  FKey := 0;
  FMaxThruPut := 0;
  FMaxPacketSize := MAXSIZE;
  inherited Connect;
end;

destructor TIdFSP.Destroy;
begin
  Disconnect;
  FreeAndNil( FDirInfo );
  FreeAndNil( FDirectoryListing );
  FreeAndNil( FStatInfo );
  inherited;
end;

procedure TIdFSP.Disconnect;
var
  LBuf,LData, LExtra : TIdBytes;
begin
  if FConEstablished then
  begin
    SetLength(LBuf,0);
    SendCmd( CC_BYE,LBuf,0,LData,LExtra);
    inherited Disconnect;
  end;
  FConEstablished := False;
end;

procedure TIdFSP.Get(const ASourceFile: string; ADest: TStream;
  AResume: Boolean);
var LStream : TIdStreamVCL;
begin
  LStream := TIdStreamVCL.Create(ADest);
  try
    Get(ASourceFile,LStream,AResume);
  finally
    FreeAndNil(LStream);
  end;
end;

procedure TIdFSP.Get(const ASourceFile, ADestFile: string;
  const ACanOverwrite: boolean; AResume: Boolean);
var
  LDestStream: TFileStream;
begin
  if FileExists(ADestFile) then begin
    if ACanOverwrite and (not AResume) then begin
      DeleteFile(ADestFile);
      LDestStream := TFileStream.Create(ADestFile, fmCreate);
    end
    else begin
      if (not ACanOverwrite) and AResume then begin
        LDestStream := TFileStream.Create(ADestFile, fmOpenReadWrite or fmShareDenyWrite);
        LDestStream.Position := LDestStream.Size;
      end
      else begin
        raise EIdFSPFileAlreadyExists.Create(RSDestinationFileAlreadyExists);
      end;
    end;
  end
  else begin
    LDestStream := TFileStream.Create(ADestFile, fmCreate);
  end;

  try
    Get(ASourceFile, LDestStream, AResume);
  finally
    FreeAndNil(LDestStream);
  end;
end;

procedure TIdFSP.Get(const ASourceFile: string; ADest: TIdStreamVCL;
  AResume: Boolean);
var LSendPacket : TIdFSPPacket;
    LRecvPacket :  TIdFSPPacket;
    LLen : Integer;
    LTmpBuf : TIdBytes;
begin
  SetLength(LTmpBuf,MAXSIZE);
  LSendPacket := TIdFSPPacket.Create;
  LRecvPacket :=  TIdFSPPacket.Create;
  try
    if AResume then begin
       LSendPacket.FFilePosition := ADest.VCLStream.Position;
    end
    else
    begin
      LSendPacket.FFilePosition := 0;
    end;
    LSendPacket.Cmd := CC_GET_FILE;
    LSendPacket.FData := ToBytes(ASourceFile+#0);
    LSendPacket.FDataLen := Length(ASourceFile)+1;
    BeginWork(wmRead);
    try
      repeat
         SendCmd(LSendPacket,LRecvPacket,LTmpBuf);
         LLen := LRecvPacket.FDataLen; //Length(LRecvPacket.Data);
         if LLen >0 then
         begin
           ADest.Write(LRecvPacket.Data,LLen);
           DoWork(wmRead,LLen);
           Inc(LSendPacket.FFilePosition,LLen);
         end
         else
         begin
           Break;
         end;
      until False;
    finally
      EndWork(wmRead);
    end;
  finally
    FreeAndNil(LSendPacket);
    FreeAndNil(LRecvPacket);
  end;
end;

procedure TIdFSP.GetDirInfo(const ADIR: String);
begin
  GetDirInfo(ADir,Self.FDirInfo );
end;

procedure TIdFSP.InitComponent;
begin
  inherited;
  Port := IdPORT_FSP;
  FSequence := 0;
  FKey := 0;
   FDirInfo := TIdFSPDirInfo.Create;
  FDirectoryListing:= TIdFSPListItems.Create;
  FStatInfo := TIdFSPStatInfo.Create(nil);
  BroadcastEnabled := False;
  FConEstablished := False;
end;

procedure TIdFSP.List;
begin
  List('/');
end;

procedure TIdFSP.List(const ASpecifier: string);
var

  LSendPacket : TIdFSPPacket;
  LRecvPacket :  TIdFSPPacket;
  LTmpBuf : TIdBytes;
begin
  SetLength(LTmpBuf,MAXSIZE);
  LSendPacket := TIdFSPPacket.Create;
  LRecvPacket :=  TIdFSPPacket.Create;
  try
  //
    LSendPacket.Cmd := CC_GET_DIR;
    LSendPacket.FFilePosition := 0;
    SetLength(LRecvPacket.FData, MAXSIZE );
    SetLength(LSendPacket.FExtraData,0);
    FDirectoryListing.Clear;
    repeat

      if ASpecifier ='' then
      begin
        LSendPacket.Data := ToBytes('/'+#0);
        LSendPacket.DataLen := 2;
      end
      else
      begin
        LSendPacket.Data := ToBytes(ASpecifier+#0);
        LSendPacket.DataLen := Length(LSendPacket.Data);
      end;
      SendCmd(LSendPacket,LRecvPacket,LTmpBuf);

      if LRecvPacket.DataLen > 0 then
      begin
        Inc(LSendPacket.FFilePosition,LRecvPacket.DataLen);
      end
      else
      begin
        Break;
      end;
    until FDirectoryListing.ParseEntries( LRecvPacket.FData, LRecvPacket.FDataLen );
  finally
    FreeAndNil(LSendPacket);
    FreeAndNil(LRecvPacket);
  end;
end;

procedure TIdFSP.SendCmd(const ACmd: Byte; const AData,
  AExtraData: TIdBYtes; const AFilePosition: Int64; var VData,
  VExtraData: TIdBytes; const ARaiseException : Boolean=True);
var LSendPacket : TIdFSPPacket;
    LRecvPacket :  TIdFSPPacket;
    LTmpBuf : TIdBytes;
begin
  SetLength(LTmpBuf,MAXSIZE);
  LSendPacket := TIdFSPPacket.Create;
   LRecvPacket :=  TIdFSPPacket.Create;
  try
    LSendPacket.Cmd := ACmd;
    LSendPacket.FilePosition := AFilePosition;
    LSendPacket.Data := AData;
    LSendPacket.FDataLen := Length(AData);
    LSendPacket.ExtraData := AExtraData;
    SendCmd(LSendPacket,LRecvPacket,LTmpBuf,ARaiseException );
    VData := LRecvPacket.Data;
    VExtraData := LRecvPacket.ExtraData;

  finally
    FreeAndNil(LSendPacket);
    FreeAndNil(LRecvPacket);
  end;
end;

procedure TIdFSP.SendCmd(const ACmd: Byte; const AData: TIdBYtes;
  const AFilePosition: Int64; var VData, VExtraData: TIdBytes; const ARaiseException : Boolean=True);
var LExtraData : TIdBytes;
begin
  SetLength(LExtraData,0);
  SendCmd(ACmd,AData,LExtraData,AFilePosition,VData,VExtraData, ARaiseException);
end;

procedure TIdFSP.Version;
var
  LData, LBuf, LExtraBuf : TIdBytes;
  LDetails : Byte;
  LC : Cardinal;
begin
  SetLength(LData,0);

  SendCmd(CC_VERSION,LData,0,LBuf,LExtraBuf);
  FSystemDesc := ParseASCIIZ( LBuf, Length(LBuf));
  if Length(LExtraBuf)>0 then
  begin
    LDetails := LExtraBuf[0];
    //bit 0 set - server does logging
    FSystemServerLogs := LDetails and $01=$01;
    //bit 1 set - server is read only
    FSystemReadOnly := LDetails and $02=$02;
    //bit 2 set - reverse lookup required
    FSystemReverseLookupRequired := LDetails and $04=$04;
    //bit 3 set - server is in private mode
    FSystemPrivateMode := LDetails and $08=$08;
    //  if bit 4 is set thruput info follows
    FThruputControl := LDetails and $10=$10;
    // bit 5 set - server accept XTRA
   //  DATA on input
    FSystemAcceptsExtraData := LDetails and $20=$20;
    //long - max_thruput allowed (in bytes/sec)
    //word - max. packet size supported by server
    if FThruputControl then
    begin
      if Length(LExtraBuf)>4 then
      begin
        LC := ((LExtraBuf[1] shl 8) or (LExtraBuf[2] and $FF)) shl 16;
        LC := LC or ((LExtraBuf[3] and $FF) shl 8) or (LExtraBuf[4] and $FF);
        FMaxThruPut := LC;
        if Length(LExtraBuf)>6 then
        begin
          LC := ((LExtraBuf[5] shl 8) or (LExtraBuf[6] and $FF));
          FMaxPacketSize := LC and $FFFF;
        end;
      end;
    end
    else
    begin
      if Length(LExtraBuf)>2 then
      begin
        LC := ((LExtraBuf[1] shl 8) or (LExtraBuf[2] and $FF));
        FMaxPacketSize := LC and $FFFF;
      end;
    end;
  end;
end;

procedure TIdFSP.SendCmd(ACmdPacket, ARecvPacket: TIdFSPPacket; var VTempBuf : TIdBytes; const ARaiseException : Boolean=True);
var 
  LLen : Integer;
  LBuf : TIdBytes;
  LSendBuf : TIdBytes;

  LMSec : Integer;
begin
  Inc(FSequence);
  SetLength(LBuf,MAXSIZE);
  ACmdPacket.Key := FKey;
  ACmdPacket.Sequence := FSequence;
  LMSec := MINTIMEOUT;
  LSendBuf := ACmdPacket.WritePacket;
    repeat
      SendBuffer(LSendBuf);

      if Assigned(FOnSend) then
      begin
        FOnSend(Self,ACmdPacket);
      end;
      LLen := ReceiveBuffer( LBuf, LMsec );
      ARecvPacket.ReadPacket(LBuf,LLen);

      if ARecvPacket.FValid then
      begin
        if Assigned(FOnRecv) then
        begin
          FOnRecv(Self,ARecvPacket);
        end;
        if (ARecvPacket.Sequence = FSequence) then
        begin
          break;
        end;
      end;

      LMSec := Round(LMSec * 1.5);
      if LMSec > MAXTIMEOUT then
      begin
        LMSec := MAXTIMEOUT;
      end;  
    until False;
    FKey := ARecvPacket.Key;

    if ARaiseException and (ARecvPacket.Cmd = CC_ERR) then
    begin
      Raise EIdFSPProtException.Create( ParseASCIIZ(ARecvPacket.Data, ARecvPacket.DataLen));
    end;

end;

procedure TIdFSP.GetStatInfo(const APath: String);
var
  LData, LBuf,LExtraBuf : TIdBytes;
  i : Cardinal;
begin
  i := 0;
  LData := ToBytes(APath + #0);
  SendCmd(CC_STAT,LData,0,LBuf,LExtraBuf);
  if Length(LBuf)>8 then
  begin
{


data format is the same as in directory listing with exception
that there is no file name appended. If file do not exists or
there is other problem (no access rights) return type of file is
0.

        struct STAT  {
      long  time;
      long  size;
      byte  type;
}
     case LBuf[8] of
       0 : //file not found
       begin
         raise EIdFSPFileNotFound.Create('');
       end;
       RDTYPE_FILE :
       begin
         FStatInfo.ItemType := ditFile;
       end;
       RDTYPE_DIR :
       begin
         FStatInfo.ItemType := ditDirectory;
       end;
     end;
     ParseStatInfo(LBuf,Self.FStatInfo,i);
  end;
end;

procedure TIdFSP.Put(const ASource: TIdStreamVCL; const ADestFile: string;
  const AGMTTime: TDateTime);
var LUnixDate : Cardinal;
  LSendPacket : TIdFSPPacket;