⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 idfsp.pas

📁 photo.163.com 相册下载器 多线程下载
💻 PAS
📖 第 1 页 / 共 3 页
字号:
  LRecvPacket :  TIdFSPPacket;
  LPosition : Cardinal;
  LLen : Integer;
  LTmpBuf : TIdBytes;
begin
  LPosition := 0;
  SetLength( LTmpBuf,MAXSIZE);
  LSendPacket := TIdFSPPacket.Create;
  LRecvPacket :=  TIdFSPPacket.Create;
  try
    SetLength(LSendPacket.FData,MAXSIZE);
    LSendPacket.Cmd := CC_UP_LOAD;
    repeat
      LLen := ASource.ReadBytes(LSendPacket.FData,MAXSIZE,0,False);
      if LLen < MAXSIZE then
      begin
        if LLen = 0 then
        begin
          break;
        end;
      end;
      LSendPacket.FDataLen := LLen;
      LSendPacket.FilePosition := LPosition;

      SendCmd(LSendPacket,LRecvPacket,LTmpBuf);
      if LLen < MAXSIZE then
      begin
        break;
      end;
      inc(LPosition,LLen);
    until False;
    //send the Install packet
    LSendPacket.Cmd := CC_INSTALL;
    LSendPacket.FilePosition := 0;
    LSendPacket.Data := ToBytes(ADestFile+#0);
    LSendPacket.FDataLen := Length(LSendPacket.Data);
    //File date - optional
    if AGMTTime=0 then
    begin
      SetLength(LSendPacket.FExtraData ,0);
    end
    else
    begin
      LUnixDate := DateTimeToUnix(AGMTTime);
      SetLength(LSendPacket.FExtraData,4);

      LSendPacket.FExtraData[0]  := Byte( (LUnixDate shr 24) and $FF);
      LSendPacket.FExtraData[1]  := Byte( (LUnixDate shr 16) and $FF);
      LSendPacket.FExtraData[2] := Byte( (LUnixDate shr 8) and $FF);
      LSendPacket.FExtraData[3] := Byte( LUnixDate and $FF);
    end;
    SendCmd(LSendPacket,LRecvPacket,LTmpBuf);
  finally
    FreeAndNil(LSendPacket);
    FreeAndNil(LRecvPacket);
  end;

end;

procedure TIdFSP.Put(const ASource: TStream; const ADestFile: string;
  const AGMTTime: TDateTime);
var LStream : TIdStreamVCL;
begin
  LStream := TIdStreamVCL.Create(ASource);
  try
    Put(LStream,ADestFile,AGMTTime);
  finally
    FreeAndNil(LStream);
  end;
end;



procedure TIdFSP.Put(const ASourceFile, ADestFile: string);
var
  LSourceStream: TFileStream;
  LDestFileName : String;
begin
  LDestFileName := ADestFile;
  if LDestFileName = '' then
  begin
   LDestFileName := ExtractFileName(ASourceFile);
  end;
  LSourceStream := TFileStream.Create(ASourceFile, fmOpenRead or fmShareDenyNone); try
    Put(LSourceStream, LDestFileName, GetGMTDateByName(ASourceFile) );
  finally FreeAndNil(LSourceStream); end;
end;

procedure TIdFSP.Delete(const AFilename: string);
var LData : TIdBytes;
  LBuf, LExBuf : TIdBytes;
begin
  LData := ToBytes(AFilename+#0);
  SendCmd(CC_DEL_FILE,LData,0,LBuf, LExBuf);
end;

procedure TIdFSP.MakeDir(const ADirName: string);
var LData : TIdBytes;
  LBuf, LExBuf : TIdBytes;
begin
  LData := ToBytes(ADirName+#0);
  SendCmd(CC_MAKE_DIR,LData,0,LBuf, LExBuf);
  ParseDirInfo(LBuf,LExBuf, FDirInfo);
end;

procedure TIdFSP.RemoveDir(const ADirName: string);
var LData : TIdBytes;
  LBuf, LExBuf : TIdBytes;
begin
  LData := ToBytes(ADirName+#0);
  SendCmd(CC_DEL_DIR,LData,0,LBuf, LExBuf);
end;

procedure TIdFSP.Rename(const ASourceFile, ADestFile: string);
var LBuf, LData, LDataExt : TIdBytes;
begin
   SetLength(LData,0);
   SetLength(LDataExt,0);
   LBuf := ToBytes(ASourceFile+#0+ADestFile);
   SendCmd(CC_RENAME,LBuf,0,LData,LDataExt);
end;

procedure TIdFSP.ParseDirInfo(const ABuf, AExtraBuf: TIdBytes; ADir : TIdFSPDirInfo);
begin
  ADir.ReadMe := ParseASCIIZ(ABuf,Length(ABuf));
  if Length(AExtraBuf)>0 then
  begin
    //0 - caller owns the directory
    ADir.OwnsDir        := AExtraBuf[0] and $01=$01;
    //1 - files can be deleted from this dir
    ADir.CanDeleteFiles := AExtraBuf[0] and $02=$02;
   // 2 - files can be added to this dir
    ADir.CanAddFiles    := AExtraBuf[0] and $04=$04;
    //3 - new subdirectories can be created
    ADir.CanMakeDir     := AExtraBuf[0] and $08=$08;
    //4 - files are NOT readable by non-owners
    ADir.OnlyOwnerCanReadFiles  := AExtraBuf[0] and $10=$10;
    //5 - directory contain an readme file
    ADir.HasReadMe      := AExtraBuf[0] and $20=$20;
    //6 - directory can be listed
    ADir.CanBeListed    := AExtraBuf[0] and $40=$40;
    //7 - files can be renamed in this directory
    ADir.CanRenameFiles := AExtraBuf[0] and $80=$80;
  end;
end;

procedure TIdFSP.GetDirInfo(const ADIR: String; ADirInfo: TIdFSPDirInfo);
var LData, LBuf, LExtraBuf : TIdBytes;
begin
  LData := ToBytes(ADIR+#0);
  SendCmd(CC_GET_PRO,LData,0,LBuf,LExtraBuf);
  ParseDirInfo(LBuf,LExtraBuf, ADirInfo );
end;

{ TIdFSPPacket }

constructor TIdFSPPacket.Create;
begin
  inherited Create;
  FCmd := 0;
  FFilePosition := 0;
  FDataLen := 0;
  SetLength(FData,0);
  SetLength(FExtraData,0);
  FSequence:=0;
  FKey:=0;
end;

function TIdFSPPacket.WritePacket : TIdBytes;
var
   LExtraDataLen : Word;
   LSum : Cardinal;
   i : Integer;
//ported from:
//http://cvs.sourceforge.net/viewcvs.py/fsp/javalib/FSPpacket.java?rev=1.6&view=markup
begin
  SetLength(Result,HSIZE);
  //cmd
  Result[0]  := Cmd;
  //checksum
  Result[1]  := 0;  //this will be the checksum value
  //key
  Result[2]  := Byte( (FKey shr 8) and $FF);
  Result[3]  := Byte( FKey and $FF);
  // sequence
  Result[4]  := Byte( (FSequence shr 8) and $FF);
  Result[5]  := Byte( FSequence and $FF);
  // data length
//  FDataLen       := Length(FData);
  Result[6]  := Byte( ( FDataLen shr 8) and $FF);
  Result[7]  := Byte( FDataLen and $FF);
  // position
  Result[8]  := Byte( (FFilePosition shr 24) and $FF);
  Result[9]  := Byte( (FFilePosition shr 16) and $FF);
  Result[10] := Byte( (FFilePosition shr 8) and $FF);
  Result[11] := Byte( FFilePosition and $FF);
  //end of header
  LExtraDataLen := Length(Self.FExtraData);
  SetLength(Result,HSIZE+FDataLen+LExtraDataLen);
  //data section
  if FDataLen >0 then
  begin
    CopyTIdBytes(FData,0,Result,HSIZE,FDataLen);
  end;
  //extra data section
  if LExtraDataLen>0 then
  begin
    CopyTIdBytes(FExtraData, 0,Result,HSIZE+FDataLen,LExtraDataLen);
  end;
  //checksum
  LSum := HSIZE + FDataLen + LExtraDataLen;
  for i := (HSIZE + FDataLen + LExtraDataLen) - 1 downto 0 do begin
	  LSum:=LSum + (Result[i] and $FF);
  end;
  Result[1]:=byte(LSum+(LSum shr 8));
end;

procedure TIdFSPPacket.ReadPacket(const AData : TIdBytes; const ALen : Cardinal);
var
  LSum, LnSum, LcSum : Cardinal; //cardinal to prevent a range-check error
  t : Word;
  LExtraDataLen : Cardinal;

begin
  FValid := True;
  if Length(AData)<HSIZE then
  begin
    FValid := False;
    Exit;
  end;
  //check data length
  FDataLen := ((AData[6] shl 8) or (AData[7] and $FF));
  FDataLen := FDataLen and $FFFF;
  if FDataLen > Cardinal(Length(AData)) then
  begin
    FValid := False;
  end;
 // LExtraLen := Length(Value)-(HSIZE + FDataLen);
  //validate checksum
  LSum := AData[1]; //checksum
  AData[1] := 0; //zero it out so we can verify the data
  LnSum := Cardinal(Length(AData));
  t:=Lnsum-1;
  Lnsum:=0;
  for t:=t downto 0 do begin
      Lnsum := Lnsum + (AData[t] and $FF);
  end;
  lcsum:=byte(Lnsum + (Lnsum shr 8));
  if LcSum <> LSum then
  begin
    FValid := False;
  end;
  //command
  FCmd :=AData[0];
  //key
  FKey := ((AData[2] shl 8) or (AData[3] and $FF));
  // sequence
  FSequence := ((AData[4] shl 8) or (AData[5] and $FF));
  //6-7 are data length which was already processed
  //file position

  FFilePosition := ((AData[8] shl 8) or (AData[9] and $FF)) shl 16;
  FFilePosition := FFilePosition or ((AData[10] and $FF) shl 8) or (AData[11] and $FF);
  //extract data
  if FDataLen > Cardinal(Length(FData)) then
  begin
    SetLength(FData,FDataLen);
  end;
  if FDataLen >0 then
  begin
    CopyTIdBytes(AData,HSIZE,FData,0,FDataLen);
  end;
  LExtraDataLen := Cardinal(Length(AData)) - (HSIZE+FDataLen);
  //extract extra data
  if LExtraDataLen>0 then
  begin
    SetLength(FExtraData,LExtraDataLen);
    CopyTIdBytes(AData,HSIZE+FDataLen,FExtraData,0,LExtraDataLen);
  end
  else
  begin
    SetLength(FExtraData,0);
  end;
end;

{ TIdFSPListItems }

function TIdFSPListItems.Add: TIdFSPListItem;
begin
  Result := TIdFSPListItem(inherited Add);
end;

constructor TIdFSPListItems.Create;
begin
  inherited Create(TIdFSPListItem);
end;

function TIdFSPListItems.GetItems(AIndex: Integer): TIdFSPListItem;
begin
  Result := TIdFSPListItem(inherited Items[AIndex]);
end;

function TIdFSPListItems.IndexOf(AItem: TIdFSPListItem): Integer;
Var
  i: Integer;
begin
  result := -1;
  for i := 0 to Count - 1 do
    if AItem = Items[i] then begin
      result := i;
      break;
    end;

end;

function TIdFSPListItems.ParseEntries(const AData: TIdBytes; const ADataLen : Cardinal) : Boolean;
var 
  i : Cardinal;
  LI : TIdFSPListItem;
  LSkip : Boolean;
  LFileName : String;
begin
  Result := False;
  i := 0;
  repeat
    if i < (ADataLen-9) then
    begin
      LI := nil;
      LSkip := False;
      case AData[i+8] of
        RDTYPE_END  :
        begin
          Result := True;
          Exit;
        end;
        RDTYPE_FILE :
        begin
          LI := Add;
          LI.ItemType := ditFile;
        end;
        RDTYPE_DIR  :
        begin
          LI := Add;
          LI.ItemType := ditDirectory;
        end;
        RDTYPE_SKIP :
        begin
          LSkip := True;
        end
      else
        Exit;
      end;
      if LSkip then
      begin
        i := i + 8;
      end
      else
      begin
        ParseStatInfo(AData,LI,i);
      end;
      if not LSkip then
      begin
        LFileName := '';
        repeat
          if i>=ADataLen then
          begin
            Break;
          end;
          if AData[i]=0 then
          begin
            break;
          end
          else
          begin
            LFileName := LFileName + Char(AData[i]);
          end;
          inc(i);
        until (i >= ADataLen);
        LI.FileName := LFileName;
      end;
      repeat
        inc(i);
      until (i and $03)=0;
    end
    else
    begin
      Exit;
    end;
  until False;
end;

procedure TIdFSPListItems.SetItems(AIndex: Integer; const Value: TIdFSPListItem);
begin
  inherited Items[AIndex] := Value;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -