📄 idfsp.pas
字号:
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 + -