Просмотров: 1346 | Дата: 19.04.2024 | Коментарии (0)

FTP клиент




Продолжение темы начатой на форуме: http://purebasic.info/phpBB2/viewtopic.php?t=681

Простой вариант FTP клиента

Возможности:
Перетягиваниемышкой файлов с компьютера на окно списка ftp...
Перетягивание файлов из списка в список и обратно...
Перетягивание папки с компьютера на ftp (создаётся пустая папка)...
Скачать\отправит - двойной клик по файлу в списке...
Добавление иконок в список в зависимости от ассоциации файлов...
Прогресс бар загрузки в одну, другую сторону...
Удалять файлы и папки...
Создавать папки...
Сортировка папок и файлов по алфавиту...
Отображение даты последнего изменения...
Растягивание окна...

Скачать исходник  


Вариант кода для PB_4.50:



InitNetwork() 
 Enumeration 
 #Window_0 ; окно 
 #FtpFile ; список на список
 #Explor ; список на копр
 #Ftp ; ftp
 #connect ; подключиться
 #url_ftp ; адресс ftp
 #log_ftp ; логин
 #pas_ftp ; пароль
 #progres ; прогресс
 #text ; прогресс
 #folder ; папка
 #up
 EndEnumeration
 
Global connect, send, download, file.s

 Structure FTP 
 name.s ; получили имя файла
 saze.s ; получили вес файла
 GadgetID.l ; идентиф.
 tame.l ; время изменения 
 EndStructure 
Global NewList Fail.FTP() ; список файлов

 Structure PAP
 name.s ; получили имя файла
 GadgetID.l ; идентиф. 
 tame.l ; время изменения 
 EndStructure 
Global NewList Papka.PAP() ; список папок 

;{=======================асоциация файлов=================================== 
Structure Info 
 Part.s ; Расширение файла 
 IconID.l ; Идентификатор иконки, связанной с расширением 
EndStructure 

Global NewList Part_IconID.Info() 
AddElement(Part_IconID() )

Procedure.s GetSysDirectory() ; Путь к системной папке
 Path.s=Space(500)
 GetSystemDirectory_(@Path,500)
 ProcedureReturn Path
EndProcedure
 
Part_IconID()\Part="dir" ; Это иконка папки 
Part_IconID()\IconID=ExtractIcon_(0,GetSysDirectory()+"\SHELL32.dll",3) 

Procedure GetExtension_Icon(Extension.s, size.l) 
 Protected Info.SHFILEINFO, StandardIcon.l, flags.l 
 StandardIcon = 0 
 If Size = 0 
 flags = #SHGFI_USEFILEATTRIBUTES | #SHGFI_ICON | #SHGFI_SMALLICON 
 Else 
 flags = #SHGFI_USEFILEATTRIBUTES | #SHGFI_ICON | #SHGFI_LARGEICON 
 EndIf 
 If SHGetFileInfo_("." + extension, #FILE_ATTRIBUTE_NORMAL, @Info.SHFILEINFO, SizeOf(SHFILEINFO), flags) 
 StandardIcon = Info\hIcon 
 Else 
 If Size = 0 
 ExtractIconEx_("shell32.dll", 0, 0, @StandardIcon, 1) 
 Else 
 ExtractIconEx_("shell32.dll", 0, @StandardIcon, 0, 1) 
 EndIf 
 EndIf 
 ProcedureReturn StandardIcon 
EndProcedure 

Procedure GetIcon(Part.s) 
 Shared Part_IconID() 
 Part=LCase(Part) 
 ForEach Part_IconID() 
 If Part=Part_IconID()\Part ; Данные о расширенни найдены 
 ProcedureReturn Part_IconID()\IconID 
 EndIf 
 Next 
 ; Данных о расширении нет, поэтому загружаем иконку 
 IconID=GetExtension_Icon(Part, 0) 
 AddElement(Part_IconID() ) 
 Part_IconID()\Part=Part 
 Part_IconID()\IconID=IconID 
ProcedureReturn IconID 
EndProcedure 
;}======================================================================= 
 
 
 Procedure FTP_Direct() ; сканируем директорию
 ClearGadgetItems(#FtpFile)
 ClearList(Fail())
 ClearList(Papka())
 
 ret=CatchImage(#folder,?folder) ; получаем ID иконки папка

 If ExamineFTPDirectory(#Ftp) ; сканируем ftp
 While NextFTPDirectoryEntry(#Ftp)
 If FTPDirectoryEntryType(#Ftp)=1 ; определяем файл/папка
 Exten.s =GetExtensionPart(FTPDirectoryEntryName(#Ftp)) ; извлекаем расширение
 AddElement(Fail())
 Fail()\name.s=FTPDirectoryEntryName(#Ftp) ; имя
 Fail()\saze.s=Str(FTPDirectoryEntrySize(#Ftp)) ; вес
 Fail()\GadgetID.l=GetIcon(Exten.s) ; получаем иконку и ID иконки расширения
 Fail()\tame.l=FTPDirectoryEntryDate(#Ftp) ; получаем время
 Else
 AddElement(Papka())
 Papka()\name.s=FTPDirectoryEntryName(#Ftp)
 Papka()\GadgetID.l=ret ; получаем ID иконки папки
 Papka()\tame.l=FTPDirectoryEntryDate(#Ftp) ; получаем время
 EndIf
 Wend
 EndIf

SortStructuredList(Papka(), 0, OffsetOf(PAP\name.s), #PB_Sort_String) ; сортируем папки по имени
SortStructuredList(Fail(), 0, OffsetOf(FTP\name.s), #PB_Sort_String) ; сортируем файлы по имени
AddGadgetItem(#FtpFile, -1, "на верх"+Chr(10)+"",CatchImage(#up,?up)) ; создаем первый элем.списка 
ForEach Papka()
 AddGadgetItem(#FtpFile, -1, Papka()\name.s+Chr(10)+"Папка"+Chr(10)+ FormatDate("%dd . %mm . %yyyy",Papka()\tame.l),Papka()\GadgetID.l) ; создаем список папок
Next
ForEach Fail()
 AddGadgetItem(#FtpFile, -1, Fail( )\name.s+Chr(10)+Fail()\saze.s+Chr(10)+ FormatDate("%dd . %mm . %yyyy",Fail()\tame.l),Fail()\GadgetID.l) ; создаем список файлов
Next 
 EndProcedure

Procedure Progress() ; прогресс бар
 If download=1 Or send=1 
 progres = FTPProgress(#Ftp)
 SetGadgetState(#progres, progres)
 Value = GetGadgetState(#progres)*100/GetGadgetAttribute(#progres, #PB_ProgressBar_Maximum)
 SetGadgetText(#text, Str(Value)+" % "+GetFilePart(file)) 
 EndIf
 If progres = -3 And download=1 ; закачка завершилась
 download=0
 SetGadgetText(#text, "закачка завершилась")
 ExplorerTreeGadget(#Explor, 5, 30, 330, 280, GetGadgetText(#Explor)+"\") ; обновляем после закачки на комп
 ResizeGadget(#Explor,#PB_Ignore,#PB_Ignore, #PB_Ignore,WindowHeight(#Window_0)-60)
 EnableGadgetDrop(#Explor, #PB_Drop_Text, #PB_Drag_Copy) ; обновляем 
 ElseIf progres = -3 And send=1 ; закачка завершилась
 If send=1
 FTP_Direct() ; обновляем после закачки на ftp
 SetGadgetText(#text, "обновили список")
 send=0
 EndIf
 ElseIf progres = -2
 SetGadgetText(#text, "неудача")
 send=0
 download=0
 EndIf
EndProcedure

Procedure send_0(file.s) 
 If GetExtensionPart(file.s)<> "" ; если файл
 If FileSize(file.s)<5000000 ; меньше 5Мб
 send=1
 SetGadgetAttribute(#progres, #PB_ProgressBar_Maximum, FileSize(file.s)) ; изменяем параметр прогрес сбар в зависимости от веса
 SendFTPFile(#Ftp, file.s, GetFilePart(file) ,#True)
 Else
 MessageRequester("Внимание !", "Файл больше 5 МБ"+Chr(10)+"Читай правила на narod.ru!", #MB_OK|#MB_ICONINFORMATION) 
 EndIf
 Else ; если папка
 CreateFTPDirectory(#Ftp, GetFilePart(file.s))
 FTP_Direct() ; обновить
 EndIf
EndProcedure

Procedure send(file.s) ; на ftp
a=0
ForEach Fail()
 proverka.s= Fail()\name.s
 If GetFilePart(file)=proverka.s
 a=1 
 EndIf
Next
 If a=1
 Select MessageRequester("Файл существует !", "Перезаписать файл !", #MB_YESNO|#MB_ICONWARNING)
 Case #IDYES
 send_0(file.s)
 EndSelect
 ElseIf a=0
 send_0(file.s)
 EndIf
EndProcedure

Procedure download() ; на комп
 If connect=1
 download=1
 saz.s= GetGadgetItemText(#FtpFile, GetGadgetState(#FtpFile), 1 ) ; вес файла
 SetGadgetAttribute(#progres, #PB_ProgressBar_Maximum, Val(saz.s)) ; изменяем параметр прогресс бар в зависимости от веса 
 file.s=GetGadgetItemText(#FtpFile, GetGadgetState(#FtpFile) ) ; имя выбранного файла
 CreateDirectory("temp") ; создать папку 
 ReceiveFTPFile(#Ftp, file.s, "temp/"+file.s, #True) ; скачать в папку темп (#True в потоке)
 EndIf 
EndProcedure

 url_ftp.s= "URL"
 log_ftp.s= "логин"
 pas_ftp.s= "пароль" 
;-----------настройки-------------------------
If OpenPreferences("inform.ini")
 PreferenceGroup("настройки")
 dir.s=ReadPreferenceString("каталог", "c") ; путь к последней открытой категории (по умлчанию с)
 url_ftp.s=ReadPreferenceString("url_ftp", "URL")
 log_ftp.s=ReadPreferenceString("log_ftp", "логин")
 pas_ftp.s=ReadPreferenceString("pas_ftp", "пароль")
ClosePreferences() 
EndIf
 
If OpenWindow(#Window_0,0,0,700,340,"FTP клиент",#WS_OVERLAPPEDWINDOW|#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
 ;SetWindowColor(#Window_0,RGB(128, 128, 128))
 StringGadget(#url_ftp,5,5,80,17,url_ftp) ; url
 StringGadget(#log_ftp,90,5,80,17,log_ftp) ; логин
 StringGadget(#pas_ftp,175,5,80,17,pas_ftp,#PB_String_Password) ; пароль 
 ButtonGadget(#connect,265,4,70,20,"Соеденить") 
 
 ProgressBarGadget(#progres, 5, 317, 330, 15, 0,100 , #PB_ProgressBar_Smooth) 
 TextGadget(#text,365,317,330,15,"прогресс")
 
 ExplorerTreeGadget(#Explor, 5, 30, 330, 280,dir.s)
 
 ListIconGadget(#FtpFile, 345, 5, 350, 305, "Файл на FTP", 150)
 AddGadgetColumn(#FtpFile,1,"Размер",80)
 AddGadgetColumn(#FtpFile,2,"Последнее изменение",100)
 
 SetTimer_(WindowID(#Window_0),Event,35,@Progress()) ; вывод прогресс бар по таймеру
 EnableGadgetDrop(#FtpFile, #PB_Drop_Files, #PB_Drag_Link) ; DragDrop с рабочего стола
 EnableGadgetDrop(#FtpFile, #PB_Drop_Text, #PB_Drag_Copy) ; DragDrop из списка компа на ftp
 EnableGadgetDrop(#Explor, #PB_Drop_Text, #PB_Drag_Copy) ; DragDrop из списка ftp на комп
 
 Repeat
 Event =WaitWindowEvent() 
 Window =EventWindow() 
 Gadget =EventGadget()
;-----------------------перетягивание файла--------------------------------
If connect=1
 If Event = #PB_Event_Gadget And EventType() = #PB_EventType_DragStart
 Select EventGadget()
 Case #Explor
 prover= DragText(GetGadgetText(#Explor))
 Case #FtpFile 
 prover= DragText(GetGadgetText(#FtpFile)) 
 EndSelect
 ElseIf Event = #PB_Event_GadgetDrop
 Select EventGadget()
 Case #FtpFile
 If prover=1
 send(EventDropText())
 prover=0
 ElseIf prover=0
 send(EventDropFiles()) 
 EndIf
 Case #Explor
 If prover=1
 download() ; обновляем 
 prover=0 
 EndIf 
 EndSelect
 EndIf
EndIf
;--------------------------------------------------------------------------
 If Event=#PB_Event_SizeWindow ; Изменяем размер редактора при изменении размеров окна
 ResizeGadget(#progres,#PB_Ignore,WindowHeight(#Window_0)-23, #PB_Ignore,#PB_Ignore) 
 ResizeGadget(#text, #PB_Ignore,WindowHeight(#Window_0)-23, #PB_Ignore,#PB_Ignore) 
 ResizeGadget(#FtpFile,#PB_Ignore,#PB_Ignore, WindowWidth(#Window_0)-350,WindowHeight(#Window_0)-35) 
 ResizeGadget(#Explor,#PB_Ignore,#PB_Ignore, #PB_Ignore,WindowHeight(#Window_0)-60)
 EndIf



 Select Event 
 Case #PB_Event_Gadget
 Select EventGadget()
 ;------------------------------------------------------
 Case #connect ; подключиться
 If OpenFTP(#Ftp, GetGadgetText(#url_ftp), GetGadgetText(#log_ftp), GetGadgetText(#pas_ftp)) ; подключаемся
 FTP_Direct()
 Else
 MessageRequester("Внимание !", "Нет подключения", #MB_OK|#MB_ICONINFORMATION)
 EndIf
 connect=1 
 ;----------------Удалить файл----------------------- 
 Case #FtpFile
 If connect=1
 If EventType()= #PB_EventType_RightClick ; выбрать файл правый клик
 name.s=GetGadgetItemText(#FtpFile, GetGadgetState(#FtpFile) ) ; имя выбранного файла
 Debug name.s
 If name.s <>"Файл на FTP"
 Select MessageRequester("Внимание !", "Удалить файл "+name, #MB_YESNO|#MB_ICONINFORMATION)
 Case #IDYES
 DeleteFTPDirectory(#Ftp, name)
 DeleteFTPFile(#Ftp,name)
 FTP_Direct() ; обновить 
 EndSelect
 ElseIf name.s ="Файл на FTP"
 numi.s =InputRequester("Создать новую папку","Русские буквы не использовать","") 
 If numi <> ""
 CreateFTPDirectory(#Ftp, numi)
 FTP_Direct() ; обновить 
 EndIf
 EndIf
 EndIf
 EndIf 
 ;----------------подпапка в низ------------------------- 
 If EventType()= #PB_EventType_LeftDoubleClick
 If GetExtensionPart(GetGadgetItemText(#FtpFile, GetGadgetState(#FtpFile))) = "" ; ecли папка 
 If SetFTPDirectory(#Ftp,GetGadgetText(#FtpFile)) ; изменяем директорию
 FTP_Direct()
 EndIf
 Else
 download() ; на комп при двойном клике
 EndIf
 ;----------------подпапка в верх------------------------- 
 If GetGadgetItemText(#FtpFile, GetGadgetState(#FtpFile))= "на верх"
 If SetFTPDirectory(#Ftp,GetPathPart(GetFTPDirectory(#Ftp)))
 FTP_Direct()
 EndIf 
 EndIf
 EndIf
 ;----------отправить на ftp файл при двойном клике-------
 Case #Explor
 file.s=GetGadgetText(#Explor)
 If EventType()= #PB_EventType_LeftDoubleClick
 If GetExtensionPart(file.s)<>"" ; не папка
 If connect=1
 send(file.s) ; отправить на ftp
 EndIf
 EndIf
 EndIf 
 EndSelect
 EndSelect
 If Event = #PB_Event_CloseWindow
 ;---------сохранить настройки-----------------
OpenPreferences("inform.ini")
 PreferenceGroup("настройки")
 WritePreferenceString("каталог", file.s) ; путь к последней открытой категории
 WritePreferenceString("url_ftp", GetGadgetText(#url_ftp))
 WritePreferenceString("log_ftp", GetGadgetText(#log_ftp))
 WritePreferenceString("pas_ftp", GetGadgetText(#pas_ftp))
ClosePreferences() 
 Break 
 EndIf
 ForEver
EndIf 
DataSection 
 folder: IncludeBinary "folder.ico"
 up: IncludeBinary "up.ico"
EndDataSection
 
 ;AbortFTPFile(#Ftp) ; для 4.50
 












Сайт посвящён языку программирования PureBasic — коммерческий компилятор языка программирования, использующего синтаксис BASIC. Предназначен для создания кроссплатформенных приложений для AmigaOS, Linux, Microsoft Windows, Windows NT и Mac OS X. Разработан компанией Fantaisie Software.