FTP клиент
Продолжение темы начатой на
форуме: http://purebasic.info/phpBB2/viewtopic.php?t=681
Простой вариант FTP клиента
Возможности:
Перетягиваниемышкой файлов с компьютера на окно списка ftp...
Перетягивание файлов из списка в список и обратно...
Перетягивание папки с компьютера на ftp (создаётся пустая папка)...
Скачать\отправит - двойной клик по файлу в списке...
Добавление иконок в список в зависимости от ассоциации файлов...
Прогресс бар загрузки в одну, другую сторону...
Удалять файлы и папки...
Создавать папки...
Сортировка папок и файлов по алфавиту...
Отображение даты последнего изменения...
Растягивание окна...
Скачать исходник
Вариант кода для PB_4.50:
<![CDATA[
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(file.s) ; на ftp
;Debug GetFilePart(file)
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 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) ) ; имя выбранного файла
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
</plaintext>
</div><br><br><br><br><br><br><br><br><br><br><br><br><br><br>
</div>
</div>
<!-- copyright (t4) --><div align="center">Используются технологии <a href="http://www.ucoz.ru/" title="Создать сайт бесплатно"><b>uCoz</b></a><br /></div><!-- /copyright -->
</body>
</html>]]></plaintext></div></div></div> 