source: trunk/Packages/synapse/source/demo/sftp/SimpleSFTP.pas

Last change on this file was 2, checked in by chronos, 13 years ago
  • Přidáno: Základní kostra projektu.
  • Přidáno: Knihovna synapse.
File size: 62.1 KB
Line 
1unit SimpleSFTP;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ssl_cryptlib,
7 StdCtrls, blcksock, syncobjs, winsock, Math, CryptLib;
8
9// Example of SFTP client implementation. Based on
10// http://www.snailbook.com/docs/sftp.txt and PuTTY's source code.
11// Not tested carefully but directory listing and file transfer seems to work.
12// Requires cl32.dll (CryptLib) and Synapse 37b6 or newer !!!
13// If somebody knows how to extract file type information from file attributes
14// packet (I'm not sure that code in TSimpleSFTP.ParseFileNamePacket will work
15// in any case) then please let know to Sergey Gagarin (serg@screens.ru)
16
17const
18 //Really developing was started for version 6 (all constants and file
19 //attributes are from version 6, but server I've had for
20 //testing was version 3, so it was tested for version 3 only !!!
21 //Thanks to PuTTY source code, it was very usefull !
22 //Please note that not all capabilities were tested carefully !!!
23 SFTP_PROTOCOLCURRENTVERSION=3;
24
25 //sftp packet types
26 SSH_FXP_INIT =1;
27 SSH_FXP_VERSION =2;
28 SSH_FXP_OPEN =3;
29 SSH_FXP_CLOSE =4;
30 SSH_FXP_READ =5;
31 SSH_FXP_WRITE =6;
32 SSH_FXP_LSTAT =7;
33 SSH_FXP_FSTAT =8;
34 SSH_FXP_SETSTAT =9;
35 SSH_FXP_FSETSTAT =10;
36 SSH_FXP_OPENDIR =11;
37 SSH_FXP_READDIR =12;
38 SSH_FXP_REMOVE =13;
39 SSH_FXP_MKDIR =14;
40 SSH_FXP_RMDIR =15;
41 SSH_FXP_REALPATH =16;
42 SSH_FXP_STAT =17;
43 SSH_FXP_RENAME =18;
44 SSH_FXP_READLINK =19;
45 SSH_FXP_SYMLINK =20;
46 //server responce types
47 SSH_FXP_STATUS =101;
48 SSH_FXP_HANDLE =102;
49 SSH_FXP_DATA =103;
50 SSH_FXP_NAME =104;
51 SSH_FXP_ATTRS =105;
52 //extended packet types
53 SSH_FXP_EXTENDED =200;
54 SSH_FXP_EXTENDED_REPLY =201;
55// RESERVED_FOR_EXTENSIONS 210-255
56
57 //file attributes flags (for protocol version 6, but processed
58 //SSH_FILEXFER_ATTR_SIZE, SSH_FILEXFER_ATTR_PERMISSIONS
59 //and SSH_FILEXFER_ATTR_ACCESSTIME only !!! (no extensions)
60 //also flag 2 is processed but not used
61 SSH_FILEXFER_ATTR_SIZE =$00000001;
62 SSH_FILEXFER_ATTR_PERMISSIONS =$00000004;
63 SSH_FILEXFER_ATTR_ACCESSTIME =$00000008;
64 SSH_FILEXFER_ATTR_CREATETIME =$00000010;
65 SSH_FILEXFER_ATTR_MODIFYTIME =$00000020;
66 SSH_FILEXFER_ATTR_ACL =$00000040;
67 SSH_FILEXFER_ATTR_OWNERGROUP =$00000080;
68 SSH_FILEXFER_ATTR_SUBSECOND_TIMES =$00000100;
69 SSH_FILEXFER_ATTR_BITS =$00000200;
70 SSH_FILEXFER_ATTR_ALLOCATION_SIZE =$00000400;
71 SSH_FILEXFER_ATTR_TEXT_HINT =$00000800;
72 SSH_FILEXFER_ATTR_MIME_TYPE =$00001000;
73 SSH_FILEXFER_ATTR_LINK_COUNT =$00002000;
74 SSH_FILEXFER_ATTR_UNTRANLATED_NAME =$00004000;
75 SSH_FILEXFER_ATTR_EXTENDED =$80000000;
76
77 //file types (not present in version 3, but roughly "simulated"
78 //in method ParseFileNamePacket (unfortunately, permissions field seems to contain no file type info)
79 SSH_FILEXFER_TYPE_REGULAR =1;
80 SSH_FILEXFER_TYPE_DIRECTORY =2;
81 SSH_FILEXFER_TYPE_SYMLINK =3;
82 SSH_FILEXFER_TYPE_SPECIAL =4;
83 SSH_FILEXFER_TYPE_UNKNOWN =5;
84 SSH_FILEXFER_TYPE_SOCKET =6;
85 SSH_FILEXFER_TYPE_CHAR_DEVICE =7;
86 SSH_FILEXFER_TYPE_BLOCK_DEVICE =8;
87 SSH_FILEXFER_TYPE_FIFO =9;
88
89 //permissions
90 S_IRUSR =$0000400;
91 S_IWUSR =$0000200;
92 S_IXUSR =$0000100;
93 S_IRGRP =$0000040;
94 S_IWGRP =$0000020;
95 S_IXGRP =$0000010;
96 S_IROTH =$0000004;
97 S_IWOTH =$0000002;
98 S_IXOTH =$0000001;
99 S_ISUID =$0004000;
100 S_ISGID =$0002000;
101 S_ISVTX =$0001000;
102 //file type bits in permissions field
103 S_IFMT =$0170000;// bitmask for the file type bitfields
104 S_IFSOCK =$0140000;// socket
105 S_IFLNK =$0120000;// symbolic link
106 S_IFREG =$0100000;// regular file
107 S_IFBLK =$0060000;// block device
108 S_IFDIR =$0040000;// directory
109 S_IFCHR =$0020000;// character device
110 S_IFIFO =$0010000;// fifo
111
112 //file attributes
113 SSH_FILEXFER_ATTR_FLAGS_READONLY =$00000001;
114 SSH_FILEXFER_ATTR_FLAGS_SYSTEM =$00000002;
115 SSH_FILEXFER_ATTR_FLAGS_HIDDEN =$00000004;
116 SSH_FILEXFER_ATTR_FLAGS_CASE_INSENSITIVE =$00000008;
117 SSH_FILEXFER_ATTR_FLAGS_ARCHIVE =$00000010;
118 SSH_FILEXFER_ATTR_FLAGS_ENCRYPTED =$00000020;
119 SSH_FILEXFER_ATTR_FLAGS_COMPRESSED =$00000040;
120 SSH_FILEXFER_ATTR_FLAGS_SPARSE =$00000080;
121 SSH_FILEXFER_ATTR_FLAGS_APPEND_ONLY =$00000100;
122 SSH_FILEXFER_ATTR_FLAGS_IMMUTABLE =$00000200;
123 SSH_FILEXFER_ATTR_FLAGS_SYNC =$00000400;
124 SSH_FILEXFER_ATTR_FLAGS_TRANSLATION_ERR =$00000800;
125
126 //file access type
127 ACE4_READ_DATA =$00000001;
128 ACE4_LIST_DIRECTORY =$00000001;
129 ACE4_WRITE_DATA =$00000002;
130 ACE4_ADD_FILE =$00000002;
131 ACE4_APPEND_DATA =$00000004;
132 ACE4_ADD_SUBDIRECTORY =$00000004;
133 ACE4_READ_NAMED_ATTRS =$00000008;
134 ACE4_WRITE_NAMED_ATTRS =$00000010;
135 ACE4_EXECUTE =$00000020;
136 ACE4_DELETE_CHILD =$00000040;
137 ACE4_READ_ATTRIBUTES =$00000080;
138 ACE4_WRITE_ATTRIBUTES =$00000100;
139 ACE4_DELETE =$00010000;
140 ACE4_READ_ACL =$00020000;
141 ACE4_WRITE_ACL =$00040000;
142 ACE4_WRITE_OWNER =$00080000;
143 ACE4_SYNCHRONIZE =$00100000;
144
145 //open file flags
146 SSH_FXF_ACCESS_DISPOSITION = $00000007;
147 SSH_FXF_CREATE_NEW = $00000000;
148 SSH_FXF_CREATE_TRUNCATE = $00000001;
149 SSH_FXF_OPEN_EXISTING = $00000002;
150 SSH_FXF_OPEN_OR_CREATE = $00000003;
151 SSH_FXF_TRUNCATE_EXISTING = $00000004;
152 SSH_FXF_ACCESS_APPEND_DATA = $00000008;
153 SSH_FXF_ACCESS_APPEND_DATA_ATOMIC = $00000010;
154 SSH_FXF_ACCESS_TEXT_MODE = $00000020;
155 SSH_FXF_ACCESS_READ_LOCK = $00000040;
156 SSH_FXF_ACCESS_WRITE_LOCK = $00000080;
157 SSH_FXF_ACCESS_DELETE_LOCK = $00000100;
158 SSH_FXF_NOFOLLOW = $00000200;
159
160 //open file flags for protocol version 3 (as in PuTTY)
161 SSH_FXF_READ =$00000001;
162 SSH_FXF_WRITE =$00000002;
163 SSH_FXF_APPEND =$00000004;
164 SSH_FXF_CREAT =$00000008;
165 SSH_FXF_TRUNC =$00000010;
166 SSH_FXF_EXCL =$00000020;
167
168 //rename flags
169 SSH_FXP_RENAME_OVERWRITE =$00000001;
170 SSH_FXP_RENAME_ATOMIC =$00000002;
171 SSH_FXP_RENAME_NATIVE =$00000004;
172
173 //error codes
174 SSH_FX_OK =0;
175 SSH_FX_EOF =1;
176 SSH_FX_NO_SUCH_FILE =2;
177 SSH_FX_PERMISSION_DENIED =3;
178 SSH_FX_FAILURE =4;
179 SSH_FX_BAD_MESSAGE =5;
180 SSH_FX_NO_CONNECTION =6;
181 SSH_FX_CONNECTION_LOST =7;
182 SSH_FX_OP_UNSUPPORTED =8;
183 SSH_FX_INVALID_HANDLE =9;
184 SSH_FX_NO_SUCH_PATH =10;
185 SSH_FX_FILE_ALREADY_EXISTS =11;
186 SSH_FX_WRITE_PROTECT =12;
187 SSH_FX_NO_MEDIA =13;
188 SSH_FX_NO_SPACE_ON_FILESYSTEM =14;
189 SSH_FX_QUOTA_EXCEEDED =15;
190 SSH_FX_UNKNOWN_PRINCIPLE =16;
191 SSH_FX_LOCK_CONFlICT =17;
192 SSH_FX_DIR_NOT_EMPTY =18;
193 SSH_FX_NOT_A_DIRECTORY =19;
194 SSH_FX_INVALID_FILENAME =20;
195 SSH_FX_LINK_LOOP =21;
196
197type
198 TSimpleSFTP=class;//main class
199
200 TSFTPFileAttributes=record //complete structure for protocol version 6
201 FileName:string;
202 LongName:string;//present in version 3 only !
203 valid_attribute_flags:DWORD;
204 file_type:byte;// always present
205 size:int64;// present only if flag SIZE
206 allocation_size:int64;// present only if flag ALLOCATION_SIZE
207 owner:string;// present only if flag OWNERGROUP
208 group:string;// present only if flag OWNERGROUP
209 permissions:DWORD;// present only if flag PERMISSIONS
210 atime:int64;// present only if flag ACCESSTIME
211 atime_nseconds:DWORD;// present only if flag SUBSECOND_TIMES
212 createtime:int64;// present only if flag CREATETIME
213 createtime_nseconds:DWORD;// present only if flag SUBSECOND_TIMES
214 mtime:int64;// present only if flag MODIFYTIME
215 mtime_nseconds:DWORD;// present only if flag SUBSECOND_TIMES
216 acl:string;// present only if flag ACL
217 attrib_bits:DWORD;// present only if flag BITS
218 text_hint:byte;// present only if flag TEXT_HINT
219 mime_type:string;// present only if flag MIME_TYPE
220 link_count:DWORD;// present only if flag LINK_COUNT
221 untranslated_name:string;// present only if flag UNTRANSLATED_NAME
222 extended_count:DWORD;// present only if flag EXTENDED - parsed but not used here !
223// extended_type:string;// not used here !
224// extended_data:string;//
225 end;
226 PSFTPFileAttributes=^TSFTPFileAttributes;
227 //'atime', 'createtime', and 'mtime' - seconds from Jan 1, 1970 in UTC
228
229 TSFTPFileList=class(TObject)
230 protected
231 FList:TList;
232 function GetFile(i:Integer):PSFTPFileAttributes;
233 public
234 constructor Create;
235 destructor Destroy;override;
236 procedure Clear;
237 function Count:Integer;
238 procedure Add(FileRecord:TSFTPFileAttributes);
239 procedure Delete(i:Integer);
240 procedure Exchange(i,j:Integer);
241 procedure Sort(Compare:TListSortCompare);
242
243 property Files[i:Integer]:PSFTPFileAttributes read GetFile;default;
244 end;
245
246 TSimpleSFTPProgressCallback=function (UserData:Pointer;
247 Current,Total:Int64):Boolean of object;//returns False to abort
248 TSimpleSMPTEvent=procedure (Sender:TSimpleSFTP) of object;
249
250 TSimpleSFTP=class(TObject)
251 private
252 //just utils to set file times for local files
253 procedure GetLocalFileTimes(FileName:string;var AccessTime,CreateTime,ModifyTime:Int64);
254 procedure SetLocalFileTimes(FileName:string;AccessTime,CreateTime,ModifyTime:Int64);
255 //The only way we read server's data ! Do not use other socket read operations !
256 procedure ReceiveBuffer(Buffer:PChar;BufferSize:Integer);
257 protected
258 FSocket:TTCPBlockSocket;
259 FTimeout:DWORD;// timeout for data waitng (miliseconds)
260 FProtocolVersion:DWORD;
261 FRequestID:DWORD;
262 FEndOfLine:string;//processed but not used
263 FBufferSize:DWORD;
264 FRemotePathSeparator:string;
265 FCurrentDir:string;
266
267 procedure DoError(ErrorMessage:string);
268 procedure ResetSessionParams;
269 //file names and attributes processing
270 function ValidateRemoteDirName(RemoteDir:string):string;
271 function ParseFileNamePacket(FileList:TSFTPFileList;PacketData:string;ProcessAttributes:Boolean=True):Integer;
272 function ParseFileAttributes(AtributesString:string;var FieldOffset:Integer):TSFTPFileAttributes;
273 function BuildAttributesString(FileAttributes:PSFTPFileAttributes):string;
274 function BuildBlankAttributesString(IsDir:Boolean=False):string;
275 //sftp packet constructing and parsing
276 function BuildPacket(PaketType:Byte;Data:array of Pointer;DataSize:array of DWORD;
277 IsFixedSize:array of Boolean;SendRequestID:Boolean=True):string;
278 procedure AddDataToPacket(var PacketString:string;Data:array of Pointer;
279 DataSize:array of DWORD;IsFixedSize:array of Boolean);//to build packet step by step
280 function ParsePacketStrings(Data:string;Offset:Integer=0):TStringList;
281 function GetStatus(PacketData:string):DWORD;//get status from server's SSH_FXP_STATUS packet
282 function CheckStatus(PacketType:DWORD;PacketData:string;ErrorString:string):Boolean;
283
284 procedure SendPacket(Packet:string);
285 function ReceivePacket(RequestID:DWORD;var PacketType:Byte;ReceiveRequestID:Boolean=True):string;
286
287 procedure Init;
288 //internal file/dir operations
289 function SetRealPath(DirName:string):string;
290 function OpenFile(FileName:string;FileOpenFlags:DWORD):string;
291 function CloseFile(FileHandle:string):Boolean;
292 function OpenDir(DirName:string):string;
293 function CloseDir(DirHandle:string):Boolean;
294 function ReadFile(FileHandle:string;FileOffset:Int64;ReadSize:DWORD):string;
295 procedure WriteFile(FileHandle:string;FileOffset:Int64;FileData:Pointer;DataSize:DWORD);
296 procedure ReadDir(DirHandle:string;FileList:TSFTPFileList);
297 //internal file attributes operations
298 procedure InternalGetFileAtributes(PacketType:BYTE;FileID:string;//name or handle
299 AttributeFlags:DWORD;var Attributes:TSFTPFileAttributes);
300 procedure GetFileAtributesByHandle(FileHandle:string;var Attributes:TSFTPFileAttributes);
301 procedure SetFileAtributesByHandle(FileHandle:string;Attributes:PSFTPFileAttributes);
302 procedure GetFileTimesByHandle(FileHandle:string;var AccessTime,CreateTime,ModifyTime:Int64);
303 procedure SetFileTimesByHandle(FileHandle:string;AccessTime,CreateTime,ModifyTime:Int64);
304 function GetFileSizeByHandle(FileHandle:string):Int64;
305 public
306 constructor Create;virtual;
307 destructor Destroy;override;
308
309 procedure Connect(Host,Port,UserName,Password:string);
310 procedure Disconnect;
311
312 //file operation
313 function PutFile(LocalFileName,RemoteDir:string;PreserveFileTimes:Boolean=True;Overwrite:Boolean=True;
314 Append:Boolean=False;SourceStartPos:Int64=0;Callback:TSimpleSFTPProgressCallback=nil;UserData:Pointer=nil):Int64;
315 function GetFile(RemoteDir,RemoteFileName,LocalFileName:string;PreserveFileTimes:Boolean=True;Overwrite:Boolean=True;
316 Append:Boolean=False;SourceStartPos:Int64=0;Callback:TSimpleSFTPProgressCallback=nil;UserData:Pointer=nil):Int64;
317 procedure DeleteFile(FileName:string);
318 procedure RenameFile(OldName,NewName:string;FailIfExists:Boolean);
319 function FileExists(FileName:string):Boolean;
320
321 //dir operation (not all tested :-) )
322 function GetCurrentDir:string;
323 function SetCurrentDir(DirName:string):string;
324 procedure ListDir(DirName:string;FileList:TSFTPFileList);
325 procedure CreateDir(DirName:string;Attributes:PSFTPFileAttributes=nil);
326 procedure DeleteDir(DirName:string);
327
328 //file attributes opearations
329 procedure GetFileAtributes(FileName:string;var Attributes:TSFTPFileAttributes;FollowLink:Boolean=True);
330 procedure SetFileAtributes(FileName:string;Attributes:PSFTPFileAttributes);
331 procedure GetFileTimes(FileName:string;var AccessTime,CreateTime,ModifyTime:Int64);
332 procedure SetFileTimes(FileName:string;AccessTime,CreateTime,ModifyTime:Int64);
333 function GetFileSize(FileName:string):Int64;
334
335 property Socket:TTCPBlockSocket read FSocket;
336 end;
337
338implementation
339
340const //error messages
341 STRING_NOTIMPLEMENTED='Not implemented';
342 STRING_INVALIDOUTPACKETDATA='Invalid out packet data';
343 STRING_INVALIDINPACKETDATA='Invalid in packet data';
344 STRING_UNEXPECTEDPACKETTYPE='Unexpected packet type';
345 STRING_UNABLETOINIT='Unable to init';
346 STRING_INVALIDBUFFERSIZE='Invalid buffer size';
347 STRING_INVALIDFILEPOS='Invalid file position';
348 STRING_FILETRANSFERABORTED='File transfer aborted';
349 STRING_UNABLETOOPENFILE='Unable to open file';
350 STRING_UNABLETOOPENDIR='Unable to open directory';
351 STRING_UNABLETOCLOSEHANDLE='Unable to close handle';
352 STRING_UNABLETOREADFILE='Unable to read file';
353 STRING_UNABLETOREADDIR='Unable to read directory';
354 STRING_UNABLETOWRITETOFILE='Unable to write to file';
355 STRING_UNABLETODELETEFILE='Unable to delete file';
356 STRING_UNABLETORENAMEFILE='Unable to rename file';
357 STRING_UNABLETOCREATEDIR='Unable to create directory';
358 STRING_UNABLETODELETEDIR='Unable to delete directory';
359 STRING_UNABLETOSETFILEATTRIBUTES='Unable to set file attributes';
360 STRING_INVALIDFILENAMECOUNT='Invalid file name count';
361 STRING_RECEIVETIMEOUT='Receive timeout';
362 STRING_UNEXPECTEDSSHMESSAGE='Unexpected SSH message';
363 STRING_INVALIDCHANNELID='Invalid channel ID';
364 STRING_INVALIDPROTOCOLVERSION='Invalid protocol version';
365 STRING_UNABLETOSETPATH='Unable to set path';
366 STRING_UNABLETOSETBUFFERSIZE='Unable to set buffer size';
367 STRING_UNABLETOGETFILEATTRIBUTES='Unable to get file attributes';
368 STRING_UNABLETOGETFILESIZE='Unable to get file size';
369 STRING_UNABLETOGETFILETIMES='Unable to get file times';
370 STRING_UNABLETOSETFILETIMES='Unable to set file times';
371 STRING_UNABLETORECEIVEPACKETDATA='Unable to receive packet data';
372 STRING_UNABLETOSENDPACKETDATA='Unable to receive packet data';
373 STRING_UNKNOWNERROR='Unknown error';
374
375
376//************************************************************************
377//************************ File time converting utils ********************
378//************************************************************************
379// FileTime - number of 100-nanosecond intervals since January 1, 1601
380// SFTPFileTime - number of seconds since January 1, 1970
381// day_diff=134774
382const
383 DAY_DIFF:Int64=134774;
384 SECONDS_IN_DAY:Int64=86400;
385
386function FileTimeToSFTPFileTime(FileTime:Int64):Int64;
387begin
388 Result:=(FileTime div 10000000)-DAY_DIFF*SECONDS_IN_DAY;
389end;
390
391function SFTPFileTimeToFileTime(FileTime:Int64):Int64;
392begin
393 Result:=(FileTime+DAY_DIFF*SECONDS_IN_DAY)*10000000;
394end;
395
396//************************************************************************
397//************** Some utils to work with SFTP packet fields **************
398//************************************************************************
399
400function PutDataToString(Buffer:Pointer;Size:Integer):string;
401begin
402 SetLength(Result,Size);
403 CopyMemory(@Result[1],Buffer,Size);
404end;
405
406function InvertDWORD(Value:DWORD):DWORD;//SFTP uses inverted byte order !!!
407begin
408 Result:=((Value and $FF) shl 24) or ((Value and $FF00) shl 8) or
409 ((Value and $FF0000) shr 8) or ((Value and $FF000000) shr 24);
410end;
411
412function InvertInt64(Value:Int64):Int64;
413begin
414 PDWORD(@Result)^:=InvertDWORD(PDWORD(Integer(@Value)+SizeOf(DWORD))^);
415 PDWORD(Integer(@Result)+SizeOf(DWORD))^:=InvertDWORD(PDWORD(@Value)^);
416end;
417
418function PutDWORD(Value:DWORD):string;
419begin
420 Value:=InvertDWORD(Value);
421 Result:=PutDataToString(@Value,SizeOf(Value));
422end;
423
424function GetDWORD(Buffer:Pointer):DWORD;
425begin
426 Result:=InvertDWORD(PDWORD(Buffer)^);
427end;
428
429function PutFixedPacketField(Buffer:Pointer;FieldSize:Integer):string;
430var CurDWORD:DWORD;
431begin //fixed size fields (DWORD, QWORD) are stored without field size
432 SetLength(Result,FieldSize);
433 case FieldSize of
434 SizeOf(DWORD): Result:=PutDWORD(PDWORD(Buffer)^);
435 SizeOf(Int64):
436 Result:=PutDWORD(PDWORD(PChar(Buffer)+SizeOf(DWORD))^)+PutDWORD(PDWORD(Buffer)^);
437 else Result:=PutDataToString(Buffer,FieldSize);
438 end;
439end;
440
441function PutStringPacketField(Buffer:string):string;
442begin //string fields are stored with their length
443 Result:=PutDWORD(Length(Buffer))+Buffer;
444end;
445
446procedure GetFixedPacketField(PacketData:string;var FieldOffset:Integer;
447 Buffer:Pointer;FieldSize:Integer);
448var CurDWORD:DWORD;
449begin
450 case FieldSize of
451 SizeOf(DWORD):
452 begin
453 CurDWORD:=GetDWORD(@PacketData[FieldOffset]);
454 CopyMemory(Buffer,@CurDWORD,SizeOf(DWORD));
455 end;
456 SizeOf(Int64):
457 begin
458 CurDWORD:=GetDWORD(@PacketData[FieldOffset]);
459 CopyMemory(PChar(Buffer)+SizeOf(DWORD),@CurDWORD,SizeOf(DWORD));
460 CurDWORD:=GetDWORD(@PacketData[FieldOffset+SizeOf(DWORD)]);
461 CopyMemory(Buffer,@CurDWORD,SizeOf(DWORD));
462 end;
463 else CopyMemory(Buffer,@PacketData[FieldOffset],FieldSize);
464 end;
465 Inc(FieldOffset,FieldSize);
466end;
467
468function GetStringPacketField(PacketData:string;var FieldOffset:Integer):string;
469var FieldSize:DWORD;
470begin
471 FieldSize:=GetDWORD(@PacketData[FieldOffset]);
472 Inc(FieldOffset,SizeOf(FieldSize));
473 SetLength(Result,FieldSize);
474 CopyMemory(@Result[1],@PacketData[FieldOffset],FieldSize);
475 Inc(FieldOffset,FieldSize);
476end;
477
478//****************************************************************
479//*********************** TSFTPFileList **************************
480//****************************************************************
481// list of file names and attributes
482
483constructor TSFTPFileList.Create;
484begin
485 inherited Create;
486 FList:=TList.Create;
487end;
488
489destructor TSFTPFileList.Destroy;
490begin
491 Clear;
492 FList.Free;
493 inherited Destroy;
494end;
495
496function TSFTPFileList.GetFile(i:Integer):PSFTPFileAttributes;
497begin
498 Result:=PSFTPFileAttributes(FList[i]);
499end;
500
501procedure TSFTPFileList.Clear;
502var i:Integer;
503begin
504 for i:=FList.Count-1 downto 0 do Delete(i);
505end;
506
507function TSFTPFileList.Count:Integer;
508begin
509 Result:=FList.Count;
510end;
511
512procedure TSFTPFileList.Add(FileRecord:TSFTPFileAttributes);
513var NewRecord:PSFTPFileAttributes;
514begin
515 New(NewRecord);
516 NewRecord^:=FileRecord;
517 FList.Add(NewRecord);
518end;
519
520procedure TSFTPFileList.Delete(i:Integer);
521begin
522 Dispose(PSFTPFileAttributes(FList[i]));
523 FList.Delete(i);
524end;
525
526procedure TSFTPFileList.Exchange(i,j:Integer);
527begin
528 FList.Exchange(i,j);
529end;
530
531procedure TSFTPFileList.Sort(Compare:TListSortCompare);
532begin
533 FList.Sort(Compare);
534end;
535
536//************************************************************************
537//****************************** TSimpleSFTP *****************************
538//************************************************************************
539
540constructor TSimpleSFTP.Create;
541begin
542 inherited Create;
543 FSocket:=TTCPBlockSocket.CreateWithSSL(TSSLCryptLib);
544 FSocket.RaiseExcept:=True;
545 FTimeout:=60000;
546 ResetSessionParams;
547end;
548
549destructor TSimpleSFTP.Destroy;
550begin
551 Disconnect;
552 try
553 FSocket.Free;
554 except
555 end;
556 inherited Destroy;
557end;
558
559procedure TSimpleSFTP.DoError(ErrorMessage:string);
560begin
561 if Trim(ErrorMessage)='' then ErrorMessage:=STRING_UNKNOWNERROR;
562 raise Exception.Create(ErrorMessage);
563end;
564
565procedure TSimpleSFTP.ResetSessionParams;
566begin
567 FProtocolVersion:=SFTP_PROTOCOLCURRENTVERSION;
568 FRequestID:=5;
569 FEndOfLine:=#13#10;
570 FBufferSize:=32768;
571 FRemotePathSeparator:='/';
572 FCurrentDir:='.';
573end;
574
575procedure TSimpleSFTP.Connect(Host,Port,UserName,Password:string);
576var NoDelay:Boolean;
577begin //setup proxy settings, ... before connecting
578 FSocket.RaiseExcept:=True;
579 try
580 FSocket.Connect(Host,Port);
581 //CryptLib manual recommends to disable the Nagle algorithm
582 NoDelay:=True;
583 setsockopt(FSocket.Socket,IPPROTO_TCP,TCP_NODELAY,@NoDelay,SizeOf(NoDelay));
584 //do ssh handshake
585 FSocket.SSL.SSLType:=LT_SSHv2;
586 FSocket.SSL.Username:=UserName;
587 FSocket.SSL.Password:=Password;
588 FSocket.SSL.SSHChannelType:='subsystem';
589 FSocket.SSL.SSHChannelArg1:='sftp';
590 FSocket.SSLDoConnect;
591 //negotiate protocol version
592 ResetSessionParams;
593 Init;
594 except
595 Disconnect;
596 raise;
597 end;
598end;
599
600procedure TSimpleSFTP.Disconnect;
601begin
602 try
603 FSocket.RaiseExcept:=False;
604 if FSocket.Socket<>INVALID_SOCKET then FSocket.CloseSocket;
605 except
606 end;
607end;
608
609procedure TSimpleSFTP.GetLocalFileTimes(FileName:string;var AccessTime,CreateTime,ModifyTime:Int64);
610var Handle:THandle;
611begin //CreateTime is not used in version 3
612 CreateTime:=0;
613 AccessTime:=0;
614 ModifyTime:=0;
615 Handle:=CreateFile(PChar(FileName),GENERIC_READ,FILE_SHARE_READ+FILE_SHARE_WRITE,nil,OPEN_EXISTING,0,0);
616 try
617 if Handle=INVALID_HANDLE_VALUE then DoError(STRING_UNABLETOGETFILETIMES+': '+FileName);
618 if not Windows.GetFileTime(Handle,@CreateTime,@AccessTime,@ModifyTime) then Exit;
619 CreateTime:=FileTimeToSFTPFileTime(CreateTime);
620 AccessTime:=FileTimeToSFTPFileTime(AccessTime);
621 ModifyTime:=FileTimeToSFTPFileTime(ModifyTime);
622 finally
623 CloseHandle(Handle);
624 end;
625end;
626
627procedure TSimpleSFTP.SetLocalFileTimes(FileName:string;AccessTime,CreateTime,ModifyTime:Int64);
628var Handle:THandle;AccessTimeP,CreateTimeP,ModifyTimeP:Pointer;
629begin //CreateTime is not used in version 3 (may be set CreateTime:=ModifyTime ?)
630 if CreateTime<>0 then CreateTime:=SFTPFileTimeToFileTime(CreateTime);
631 if AccessTime<>0 then AccessTime:=SFTPFileTimeToFileTime(AccessTime);
632 if ModifyTime<>0 then ModifyTime:=SFTPFileTimeToFileTime(ModifyTime);
633 if AccessTime=0 then AccessTimeP:=nil else AccessTimeP:=@AccessTime;
634 if CreateTime=0 then CreateTimeP:=nil else CreateTimeP:=@CreateTime;
635 if ModifyTime=0 then ModifyTimeP:=nil else ModifyTimeP:=@ModifyTime;
636 Handle:=CreateFile(PChar(FileName),GENERIC_WRITE,FILE_SHARE_READ+FILE_SHARE_WRITE,nil,OPEN_EXISTING,0,0);
637 try
638 if Handle=INVALID_HANDLE_VALUE then DoError(STRING_UNABLETOSETFILETIMES+': '+FileName);
639 if not Windows.SetFileTime(Handle,CreateTimeP,AccessTimeP,ModifyTimeP) then Exit;
640 finally
641 CloseHandle(Handle);
642 end;
643end;
644
645function TSimpleSFTP.BuildPacket(PaketType:Byte;Data:array of Pointer;
646 DataSize:array of DWORD;IsFixedSize:array of Boolean;SendRequestID:Boolean=True):string;
647var i:Integer;CurField:string;FieldSize:DWORD;
648begin //always increases FRequestID !
649 if (Length(Data)<>Length(DataSize)) or (Length(Data)<>Length(IsFixedSize))
650 then DoError(STRING_INVALIDOUTPACKETDATA);
651 Result:='';
652 //store packet fields
653 for i:=Low(Data) to High(Data) do
654 begin
655 FieldSize:=DataSize[i];
656 if FieldSize>0 then
657 begin
658 CurField:=PutDataToString(Data[i],FieldSize);
659 //if not IsFixedSize then store field size too
660 if not IsFixedSize[i] then CurField:=PutDWORD(FieldSize)+CurField;
661 Result:=Result+CurField;
662 end;
663 end;
664 //store packet request id
665 if SendRequestID then Result:=PutDWORD(FRequestID)+Result;
666 //store packet type
667 Result:=Char(PaketType)+Result;
668 //store packet size
669 Result:=PutDWORD(Length(Result))+Result;
670 Inc(FRequestID);
671end;
672
673procedure TSimpleSFTP.AddDataToPacket(var PacketString:string;Data:array of Pointer;
674 DataSize:array of DWORD;IsFixedSize:array of Boolean);
675var i:Integer;CurField:string;FieldSize:DWORD;
676begin //just add field to packet string (not increases FRequestID , but modifies packet size)
677 if (Length(Data)<>Length(DataSize)) or (Length(Data)<>Length(IsFixedSize))
678 or (PacketString='') then DoError(STRING_INVALIDOUTPACKETDATA);
679 //store packet fields
680 for i:=Low(Data) to High(Data) do
681 begin
682 FieldSize:=DataSize[i];
683 if FieldSize>0 then
684 begin
685 CurField:=PutDataToString(Data[i],FieldSize);
686 if not IsFixedSize[i] then CurField:=PutDWORD(FieldSize)+CurField;
687 PacketString:=PacketString+CurField;
688 end;
689 end;
690 //set new packet size
691 FieldSize:=Length(PacketString);
692 CopyMemory(@PacketString[1],@FieldSize,SizeOf(FieldSize));
693end;
694
695function TSimpleSFTP.ParsePacketStrings(Data:string;Offset:Integer=0):TStringList;
696var CurPos,CurSize:DWORD;
697begin //assumed that packet contains string fields only starting from Offset
698 if Offset>0 then Data:=Copy(Data,Offset,Length(Data));
699 Result:=TStringList.Create;
700 try
701 CurPos:=1;
702 while CurPos<(Length(Data)-SizeOf(CurSize)+1) do
703 begin
704 CurSize:=GetDWORD(@Data[CurPos]);
705 Result.Add(Copy(Data,CurPos+SizeOf(CurSize),CurSize));
706 CurPos:=CurPos+SizeOf(CurSize)+CurSize;
707 end;
708 except
709 Result.Free;
710 raise;
711 end;
712end;
713
714procedure TSimpleSFTP.SendPacket(Packet:string);
715var SentLength,CurDataSize:Integer;StartTime:DWORD;
716begin
717 FSocket.SendBuffer(@Packet[1],Length(Packet));
718end;
719
720procedure TSimpleSFTP.ReceiveBuffer(Buffer:PChar;BufferSize:Integer);
721begin
722 FSocket.RecvBufferEx(Buffer,BufferSize,FTimeout);
723end;
724
725function TSimpleSFTP.ReceivePacket(RequestID:DWORD;var PacketType:Byte;ReceiveRequestID:Boolean=True):string;
726var PacketSize,CurRequestID,CurSize,CurDataSize:DWORD;PacketData:string;CurPacketType:BYTE;
727 CurData:AnsiString;StartTime:DWORD;ReceivedLength:Integer;CurBuffer:string;
728begin
729 Result:='';
730 while True do
731 begin
732 //receive packet size
733 ReceiveBuffer(@PacketSize,SizeOf(PacketSize));
734 PacketSize:=GetDWORD(@PacketSize);
735 //receive packet type
736 ReceiveBuffer(@CurPacketType,SizeOf(CurPacketType));
737 CurSize:=SizeOf(CurPacketType);
738 //receive request id
739 if ReceiveRequestID then
740 begin
741 ReceiveBuffer(@CurRequestID,SizeOf(CurRequestID));
742 CurRequestID:=GetDWORD(@CurRequestID);
743 CurSize:=CurSize+SizeOf(CurRequestID);
744 end;
745 //receive packet data
746 SetLength(Result,PacketSize-CurSize);
747 ReceiveBuffer(@Result[1],Length(Result));
748 //check RequestID and PacketType (-1 and 0 means any ...)
749 if (not ReceiveRequestID) or (RequestID=-1) or (RequestID=CurRequestID) then
750 begin
751 if (PacketType<>0) and (PacketType<>CurPacketType) then
752 DoError(STRING_UNEXPECTEDPACKETTYPE+': '+IntToStr(PacketType)+'<>'+IntToStr(CurPacketType));
753 PacketType:=CurPacketType;
754 Break;
755 end;
756 end;
757end;
758
759procedure TSimpleSFTP.Init;
760var PacketData:string;PacketStrings:TStringList;i,FieldOffset:Integer;PacketType:Byte;
761 TmpProtocolVersion,CurProtocolVersion:DWORD;
762begin //negotiate protocol version (we support version 3 only!)
763 PacketType:=SSH_FXP_INIT;
764 TmpProtocolVersion:=InvertDWORD(FProtocolVersion);
765 SendPacket(BuildPacket(PacketType,[@TmpProtocolVersion],[SizeOf(TmpProtocolVersion)],[True],False));
766 PacketType:=SSH_FXP_VERSION;
767 PacketData:=ReceivePacket(FRequestID-1,PacketType,False);
768 FieldOffset:=1;
769 //get protocol version
770 GetFixedPacketField(PacketData,FieldOffset,@CurProtocolVersion,SizeOf(CurProtocolVersion));
771 if FProtocolVersion<CurProtocolVersion then
772 DoError(STRING_INVALIDPROTOCOLVERSION+': '+IntToStr(FProtocolVersion)+'<'+IntToStr(CurProtocolVersion));
773 FProtocolVersion:=CurProtocolVersion;
774 //parse extensions (if any)
775 if FieldOffset<Length(PacketData) then
776 begin
777 PacketStrings:=ParsePacketStrings(PacketData,FieldOffset);
778 try
779 i:=0;
780 while i<(PacketStrings.Count-1) do
781 begin //iterate pairs of string for extensions
782 if PacketStrings[i]='newline' then
783 begin
784 FEndOfLine:=PacketStrings[i+1];
785 Break;
786 end;
787 Inc(i,2);
788 end;
789 finally
790 PacketStrings.Free;
791 end;
792 end;
793 FCurrentDir:=SetCurrentDir(FCurrentDir);
794end;
795
796function TSimpleSFTP.SetCurrentDir(DirName:string):string;
797var DirHandle:string;
798begin
799 if DirName='' then DirName:='.';
800 //if DirName not started from '/' then build fill dir name: FCurrentDir+'/'+DirName
801 if Copy(DirName,1,Length(FRemotePathSeparator))<>FRemotePathSeparator then
802 DirName:=ValidateRemoteDirName(FCurrentDir)+DirName;
803 Result:=SetRealPath(DirName);
804 //try open new dir (just to check if it exists)
805 DirHandle:=OpenDir(Result);
806 CloseDir(DirHandle);
807 FCurrentDir:=Result;
808end;
809
810function TSimpleSFTP.GetCurrentDir:string;
811begin
812 Result:=SetCurrentDir('.');
813end;
814
815function TSimpleSFTP.SetRealPath(DirName:string):string;
816var PacketType:BYTE;PacketString,PacketData:string;FileList:TSFTPFileList;
817begin
818 PacketType:=SSH_FXP_REALPATH;
819 DirName:=DirName;
820 PacketString:=BuildPacket(PacketType,[@DirName[1]],[Length(DirName)],[False]);
821 SendPacket(PacketString);
822 PacketType:=0;
823 PacketData:=ReceivePacket(FRequestID-1,PacketType,True);
824 CheckStatus(PacketType,PacketData,STRING_UNABLETOSETPATH+': '+DirName);
825 if PacketType<>SSH_FXP_NAME then DoError(STRING_UNABLETOSETPATH+': '+DirName);
826 FileList:=TSFTPFileList.Create;
827 try
828 ParseFileNamePacket(FileList,PacketData,False);
829 if FileList.Count=0 then DoError(STRING_UNABLETOSETPATH+': '+DirName);
830 Result:=FileList[0].FileName;
831 finally
832 FileList.Free;
833 end;
834end;
835
836function TSimpleSFTP.FileExists(FileName:string):Boolean;
837var Attributes:TSFTPFileAttributes;FileOpenFlags:DWORD;FileHandle:string;
838begin //catches exception !
839 try
840 if FProtocolVersion>3 then FileOpenFlags:=SSH_FXF_OPEN_EXISTING
841 else FileOpenFlags:=SSH_FXF_READ;
842 FileHandle:=OpenFile(FileName,FileOpenFlags);
843 CloseFile(FileHandle);
844 Result:=True;
845 except
846 Result:=False;
847 end;
848end;
849
850function TSimpleSFTP.GetFileSizeByHandle(FileHandle:string):Int64;
851var Attributes:TSFTPFileAttributes;
852begin
853 GetFileAtributesByHandle(FileHandle,Attributes);
854 if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_SIZE)<>0 then Result:=Attributes.size
855 else DoError(STRING_UNABLETOGETFILESIZE);
856end;
857
858function TSimpleSFTP.GetFileSize(FileName:string):Int64;
859var Attributes:TSFTPFileAttributes;
860begin
861 GetFileAtributes(FileName,Attributes);
862 if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_SIZE)<>0 then Result:=Attributes.size
863 else DoError(STRING_UNABLETOGETFILESIZE);
864end;
865
866procedure TSimpleSFTP.GetFileTimes(FileName:string;var AccessTime,CreateTime,ModifyTime:Int64);
867var Attributes:TSFTPFileAttributes;
868begin
869 GetFileAtributes(FileName,Attributes);
870 AccessTime:=0;
871 CreateTime:=0;
872 ModifyTime:=0;
873 if FProtocolVersion>3 then
874 begin
875 if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_ACCESSTIME)<>0 then
876 AccessTime:=Attributes.atime;
877 if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_CREATETIME)<>0 then
878 CreateTime:=Attributes.createtime;
879 if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_MODIFYTIME)<>0 then
880 ModifyTime:=Attributes.mtime;
881 end
882 else
883 begin
884 if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_ACCESSTIME)<>0 then
885 begin
886 AccessTime:=Attributes.atime;
887 ModifyTime:=Attributes.mtime;
888 end;
889 end;
890end;
891
892procedure TSimpleSFTP.GetFileTimesByHandle(FileHandle:string;var AccessTime,CreateTime,ModifyTime:Int64);
893var Attributes:TSFTPFileAttributes;
894begin
895 GetFileAtributesByHandle(FileHandle,Attributes);
896 AccessTime:=0;
897 CreateTime:=0;
898 ModifyTime:=0;
899 if FProtocolVersion>3 then
900 begin
901 if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_ACCESSTIME)<>0 then
902 AccessTime:=Attributes.atime;
903 if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_CREATETIME)<>0 then
904 CreateTime:=Attributes.createtime;
905 if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_MODIFYTIME)<>0 then
906 ModifyTime:=Attributes.mtime;
907 end
908 else
909 begin
910 if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_ACCESSTIME)<>0 then
911 begin
912 AccessTime:=Attributes.atime;
913 ModifyTime:=Attributes.mtime;
914 end;
915 end;
916end;
917
918function TSimpleSFTP.ValidateRemoteDirName(RemoteDir:string):string;
919begin //just add trailing '/' if needed
920 if (RemoteDir<>'') and (Copy(RemoteDir,Length(RemoteDir)-Length(FRemotePathSeparator)+1,
921 Length(FRemotePathSeparator))<>FRemotePathSeparator)
922 then Result:=RemoteDir+FRemotePathSeparator else Result:=RemoteDir;
923end;
924
925function TSimpleSFTP.PutFile(LocalFileName,RemoteDir:string;PreserveFileTimes:Boolean=True;Overwrite:Boolean=True;
926 Append:Boolean=False;SourceStartPos:Int64=0;Callback:TSimpleSFTPProgressCallback=nil;UserData:Pointer=nil):Int64;
927var FileHandle,Buffer:string;FileStream:TFileStream;CurrentRemoteOffset,TotalSize:Int64;CurRead:Integer;
928 FileOpenFlags:DWORD;AccessTime,CreateTime,ModifyTime:Int64;RemoteFileName:string;
929begin //returns sent size (indeed if sent size is not file size then raise exception :-) )
930 Result:=0;
931 FileOpenFlags:=0;
932 if FProtocolVersion>3 then
933 begin
934 if Overwrite then FileOpenFlags:=(FileOpenFlags or SSH_FXF_CREATE_NEW)
935 else FileOpenFlags:=(FileOpenFlags or SSH_FXF_OPEN_OR_CREATE);
936 if Append and not Overwrite then FileOpenFlags:=FileOpenFlags or SSH_FXF_ACCESS_APPEND_DATA;
937 end
938 else
939 begin //as in PuTTY
940 FileOpenFlags:=SSH_FXF_WRITE;
941 if Overwrite then FileOpenFlags:=FileOpenFlags or SSH_FXF_WRITE or SSH_FXF_CREAT;
942 if not Append then FileOpenFlags:=FileOpenFlags or SSH_FXF_TRUNC;
943 end;
944 RemoteFileName:=ValidateRemoteDirName(RemoteDir)+ExtractFileName(LocalFileName);
945 //open remote file
946 FileHandle:=OpenFile(RemoteFileName,FileOpenFlags);
947 try
948 if Append then CurrentRemoteOffset:=GetFileSizeByHandle(FileHandle) else CurrentRemoteOffset:=0;
949 if FBufferSize<=0 then DoError(STRING_INVALIDBUFFERSIZE);
950 SetLength(Buffer,FBufferSize);
951 //open local file
952 FileStream:=TFileStream.Create(LocalFileName,fmOpenRead or fmShareDenyNone);
953 try
954 TotalSize:=FileStream.Size-SourceStartPos;
955 //local file offset
956 FileStream.Seek(SourceStartPos,soFromBeginning);
957 if FileStream.Position<>SourceStartPos then
958 DoError(STRING_INVALIDFILEPOS+': '+LocalFileName+' ('+IntToStr(SourceStartPos)+')');
959 while Result<TotalSize do
960 begin
961 //read local file
962 CurRead:=FileStream.Read(Buffer[1],FBufferSize);
963 if CurRead>0 then //write remote file
964 WriteFile(FileHandle,CurrentRemoteOffset,@Buffer[1],CurRead);
965 CurrentRemoteOffset:=CurrentRemoteOffset+CurRead;
966 Result:=Result+CurRead;
967 if CurRead<FBufferSize then Break;
968 //call progress procedure and abort if it returns false
969 if Assigned(Callback) and not Callback(UserData,Result,TotalSize) then
970 DoError(STRING_FILETRANSFERABORTED+': '+LocalFileName);
971 end;
972 //end of remote file (send empty data packet) - it seems not necessary
973 WriteFile(FileHandle,CurrentRemoteOffset,@Buffer[1],0);
974 finally
975 FileStream.Free;
976 end;
977 finally
978 try
979 CloseFile(FileHandle);
980 except
981 end;
982 end;
983 if PreserveFileTimes then
984 begin
985 GetLocalFileTimes(LocalFileName,AccessTime,CreateTime,ModifyTime);
986 SetFileTimes(RemoteFileName,AccessTime,CreateTime,ModifyTime);
987 end;
988end;
989
990function TSimpleSFTP.GetFile(RemoteDir,RemoteFileName,LocalFileName:string;PreserveFileTimes:Boolean=True;Overwrite:Boolean=True;
991 Append:Boolean=False;SourceStartPos:Int64=0;Callback:TSimpleSFTPProgressCallback=nil;UserData:Pointer=nil):Int64;
992var FileHandle,Buffer:string;FileStream:TFileStream;CurrentRemoteOffset,TotalSize:Int64;
993 CurRead,CurNeedRead:Integer;FileOpenFlags:DWORD;AccessTime,CreateTime,ModifyTime:Int64;
994begin //returns received size (transfer breaking on server's EOF or small received buffer size)
995 Result:=0;
996 FileOpenFlags:=0;
997 if FProtocolVersion>3 then FileOpenFlags:=SSH_FXF_OPEN_EXISTING
998 else FileOpenFlags:=SSH_FXF_READ;
999 RemoteFileName:=ValidateRemoteDirName(RemoteDir)+RemoteFileName;
1000 //open remote file
1001 FileHandle:=OpenFile(RemoteFileName,FileOpenFlags);
1002 try
1003 if FBufferSize<=0 then DoError(STRING_INVALIDBUFFERSIZE);
1004 FileOpenFlags:=0;
1005 if Overwrite then
1006 begin
1007 SysUtils.DeleteFile(LocalFileName);
1008 FileOpenFlags:=fmCreate;
1009 end
1010 else FileOpenFlags:=fmOpenWrite;
1011 //open local file
1012 FileStream:=TFileStream.Create(LocalFileName,FileOpenFlags);
1013 try
1014 //local file offset
1015 if Append and not Overwrite then FileStream.Seek(0,soFromEnd);
1016 //remote file size
1017 TotalSize:=GetFileSizeByHandle(FileHandle)-SourceStartPos;
1018 if TotalSize<0 then DoError(STRING_INVALIDFILEPOS+': '+RemoteFileName+' ('+IntToStr(SourceStartPos)+')');
1019 while Result<TotalSize do
1020 begin
1021 //read remote file
1022 Buffer:=ReadFile(FileHandle,SourceStartPos,FBufferSize);
1023 CurRead:=Length(Buffer);
1024 if CurRead>0 then //write local file
1025 FileStream.Write(Buffer[1],CurRead);
1026 Inc(SourceStartPos,CurRead);
1027 Inc(Result,CurRead);
1028 if CurRead<FBufferSize then Break;
1029 if Assigned(Callback) and not Callback(UserData,Result,TotalSize) then
1030 DoError(STRING_FILETRANSFERABORTED+': '+RemoteFileName);
1031 end;
1032 finally
1033 FileStream.Free;
1034 end;
1035 finally
1036 try
1037 CloseFile(FileHandle);
1038 except
1039 end;
1040 end;
1041 if PreserveFileTimes then
1042 begin
1043 GetFileTimes(RemoteFileName,AccessTime,CreateTime,ModifyTime);
1044 SetLocalFileTimes(LocalFileName,AccessTime,CreateTime,ModifyTime);
1045 end;
1046end;
1047
1048function TSimpleSFTP.OpenFile(FileName:string;FileOpenFlags:DWORD):string;
1049var FileAccess,FileAccessSize:DWORD;PacketType:BYTE;Atributes:TSFTPFileAttributes;
1050 AtributesString,PacketString,PacketData:string;FieldOffset:Integer;
1051begin //returns file handle
1052 PacketType:=SSH_FXP_OPEN;
1053 if FProtocolVersion>3 then FileAccessSize:=SizeOf(FileAccess) else FileAccessSize:=0;
1054 FileAccess:=ACE4_WRITE_DATA+ACE4_WRITE_ATTRIBUTES;
1055 AtributesString:=BuildBlankAttributesString;
1056 FileAccess:=InvertDWORD(FileAccess);
1057 FileOpenFlags:=InvertDWORD(FileOpenFlags);
1058 PacketString:=BuildPacket(PacketType,[@FileName[1],@FileAccess,@FileOpenFlags,@AtributesString[1]],
1059 [Length(FileName),FileAccessSize,SizeOf(FileOpenFlags),Length(AtributesString)],
1060 [False,True,True,True]);
1061 SendPacket(PacketString);
1062 PacketType:=0;
1063 PacketData:=ReceivePacket(FRequestID-1,PacketType);
1064 CheckStatus(PacketType,PacketData,STRING_UNABLETOOPENFILE+': '+FileName);
1065 if (PacketType<>SSH_FXP_HANDLE) then DoError(STRING_UNABLETOOPENFILE+': '+FileName);
1066 //get file handle
1067 FieldOffset:=1;
1068 Result:=GetStringPacketField(PacketData,FieldOffset);
1069end;
1070
1071function TSimpleSFTP.OpenDir(DirName:string):string;
1072var PacketType:BYTE;PacketString,PacketData:string;FieldOffset:Integer;
1073begin
1074 PacketType:=SSH_FXP_OPENDIR;
1075 PacketString:=BuildPacket(PacketType,[@DirName[1]],[Length(DirName)],[False]);
1076 SendPacket(PacketString);
1077 PacketType:=0;
1078 PacketData:=ReceivePacket(FRequestID-1,PacketType);
1079 CheckStatus(PacketType,PacketData,STRING_UNABLETOOPENDIR+': '+DirName);
1080 if (PacketType<>SSH_FXP_HANDLE) then DoError(STRING_UNABLETOOPENDIR+': '+DirName);
1081 //get dir handle
1082 FieldOffset:=1;
1083 Result:=GetStringPacketField(PacketData,FieldOffset);
1084end;
1085
1086function TSimpleSFTP.CloseFile(FileHandle:string):Boolean;
1087var PacketType:BYTE;PacketString,PacketData:string;
1088begin
1089 PacketType:=SSH_FXP_CLOSE;
1090 PacketString:=BuildPacket(PacketType,[@FileHandle[1]],[Length(FileHandle)],[False]);
1091 SendPacket(PacketString);
1092 PacketType:=0;
1093 PacketData:=ReceivePacket(FRequestID-1,PacketType);
1094 CheckStatus(PacketType,PacketData,STRING_UNABLETOCLOSEHANDLE+': '+FileHandle);
1095 Result:=True;
1096end;
1097
1098function TSimpleSFTP.CloseDir(DirHandle:string):Boolean;
1099begin
1100 Result:=CloseFile(DirHandle);
1101end;
1102
1103function TSimpleSFTP.ReadFile(FileHandle:string;FileOffset:Int64;ReadSize:DWORD):string;
1104var PacketType:BYTE;PacketString,PacketData:string;FieldOffset:Integer;
1105begin
1106 Result:='';
1107 PacketType:=SSH_FXP_READ;
1108 FileOffset:=InvertInt64(FileOffset);
1109 ReadSize:=InvertDWORD(ReadSize);
1110 PacketString:=BuildPacket(PacketType,[@FileHandle[1],@FileOffset,@ReadSize],
1111 [Length(FileHandle),SizeOf(FileOffset),SizeOf(ReadSize)],[False,True,True]);
1112 SendPacket(PacketString);
1113 PacketType:=0;
1114 PacketData:=ReceivePacket(FRequestID-1,PacketType);
1115 case PacketType of
1116 SSH_FXP_STATUS:
1117 begin //server can say "EOF" or error
1118 if GetStatus(PacketData)=SSH_FX_EOF then Exit
1119 else CheckStatus(PacketType,PacketData,STRING_UNABLETOREADFILE+': '+FileHandle);
1120 end;
1121 SSH_FXP_DATA:
1122 begin
1123 FieldOffset:=1;
1124 Result:=GetStringPacketField(PacketData,FieldOffset);
1125 end;
1126 else DoError(STRING_UNABLETOREADFILE+': '+FileHandle);
1127 end;
1128end;
1129
1130procedure TSimpleSFTP.ReadDir(DirHandle:string;FileList:TSFTPFileList);
1131var PacketType:BYTE;PacketString,PacketData:string;
1132begin
1133 FileList.Clear;
1134 PacketType:=SSH_FXP_READDIR;
1135 PacketString:=BuildPacket(PacketType,[@DirHandle[1]],[Length(DirHandle)],[False]);
1136 while True do
1137 begin
1138 SendPacket(PacketString);
1139 PacketType:=0;
1140 PacketData:=ReceivePacket(FRequestID-1,PacketType);
1141 case PacketType of
1142 SSH_FXP_STATUS:
1143 begin //server can say "EOF" or error
1144 if GetStatus(PacketData)=SSH_FX_EOF then Break
1145 else CheckStatus(PacketType,PacketData,STRING_UNABLETOREADDIR+': '+DirHandle);
1146 end;
1147 SSH_FXP_NAME:
1148 begin //PacketData can contain 1 or more file info
1149 ParseFileNamePacket(FileList,PacketData);
1150 end;
1151 else DoError(STRING_UNABLETOREADDIR+': '+DirHandle+' ('+STRING_UNEXPECTEDPACKETTYPE+
1152 ' '+IntToStr(PacketType)+')');
1153 end;
1154 end;
1155end;
1156
1157function TSimpleSFTP.ParseFileNamePacket(FileList:TSFTPFileList;PacketData:string;
1158 ProcessAttributes:Boolean=True):Integer;
1159var NameCount,i:DWORD;FileAttributes:TSFTPFileAttributes;FileName,LongName:string;FieldOffset:Integer;
1160begin //returns count of file records added to FileList
1161 Result:=0;
1162 FieldOffset:=1;
1163 //get file record count
1164 GetFixedPacketField(PacketData,FieldOffset,@NameCount,SizeOf(NameCount));
1165 //get names and attributes
1166 for i:=1 to NameCount do
1167 begin
1168 FileName:=GetStringPacketField(PacketData,FieldOffset);
1169 if FProtocolVersion<=3 then LongName:=GetStringPacketField(PacketData,FieldOffset);
1170 if ProcessAttributes then FileAttributes:=ParseFileAttributes(PacketData,FieldOffset);
1171 FileAttributes.FileName:=FileName;
1172 if (FileAttributes.permissions and S_IFMT)<>0 then
1173 begin //we trying to check file type bits in permissions, but it seems to contain no file type bits
1174 if (FileAttributes.permissions and S_IFLNK)<>0 then FileAttributes.file_type:=SSH_FILEXFER_TYPE_SYMLINK
1175 else if (FileAttributes.permissions and S_IFREG)<>0 then FileAttributes.file_type:=SSH_FILEXFER_TYPE_REGULAR
1176 else if (FileAttributes.permissions and S_IFDIR)<>0 then FileAttributes.file_type:=SSH_FILEXFER_TYPE_DIRECTORY
1177 else FileAttributes.file_type:=SSH_FILEXFER_TYPE_UNKNOWN;
1178 end
1179 else
1180 begin
1181 if (FProtocolVersion<=3) and (LongName<>'') then
1182 begin //try to parse long file name (assumed it has the form of "ls -l" listing);
1183 FileAttributes.LongName:=LongName;
1184 case LongName[1] of //just simple file_type emulation :-) (it works with my server)
1185 '-': FileAttributes.file_type:=SSH_FILEXFER_TYPE_REGULAR;
1186 'd': FileAttributes.file_type:=SSH_FILEXFER_TYPE_DIRECTORY;
1187 'l': FileAttributes.file_type:=SSH_FILEXFER_TYPE_SYMLINK;
1188 '/': FileAttributes.file_type:=SSH_FILEXFER_TYPE_DIRECTORY;//in SetRealPath
1189 else FileAttributes.file_type:=SSH_FILEXFER_TYPE_UNKNOWN;
1190 end;
1191 end;
1192 end;
1193 FileList.Add(FileAttributes);
1194 Inc(Result);
1195 end;
1196end;
1197
1198procedure ResetFileAttributes(FileAttributes:PSFTPFileAttributes);
1199begin
1200 with FileAttributes^ do
1201 begin
1202 FileName:='';
1203 LongName:='';
1204 valid_attribute_flags:=0;
1205 file_type:=0;// always present (not in version 3)
1206 size:=0;// present only if flag SIZE
1207 allocation_size:=0;// present only if flag ALLOCATION_SIZE
1208 owner:='';// present only if flag OWNERGROUP
1209 group:='';// present only if flag OWNERGROUP
1210 permissions:=0;// present only if flag PERMISSIONS
1211 atime:=0;// present only if flag ACCESSTIME
1212 atime_nseconds:=0;// present only if flag SUBSECOND_TIMES
1213 createtime:=0;// present only if flag CREATETIME
1214 createtime_nseconds:=0;// present only if flag SUBSECOND_TIMES
1215 mtime:=0;// present only if flag MODIFYTIME
1216 mtime_nseconds:=0;// present only if flag SUBSECOND_TIMES
1217 acl:='';// present only if flag ACL
1218 attrib_bits:=0;// present only if flag BITS
1219 text_hint:=0;// present only if flag TEXT_HINT
1220 mime_type:='';// present only if flag MIME_TYPE
1221 link_count:=0;// present only if flag LINK_COUNT
1222 untranslated_name:='';// present only if flag UNTRANSLATED_NAME
1223 extended_count:=0;// present only if flag EXTENDED
1224// extended_type:string;
1225// extended_data:string;
1226 end;
1227end;
1228
1229function TSimpleSFTP.ParseFileAttributes(AtributesString:string;var FieldOffset:Integer):TSFTPFileAttributes;
1230var TmpInt64:Int64;TmpDWORD:DWORD;TmpString:string;i:Integer;
1231 procedure CopyFixedAttribute(CopyFlag:DWORD;CopyTo:Pointer;CopySize:Integer);
1232 begin
1233 if (Result.valid_attribute_flags and CopyFlag)<>0 then
1234 GetFixedPacketField(AtributesString,FieldOffset,CopyTo,CopySize);
1235 end;
1236 procedure CopyStringAttribute(CopyFlag:DWORD;var CopyTo:string);
1237 begin
1238 if (Result.valid_attribute_flags and CopyFlag)<>0 then
1239 CopyTo:=GetStringPacketField(AtributesString,FieldOffset);
1240 end;
1241begin //version 3 parsing - like in PuTTY
1242 ResetFileAttributes(@Result);
1243 with Result do
1244 begin
1245 GetFixedPacketField(AtributesString,FieldOffset,@valid_attribute_flags,SizeOf(valid_attribute_flags));
1246 if FProtocolVersion>3 then
1247 GetFixedPacketField(AtributesString,FieldOffset,@file_type,SizeOf(file_type));
1248 CopyFixedAttribute(SSH_FILEXFER_ATTR_SIZE,@size,SizeOf(size));
1249 if FProtocolVersion<=3 then
1250 CopyFixedAttribute(2,@TmpInt64,SizeOf(TmpInt64));
1251 if FProtocolVersion>3 then
1252 begin
1253 CopyFixedAttribute(SSH_FILEXFER_ATTR_ALLOCATION_SIZE,@allocation_size,SizeOf(allocation_size));
1254 CopyStringAttribute(SSH_FILEXFER_ATTR_OWNERGROUP,owner);
1255 CopyStringAttribute(SSH_FILEXFER_ATTR_OWNERGROUP,group);
1256 end;
1257 CopyFixedAttribute(SSH_FILEXFER_ATTR_PERMISSIONS,@permissions,SizeOf(permissions));
1258 if FProtocolVersion>3 then
1259 begin
1260 CopyFixedAttribute(SSH_FILEXFER_ATTR_ACCESSTIME,@atime,SizeOf(atime));
1261 CopyFixedAttribute(SSH_FILEXFER_ATTR_ACCESSTIME or SSH_FILEXFER_ATTR_SUBSECOND_TIMES,@atime_nseconds,SizeOf(atime_nseconds));
1262 CopyFixedAttribute(SSH_FILEXFER_ATTR_CREATETIME,@createtime,SizeOf(createtime));
1263 CopyFixedAttribute(SSH_FILEXFER_ATTR_CREATETIME or SSH_FILEXFER_ATTR_SUBSECOND_TIMES,@createtime_nseconds,SizeOf(createtime_nseconds));
1264 CopyFixedAttribute(SSH_FILEXFER_ATTR_MODIFYTIME,@mtime,SizeOf(mtime));
1265 CopyFixedAttribute(SSH_FILEXFER_ATTR_MODIFYTIME or SSH_FILEXFER_ATTR_SUBSECOND_TIMES,@mtime_nseconds,SizeOf(mtime_nseconds));
1266 end
1267 else
1268 begin
1269 TmpDWORD:=0;
1270 CopyFixedAttribute(SSH_FILEXFER_ATTR_ACCESSTIME,@TmpDWORD,SizeOf(TmpDWORD));
1271 atime:=TmpDWORD;
1272 TmpDWORD:=0;
1273 CopyFixedAttribute(SSH_FILEXFER_ATTR_ACCESSTIME,@TmpDWORD,SizeOf(TmpDWORD));
1274 mtime:=TmpDWORD;
1275 end;
1276 if FProtocolVersion>3 then
1277 begin
1278 CopyStringAttribute(SSH_FILEXFER_ATTR_ACL,acl);
1279 if FProtocolVersion>4 then
1280 CopyFixedAttribute(SSH_FILEXFER_ATTR_BITS,@attrib_bits,SizeOf(attrib_bits));
1281 CopyFixedAttribute(SSH_FILEXFER_ATTR_TEXT_HINT,@text_hint,SizeOf(text_hint));
1282 CopyStringAttribute(SSH_FILEXFER_ATTR_MIME_TYPE,mime_type);
1283 CopyFixedAttribute(SSH_FILEXFER_ATTR_LINK_COUNT,@link_count,SizeOf(link_count));
1284 CopyStringAttribute(SSH_FILEXFER_ATTR_UNTRANLATED_NAME,untranslated_name);
1285 end;
1286 extended_count:=0;
1287 CopyFixedAttribute(SSH_FILEXFER_ATTR_EXTENDED,@extended_count,SizeOf(extended_count));
1288 for i:=1 to extended_count do
1289 begin //parsed but not used
1290 GetStringPacketField(AtributesString,FieldOffset);//extended_type
1291 GetStringPacketField(AtributesString,FieldOffset);//extended_data
1292 end;
1293 end;
1294end;
1295
1296function TSimpleSFTP.BuildBlankAttributesString(IsDir:Boolean=False):string;
1297var FileAttributes:TSFTPFileAttributes;
1298begin
1299 ResetFileAttributes(@FileAttributes);
1300 if IsDir then FileAttributes.file_type:=SSH_FILEXFER_TYPE_DIRECTORY
1301 else FileAttributes.file_type:=SSH_FILEXFER_TYPE_REGULAR;
1302 Result:=BuildAttributesString(@FileAttributes);
1303end;
1304
1305function TSimpleSFTP.BuildAttributesString(FileAttributes:PSFTPFileAttributes):string;
1306var TmpInt64:Int64;TmpDWORD:DWORD;
1307 procedure AddFixedAttributeString(CopyFlag:DWORD;CurAttribute:Pointer;CurSize:Integer);
1308 begin
1309 if (FileAttributes^.valid_attribute_flags and CopyFlag)<>0 then
1310 Result:=Result+PutFixedPacketField(CurAttribute,CurSize);
1311 end;
1312 procedure AddStringAttributeString(CopyFlag:DWORD;CurAttribute:string);
1313 begin
1314 if (FileAttributes^.valid_attribute_flags and CopyFlag)<>0 then
1315 Result:=Result+PutStringPacketField(CurAttribute);
1316 end;
1317begin //version 3 - like in PuTTY
1318 Result:='';
1319 with FileAttributes^ do
1320 begin
1321 Result:=Result+PutFixedPacketField(@valid_attribute_flags,SizeOf(valid_attribute_flags));
1322 if FProtocolVersion>3 then
1323 Result:=Result+PutFixedPacketField(@file_type,SizeOf(file_type));
1324 AddFixedAttributeString(SSH_FILEXFER_ATTR_SIZE,@size,SizeOf(size));
1325 if FProtocolVersion<=3 then
1326 AddFixedAttributeString(2,@TmpInt64,SizeOf(TmpInt64));
1327 if FProtocolVersion>3 then
1328 begin
1329 AddFixedAttributeString(SSH_FILEXFER_ATTR_ALLOCATION_SIZE,@allocation_size,SizeOf(allocation_size));
1330 AddStringAttributeString(SSH_FILEXFER_ATTR_OWNERGROUP,owner);
1331 AddStringAttributeString(SSH_FILEXFER_ATTR_OWNERGROUP,group);
1332 end;
1333 AddFixedAttributeString(SSH_FILEXFER_ATTR_PERMISSIONS,@permissions,SizeOf(permissions));
1334 if FProtocolVersion>3 then
1335 begin
1336 AddFixedAttributeString(SSH_FILEXFER_ATTR_ACCESSTIME,@atime,SizeOf(atime));
1337 AddFixedAttributeString(SSH_FILEXFER_ATTR_ACCESSTIME or SSH_FILEXFER_ATTR_SUBSECOND_TIMES,@atime_nseconds,SizeOf(atime_nseconds));
1338 AddFixedAttributeString(SSH_FILEXFER_ATTR_CREATETIME,@createtime,SizeOf(createtime));
1339 AddFixedAttributeString(SSH_FILEXFER_ATTR_CREATETIME or SSH_FILEXFER_ATTR_SUBSECOND_TIMES,@createtime_nseconds,SizeOf(createtime_nseconds));
1340 AddFixedAttributeString(SSH_FILEXFER_ATTR_MODIFYTIME,@mtime,SizeOf(mtime));
1341 AddFixedAttributeString(SSH_FILEXFER_ATTR_MODIFYTIME or SSH_FILEXFER_ATTR_SUBSECOND_TIMES,@mtime_nseconds,SizeOf(mtime_nseconds));
1342 end
1343 else
1344 begin
1345 TmpDWORD:=atime;
1346 AddFixedAttributeString(SSH_FILEXFER_ATTR_ACCESSTIME,@TmpDWORD,SizeOf(TmpDWORD));
1347 TmpDWORD:=mtime;
1348 AddFixedAttributeString(SSH_FILEXFER_ATTR_ACCESSTIME,@TmpDWORD,SizeOf(TmpDWORD));
1349 end;
1350 if FProtocolVersion>3 then
1351 begin
1352 AddStringAttributeString(SSH_FILEXFER_ATTR_ACL,acl);
1353 AddFixedAttributeString(SSH_FILEXFER_ATTR_BITS,@attrib_bits,SizeOf(attrib_bits));
1354 AddFixedAttributeString(SSH_FILEXFER_ATTR_TEXT_HINT,@text_hint,SizeOf(text_hint));
1355 AddStringAttributeString(SSH_FILEXFER_ATTR_MIME_TYPE,mime_type);
1356 AddFixedAttributeString(SSH_FILEXFER_ATTR_LINK_COUNT,@link_count,SizeOf(link_count));
1357 AddStringAttributeString(SSH_FILEXFER_ATTR_UNTRANLATED_NAME,untranslated_name);
1358 end;
1359 extended_count:=0;
1360 AddFixedAttributeString(SSH_FILEXFER_ATTR_EXTENDED,@extended_count,SizeOf(extended_count));
1361 end;
1362end;
1363
1364procedure TSimpleSFTP.WriteFile(FileHandle:string;FileOffset:Int64;FileData:Pointer;DataSize:DWORD);
1365var PacketType:BYTE;PacketString,PacketData:string;InvertedDataSize:DWORD;
1366begin
1367 PacketType:=SSH_FXP_WRITE;
1368 FileOffset:=InvertInt64(FileOffset);
1369 InvertedDataSize:=InvertDWORD(DataSize);
1370 PacketString:=BuildPacket(PacketType,[@FileHandle[1],@FileOffset,@InvertedDataSize,FileData],
1371 [Length(FileHandle),SizeOf(FileOffset),SizeOf(DataSize),DataSize],[False,True,True,True]);
1372 SendPacket(PacketString);
1373 PacketType:=SSH_FXP_STATUS;
1374 PacketData:=ReceivePacket(FRequestID-1,PacketType);
1375 CheckStatus(PacketType,PacketData,STRING_UNABLETOWRITETOFILE+': '+FileHandle);
1376end;
1377
1378procedure TSimpleSFTP.DeleteFile(FileName:string);
1379var PacketType:BYTE;PacketString,PacketData:string;
1380begin
1381 PacketType:=SSH_FXP_REMOVE;
1382 PacketString:=BuildPacket(PacketType,[@FileName[1]],[Length(FileName)],[False]);
1383 SendPacket(PacketString);
1384 PacketType:=SSH_FXP_STATUS;
1385 PacketData:=ReceivePacket(FRequestID-1,PacketType);
1386 CheckStatus(PacketType,PacketData,STRING_UNABLETODELETEFILE+': '+FileName);
1387end;
1388
1389procedure TSimpleSFTP.RenameFile(OldName,NewName:string;FailIfExists:Boolean);
1390var PacketType:BYTE;PacketString,PacketData:string;RenameFlags:DWORD;
1391begin
1392 PacketType:=SSH_FXP_RENAME;
1393 RenameFlags:=SSH_FXP_RENAME_NATIVE;
1394 if not FailIfExists then RenameFlags:=RenameFlags+SSH_FXP_RENAME_OVERWRITE;
1395 RenameFlags:=InvertDWORD(RenameFlags);
1396 PacketString:=BuildPacket(PacketType,[@OldName[1],@NewName[1],@RenameFlags],
1397 [Length(OldName),Length(NewName),SizeOf(RenameFlags)],[False,False,True]);
1398 SendPacket(PacketString);
1399 PacketType:=SSH_FXP_STATUS;
1400 PacketData:=ReceivePacket(FRequestID-1,PacketType);
1401 CheckStatus(PacketType,PacketData,STRING_UNABLETORENAMEFILE+': '+OldName+
1402 ' -> '+NewName);
1403end;
1404
1405procedure TSimpleSFTP.CreateDir(DirName:string;Attributes:PSFTPFileAttributes=nil);
1406var PacketType:BYTE;PacketString,AttributesString,PacketData:string;
1407begin
1408 PacketType:=SSH_FXP_MKDIR;
1409 if Assigned(Attributes) then AttributesString:=BuildAttributesString(Attributes)
1410 else AttributesString:=BuildBlankAttributesString(True);
1411 PacketString:=BuildPacket(PacketType,[@DirName[1],@AttributesString[1]],
1412 [Length(DirName),Length(AttributesString)],[False,True]);
1413 SendPacket(PacketString);
1414 PacketType:=SSH_FXP_STATUS;
1415 PacketData:=ReceivePacket(FRequestID-1,PacketType);
1416 CheckStatus(PacketType,PacketData,STRING_UNABLETOCREATEDIR+': '+DirName);
1417end;
1418
1419procedure TSimpleSFTP.DeleteDir(DirName:string);
1420var PacketType:BYTE;PacketString,PacketData:string;
1421begin
1422 PacketType:=SSH_FXP_RMDIR;
1423 PacketString:=BuildPacket(PacketType,[@DirName[1]],[Length(DirName)],[False]);
1424 SendPacket(PacketString);
1425 PacketType:=SSH_FXP_STATUS;
1426 PacketData:=ReceivePacket(FRequestID-1,PacketType);
1427 CheckStatus(PacketType,PacketData,STRING_UNABLETODELETEDIR+': '+DirName);
1428end;
1429
1430procedure TSimpleSFTP.ListDir(DirName:string;FileList:TSFTPFileList);
1431var DirHandle:string;
1432begin
1433 DirHandle:=OpenDir(DirName);
1434 try
1435 ReadDir(DirHandle,FileList);
1436 finally
1437 try
1438 CloseDir(DirHandle);
1439 except
1440 end;
1441 end;
1442end;
1443
1444procedure TSimpleSFTP.InternalGetFileAtributes(PacketType:BYTE;FileID:string;//name or handle
1445 AttributeFlags:DWORD;var Attributes:TSFTPFileAttributes);
1446var PacketString,AttributesString,PacketData:string;FieldOffset,AttributeFlagsSize:Integer;
1447begin
1448 if FProtocolVersion>3 then AttributeFlagsSize:=SizeOf(AttributeFlags) else AttributeFlagsSize:=0;
1449 AttributeFlags:=InvertDWORD(AttributeFlags);
1450 PacketString:=BuildPacket(PacketType,[@FileID[1],@AttributeFlags],
1451 [Length(FileID),AttributeFlagsSize],[False,True]);
1452 SendPacket(PacketString);
1453 PacketType:=0;
1454 PacketData:=ReceivePacket(FRequestID-1,PacketType);
1455 CheckStatus(PacketType,PacketData,STRING_UNABLETOGETFILEATTRIBUTES+': '+FileID);
1456 if PacketType<>SSH_FXP_ATTRS then DoError(STRING_UNABLETOGETFILEATTRIBUTES+': '+FileID);
1457 FieldOffset:=1;
1458 Attributes:=ParseFileAttributes(PacketData,FieldOffset);
1459end;
1460
1461procedure TSimpleSFTP.GetFileAtributes(FileName:string;var Attributes:TSFTPFileAttributes;FollowLink:Boolean=True);
1462var PacketType:BYTE;AttributeFlags:DWORD;
1463begin
1464 if FollowLink then PacketType:=SSH_FXP_STAT else PacketType:=SSH_FXP_LSTAT;
1465 AttributeFlags:=SSH_FILEXFER_ATTR_SIZE or SSH_FILEXFER_ATTR_PERMISSIONS
1466 or SSH_FILEXFER_ATTR_ACCESSTIME;
1467 InternalGetFileAtributes(PacketType,FileName,AttributeFlags,Attributes);
1468end;
1469
1470procedure TSimpleSFTP.GetFileAtributesByHandle(FileHandle:string;var Attributes:TSFTPFileAttributes);
1471var AttributeFlags:DWORD;
1472begin
1473 AttributeFlags:=SSH_FILEXFER_ATTR_SIZE or SSH_FILEXFER_ATTR_PERMISSIONS
1474 or SSH_FILEXFER_ATTR_ACCESSTIME;
1475 InternalGetFileAtributes(SSH_FXP_FSTAT,FileHandle,AttributeFlags,Attributes);
1476end;
1477
1478procedure TSimpleSFTP.SetFileAtributes(FileName:string;Attributes:PSFTPFileAttributes);
1479var PacketType:BYTE;PacketString,AttributesString,PacketData:string;
1480begin
1481 PacketType:=SSH_FXP_SETSTAT;
1482 AttributesString:=BuildAttributesString(Attributes);
1483 PacketString:=BuildPacket(PacketType,[@FileName[1],@AttributesString[1]],
1484 [Length(FileName),Length(AttributesString)],[False,True]);
1485 SendPacket(PacketString);
1486 PacketType:=SSH_FXP_STATUS ;
1487 PacketData:=ReceivePacket(FRequestID-1,PacketType);
1488 CheckStatus(PacketType,PacketData,STRING_UNABLETOSETFILEATTRIBUTES+': '+FileName);
1489end;
1490
1491procedure TSimpleSFTP.SetFileAtributesByHandle(FileHandle:string;Attributes:PSFTPFileAttributes);
1492var PacketType:BYTE;PacketString,AttributesString,PacketData:string;
1493begin
1494 PacketType:=SSH_FXP_FSETSTAT;
1495 AttributesString:=BuildAttributesString(Attributes);
1496 PacketString:=BuildPacket(PacketType,[@FileHandle[1],@AttributesString[1]],
1497 [Length(FileHandle),Length(AttributesString)],[False,True]);
1498 SendPacket(PacketString);
1499 PacketType:=SSH_FXP_STATUS ;
1500 PacketData:=ReceivePacket(FRequestID-1,PacketType);
1501 CheckStatus(PacketType,PacketData,STRING_UNABLETOSETFILEATTRIBUTES+': '+FileHandle);
1502end;
1503
1504procedure TSimpleSFTP.SetFileTimes(FileName:string;AccessTime,CreateTime,ModifyTime:Int64);
1505var PacketType:BYTE;PacketString,AttributesString,PacketData:string;Attributes:TSFTPFileAttributes;
1506begin
1507 ResetFileAttributes(@Attributes);
1508 Attributes.valid_attribute_flags:=SSH_FILEXFER_ATTR_ACCESSTIME;
1509 if FProtocolVersion>3 then
1510 Attributes.valid_attribute_flags:=Attributes.valid_attribute_flags or
1511 SSH_FILEXFER_ATTR_CREATETIME or SSH_FILEXFER_ATTR_MODIFYTIME;
1512 Attributes.atime:=AccessTime;
1513 Attributes.createtime:=CreateTime;
1514 Attributes.mtime:=ModifyTime;
1515 SetFileAtributes(FileName,@Attributes);
1516end;
1517
1518procedure TSimpleSFTP.SetFileTimesByHandle(FileHandle:string;AccessTime,CreateTime,ModifyTime:Int64);
1519var PacketType:BYTE;PacketString,AttributesString,PacketData:string;Attributes:TSFTPFileAttributes;
1520begin
1521 ResetFileAttributes(@Attributes);
1522 Attributes.valid_attribute_flags:=SSH_FILEXFER_ATTR_ACCESSTIME;
1523 if FProtocolVersion>3 then
1524 Attributes.valid_attribute_flags:=Attributes.valid_attribute_flags or
1525 SSH_FILEXFER_ATTR_CREATETIME or SSH_FILEXFER_ATTR_MODIFYTIME;
1526 Attributes.atime:=AccessTime;
1527 Attributes.createtime:=CreateTime;
1528 Attributes.mtime:=ModifyTime;
1529 SetFileAtributesByHandle(FileHandle,@Attributes);
1530end;
1531
1532function TSimpleSFTP.GetStatus(PacketData:string):DWORD;
1533begin //assumed PacketType=SSH_FXP_STATUS
1534 Result:=GetDWORD(@PacketData[1]);
1535end;
1536
1537function TSimpleSFTP.CheckStatus(PacketType:DWORD;PacketData:string;ErrorString:string):Boolean;
1538var Status:DWORD;i,FieldOffset:Integer;
1539begin
1540 Result:=False;
1541 if PacketType<>SSH_FXP_STATUS then Exit;
1542 FieldOffset:=1;
1543 GetFixedPacketField(PacketData,FieldOffset,@Status,SizeOf(Status));
1544 if Status<>SSH_FX_OK then
1545 begin //expected strings with error description ?
1546 while FieldOffset<Length(PacketData) do
1547 ErrorString:=ErrorString+#13#10+GetStringPacketField(PacketData,FieldOffset);
1548 DoError(ErrorString);
1549 end
1550 else Result:=True;
1551end;
1552
1553end.
Note: See TracBrowser for help on using the repository browser.