Продолжение темы начатой на форуме: 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