$PBExportHeader$nvo_ftp.sru forward global type nvo_ftp from nonvisualobject end type end forward type filetime from structure unsignedlong dwlowdatetime unsignedlong dwhighdatetime end type type win32_find_data from structure unsignedlong dwfileattributes filetime ftcreationtime filetime ftlastaccesstime filetime ftlastwritetime unsignedlong nfilesizehigh unsignedlong nfilesizelow unsignedlong dwreserved0 unsignedlong dwreserved1 character cfilename[260] character calternate[14] end type type systemtime from structure integer wYear integer wMonth integer wDayOfWeek integer wDay integer wHour integer wMinute integer wSecond integer wMilliseconds end type global type nvo_ftp from nonvisualobject end type global nvo_ftp nvo_ftp type prototypes FUNCTION ulong InternetGetConnectedState( REF ulong lpdwFlags, ulong dwReserved ) LIBRARY "wininet.dll" Function Long InternetOpen(String sAgent, Long lAccessType, String sProxyName,String sProxyBypass, Long lFlags) Library "wininet.dll" Alias For "InternetOpenA;Ansi" Function Long InternetConnect(Long hInternetSession, String sServerName, Integer nServerPort, String sUsername,String sPassword, Long lService, Long lFlags, Long lContext) Library "wininet.dll" Alias For "InternetConnectA;Ansi" Function Integer InternetCloseHandle(Long hInet) Library "wininet.dll" Function Boolean FtpGetCurrentDirectory(Long hFtpSession, ref String lpszDirectory, ref Long lpdwCurrentDirectory) Library "wininet.dll" Alias For "FtpGetCurrentDirectoryA;Ansi" Function Boolean FtpSetCurrentDirectory(Long hFtpSession, ref String lpszDirectory) Library "wininet.dll" Alias For "FtpSetCurrentDirectoryA;Ansi" Function Long FtpFindFirstFile(Long hFtpSession, String lpszSearchFile,ref win32_find_data lpFindFileData, Long dwFlags,Long dwContent) Library "wininet.dll" Alias For "FtpFindFirstFileA;Ansi" Function Long InternetFindNextFile(Long hFind, ref win32_find_data lpvFindData) Library "wininet.dll" Alias For "InternetFindNextFileA;Ansi" Function Boolean FtpGetFile(Long hFtpSession, String lpszRemoteFile, String lpszNewFile, Boolean fFailIfExists, Long dwFlagsAndAttributes, Long dwFlags, Long dwContext) Library "wininet.dll" Alias For "FtpGetFileA;Ansi" Function Boolean FtpPutFile(Long hFtpSession, String lpszLocalFile, String lpszRemoteFile, Long dwFlags, Long dwContext) Library "wininet.dll" Alias For "FtpPutFileA;Ansi" Function Boolean FtpDeleteFile(Long hFtpSession, String lpszFileName) Library "wininet.dll" Alias For "FtpDeleteFileA;Ansi" Function Long FtpOpenFile(Long hFtpSession, String lpszRemoteFile, Long dwFlagsAndAttributes, Long dwFlags, Long dwContext) Library "wininet.dll" Alias For "FtpOpenFileA;Ansi" FUNCTION ulong FileTimeToSystemTime(ref FILETIME lpFileTime,ref SYSTEMTIME lpSystemTime) LIBRARY "kernel32.dll" alias for "FileTimeToSystemTime;Ansi" FUNCTION ulong GetCurrentDirectory(ulong nBufferLength,ref string lpBuffer) LIBRARY "kernel32.dll" Alias For "GetCurrentDirectoryA;Ansi" FUNCTION ulong SetCurrentDirectory(ref string lpPathName) LIBRARY "kernel32.dll" ALIAS FOR "SetCurrentDirectoryA;Ansi" FUNCTION ulong FindFirstFile(ref string lpFileName,ref WIN32_FIND_DATA lpFindFileData) LIBRARY "kernel32.dll" ALIAS FOR "FindFirstFileA;Ansi" FUNCTION ulong FindNextFile(ulong hFindFile,ref WIN32_FIND_DATA lpFindFileData) LIBRARY "kernel32.dll" ALIAS FOR "FindNextFileA;Ansi" FUNCTION ulong GetDriveType(ref string nDrive) LIBRARY "kernel32.dll" ALIAS FOR "GetDriveTypeA;Ansi" FUNCTION ulong DeleteFile(ref string lpFileName) LIBRARY "kernel32.dll" ALIAS FOR "DeleteFileA;Ansi" Function ulong ShellExecute(ulong hwnd,ref string lpOperation,ref string lpFile,ref string lpParameters,ref string lpDirectory,ulong nShowCmd) LIBRARY "shell32.dll" ALIAS FOR "ShellExecuteA;Ansi" end prototypes type variables Private: Long il_dwflags = 1 //传输方式1为ASSIC方式,2为二进制方式 Boolean ib_overfile = False //是否覆盖己存在的文件 Long il_handle = 0 //是否连接上网络 0 不成功 Long il_netconn = 0 //连接上FTP的句柄 0 不成功 Long il_findfile = 0 //是否找到第一个文件 Long il_localfindfile = 0 //是否找到本地的第一个文件 String is_servername String is_username String is_password Integer ii_port end variables forward prototypes public function long of_internetopen () public function long uf_ftpconnect (string as_servername, string as_username, string as_password, integer ai_port) public function boolean uf_ftpgetfile (string as_remotefile, string as_newfile) public function boolean of_ftpconnect () public function boolean uf_ftpputfile (string as_localfile, string as_remotefile) public function boolean uf_ftpdeletefile (string as_remotefile) public function string uf_ftpfindfirstfile (string as_filemask) public function boolean uf_ftpsetcurrentdir (string as_currentdir) public function boolean of_internetclose () public function boolean uf_internetclose () public function string uf_ftpfindnextfile () public function string uf_ftpgetcurrentdir () public function string uf_cutstring (string as_string, string as_posstring, integer ai_pos) public function string of_markfileinfo (win32_find_data astr_data) public function datetime of_filetime2systemtime (filetime astr_filetime) public function string uf_getcurrentdir () public function string uf_findfirstfile (string as_filemask) public function string uf_findnextfile () public function string uf_remotefilelist (string as_filemask) public function long of_internetopen () public function long uf_ftpconnect (string as_servername, string as_username, string as_password, integer ai_port) public function boolean uf_ftpgetfile (string as_remotefile, string as_newfile) public function boolean of_ftpconnect () public function boolean uf_ftpputfile (string as_localfile, string as_remotefile) public function boolean uf_ftpdeletefile (string as_remotefile) public function string uf_ftpfindfirstfile (string as_filemask) public function boolean uf_ftpsetcurrentdir (string as_currentdir) public function boolean of_internetclose () public function boolean uf_internetclose () public function string uf_ftpfindnextfile () public function string uf_ftpgetcurrentdir () public function string uf_cutstring (string as_string, string as_posstring, integer ai_pos) public function string of_markfileinfo (win32_find_data astr_data) public function datetime of_filetime2systemtime (filetime astr_filetime) public function string uf_getcurrentdir () public function string uf_findfirstfile (string as_filemask) public function string uf_findnextfile () public function string uf_remotefilelist (string as_filemask) public function string uf_localfilelist (string as_filemask) public function boolean uf_setcurrentdir (string as_currentdir) public subroutine uf_resetremotefind () public subroutine uf_resetlocalfind () public function integer uf_getdrivetype (string as_diskpath) public function string uf_readini (string as_filename, string as_section, string as_key, string as_default) public subroutine uf_overfile (boolean ab_flag) public subroutine uf_sendmode (string as_mode) public function boolean uf_actionfile (unsignedlong aul_hwnd, string as_filename) public function boolean uf_deletefile (string as_filename) public function integer uf_internetconnect () end prototypes public function long of_internetopen ();String ls_proxyname,ls_proxypass Long ll_handle SetNull(ls_proxyname) SetNull(ls_proxypass) ll_handle = InternetOpen("FTP Control",1,ls_proxyname,ls_proxypass,0) If ll_handle = 0 Then MessageBox('提示','不能打开Ftp控制。') Return 0 End If Return ll_handle end function public function long uf_ftpconnect (string as_servername, string as_username, string as_password, integer ai_port);il_handle = of_internetopen() If il_handle = 0 Then Return 0 il_netconn = InternetConnect(il_handle,as_servername,ai_port,as_username,as_password,1,0,0) If il_netconn = 0 Then of_internetclose() MessageBox('提示','不能连接主机 '+as_servername+' 。') Return 0 End If is_servername = as_servername is_username = as_username is_password = as_password ii_port = ai_port Return il_netconn end function public function boolean uf_ftpgetfile (string as_remotefile, string as_newfile);If Not of_ftpconnect() Then Return False Boolean lb_ok,lb_notover lb_notover = Not ib_overfile lb_ok = FtpGetFile(il_netconn,as_remotefile,as_newfile,lb_notover,0,il_dwflags,0) IF lb_ok = False Then // MessageBox('提示','下载文件'+as_remotefile+'时出错。') Return False End If Return True end function public function boolean of_ftpconnect ();If il_netconn = 0 Then MessageBox('提示','请先连接FTP服务器。') Return False End If Return True end function public function boolean uf_ftpputfile (string as_localfile, string as_remotefile);If Not of_ftpconnect() Then Return False Boolean lb_ok lb_ok = FtpPutFile(il_netconn,as_localfile,as_remotefile,il_dwflags,0) IF lb_ok = False Then // MessageBox('提示','上传文件'+as_localfile+'时出错。') Return False End If Return True end function public function boolean uf_ftpdeletefile (string as_remotefile);If Not of_ftpconnect() Then Return False Boolean lb_ok lb_ok = FtpDeleteFile(il_netconn,as_remotefile) IF lb_ok = False Then // MessageBox('提示','删除远程文件'+as_remotefile+'时出错。') Return False End If Return True end function public function string uf_ftpfindfirstfile (string as_filemask);//==================================================================== // Function - uf_ftpfindfirstfile for nvo_ftp //-------------------------------------------------------------------- // 描述: 寻找符合的第一个文件名 //-------------------------------------------------------------------- // 参数: // // string as_filemask // <描述> 需寻找的文件名,可用通配符*或? //-------------------------------------------------------------------- // 返回值: (STRING) 文件名 //-------------------------------------------------------------------- // 编制: BAOYF 日期: 2002.10.09 15:09 //==================================================================== If Not of_ftpconnect() Then Return '?' If il_findfile <> 0 Then Return '?' String ls_filename = "?" win32_find_data lstr_data lstr_data.cfilename = Space(260) lstr_data.calternate = Space(14) il_findfile = FtpFindFirstFile(il_netconn,as_filemask,lstr_data,0,0) If il_findfile <> 0 Then ls_filename = of_markfileinfo(lstr_data) End If Return ls_filename end function public function boolean uf_ftpsetcurrentdir (string as_currentdir);If Not of_ftpconnect() Then Return False Boolean lb_ok lb_ok = FtpSetCurrentDirectory(il_netconn,as_currentdir) If lb_ok Then Return True //MessageBox("提示","设置远程目录错误。") Return False end function public function boolean of_internetclose ();//==================================================================== // Function - of_internetclose for nvo_ftp //-------------------------------------------------------------------- // 描述: 关闭ftp连接与网络连接 //-------------------------------------------------------------------- // 参数: 无 // // <数据类型> <名称> // <描述> // <数据类型> <名称> // <描述> //-------------------------------------------------------------------- // 返回值: (BOOLEAN) True成功 False不成功 //-------------------------------------------------------------------- // 编制: BAOYF 日期: 2002.10.09 15:06 //==================================================================== Long ll_ok ll_ok = InternetCloseHandle(il_netconn) If ll_ok = 0 Then Return False End If il_netconn = 0 il_findfile = 0 il_localfindfile = 0 ll_ok = InternetCloseHandle(il_handle) If ll_ok = 0 Then Return False End If il_handle = 0 Return True end function public function boolean uf_internetclose ();Return of_internetclose() end function public function string uf_ftpfindnextfile ();If il_findfile = 0 Then MessageBox("提示","不能确定文件的位置。") Return "?" End If Long ll_ok String ls_filename = "?" win32_find_data lstr_data lstr_data.cfilename = Space(260) lstr_data.calternate = Space(14) ll_ok = InternetFindNextFile(il_findfile,lstr_data) If ll_ok <> 0 Then ls_filename = of_markfileinfo(lstr_data) End If Return ls_filename end function public function string uf_ftpgetcurrentdir ();If Not of_ftpconnect() Then Return "?" String ls_dir Long ll_len Boolean lb_ok ls_dir = Space(250) ll_len = 250 lb_ok = FtpGetCurrentDirectory(il_netconn,ls_dir,ll_len) If lb_ok Then Return Left(ls_dir,ll_len) End If MessageBox("提示","取远程目录错误。") Return "?" end function public function string uf_cutstring (string as_string, string as_posstring, integer ai_pos);//剪取一串字符串中按as_posstring分开的第ai_pos段字符串 /*例如: ls_str = "abc||bst||9usdf8||klsfj12||9886" ls_pos = "||" li_pos = 3 则uf_cutstring(ls_str,ls_pos,li_pos) = "9usdf8" */ integer li_pos,li_poslen integer li_i,li_sumi string ls_return ls_return = "" li_poslen = len(as_posstring) li_sumi = ai_pos - 1 for li_i = 1 to li_sumi li_pos = pos(as_string,as_posstring) if li_pos = 0 then goto l_return as_string = mid(as_string,li_pos + li_poslen) next li_pos = pos(as_string,as_posstring) if li_pos = 0 then ls_return = as_string else ls_return = mid(as_string,1,li_pos - 1) end if return ls_return l_return: return ls_return end function public function string of_markfileinfo (win32_find_data astr_data);String ls_fileinfo DateTime ldt_filetime ldt_filetime = of_filetime2systemtime(astr_data.ftlastwritetime) ls_fileinfo = Trim(astr_data.cfilename) Choose Case astr_data.dwfileattributes Case 16,17,18,20,21,22,23,48,49,50,52,53,2066 ls_fileinfo = ls_fileinfo + '?' + '-1' //目录 Case Else ls_fileinfo = ls_fileinfo + '?' + String(astr_data.nfilesizelow) End Choose ls_fileinfo = ls_fileinfo + '?' + String(ldt_filetime,'yyyy.mm.dd hh:mm:ss') Return ls_fileinfo end function public function datetime of_filetime2systemtime (filetime astr_filetime);String ls_date,ls_time DateTime ldt_datetime systemtime lstr_systemtime FileTimeToSystemTime(astr_filetime,lstr_systemtime) ls_date = String(lstr_systemtime.wyear)+'-'+String(lstr_systemtime.wmonth)+'-'+String(lstr_systemtime.wday) ls_time = String(lstr_systemtime.whour)+':'+String(lstr_systemtime.wminute)+':'+String(lstr_systemtime.wsecond) ldt_datetime = Datetime(Date(ls_date),Time(ls_time)) Return ldt_datetime end function public function string uf_getcurrentdir ();String ls_dirstring uLong ll_len,ll_ok ls_dirstring = Space(256) ll_len = 256 ll_ok = GetCurrentDirectory(ll_len,ls_dirstring) If ll_ok <> 0 Then ls_dirstring = Trim(ls_dirstring) Return ls_dirstring End If Return "?" end function public function string uf_findfirstfile (string as_filemask);String ls_filename = "?" win32_find_data lstr_data lstr_data.cfilename = Space(260) lstr_data.calternate = Space(14) il_localfindfile = FindFirstFile(as_filemask,lstr_data) If il_localfindfile <> 0 Then ls_filename = of_markfileinfo(lstr_data) End If Return ls_filename end function public function string uf_findnextfile ();If il_localfindfile = 0 Then MessageBox("提示","不能确定本地文件的位置。") Return "?" End If Long ll_ok String ls_filename = "?" win32_find_data lstr_data lstr_data.cfilename = Space(260) lstr_data.calternate = Space(14) ll_ok = FindNextFile(il_localfindfile,lstr_data) If ll_ok <> 0 Then ls_filename = of_markfileinfo(lstr_data) End If Return ls_filename end function public function string uf_remotefilelist (string as_filemask);If il_findfile = 0 Then Return uf_ftpfindfirstfile(as_filemask) End If Return uf_ftpfindnextfile() end function public function string uf_localfilelist (string as_filemask);If il_localfindfile = 0 Then Return uf_findfirstfile(as_filemask) End If Return uf_findnextfile() end function public function boolean uf_setcurrentdir (string as_currentdir);Long ll_ok ll_ok = SetCurrentDirectory(as_currentdir) If ll_ok = 0 Then Return False Return True end function public subroutine uf_resetremotefind ();il_findfile = 0 end subroutine public subroutine uf_resetlocalfind ();il_localfindfile = 0 end subroutine public function integer uf_getdrivetype (string as_diskpath);//Return : //0 指定设备不可用 //1 指定目录不存在 //2 可移动设备DRIVE_REMOVABLE //3 DRIVE_FIXED //4 DRIVE_REMOTE //5 DRIVE_CDROM //6 虚拟设备 DRIVE_RAMDISK //其它不存在 Return GetDriveType(as_diskpath) end function public function string uf_readini (string as_filename, string as_section, string as_key, string as_default);//读取ini文件中的信息,若不存在此值则新增一个值 //参数:as_filename INI文件名 // as_section 段 // as_key 键 // as_default 默认值 //返回:读取的值 Integer li_fileno String ls_string If FileExists(as_filename) = False Then li_fileno = FileOpen(as_filename,LineMode!,Write!,LockWrite!,Append!) If li_fileno <= 0 Then MessageBox('提示','文件不能被创建,请与管理员联系。') Return '' End If FileClose(li_fileno) End If ls_string = ProfileString (as_filename,as_section,as_key,'Bsoft_Value') If ls_string = 'Bsoft_Value' Then SetProfileString(as_filename,as_section,as_key,as_default) ls_string = as_default End If Return ls_string end function public subroutine uf_overfile (boolean ab_flag);ib_overfile = ab_flag end subroutine public subroutine uf_sendmode (string as_mode);String ls_mode ls_mode = Upper(as_mode) If ls_mode = 'BIN' Then il_dwflags = 2 Else il_dwflags = 1 End If end subroutine public function boolean uf_actionfile (unsignedlong aul_hwnd, string as_filename);String str_null,str_filename uLong ll_ok SetNull ( str_null ) ll_ok = ShellExecute(aul_hwnd, str_null , as_filename , str_null, str_null, 1 ) If ll_ok = 0 Then Return False Return True end function public function boolean uf_deletefile (string as_filename);//删除本地文件 Long ll_ok ll_ok = DeleteFile(as_filename) If ll_ok = 0 Then Return False Return True end function public function integer uf_internetconnect ();uLong lul_connection lul_connection = 7 Return InternetGetConnectedState( lul_connection, 0 ) //= 0 //不通 //= 1 //拨号连通 //= 2 //网络连通 //= 4 //proxy连通 end function on nvo_ftp.create TriggerEvent( this, "constructor" ) end on on nvo_ftp.destroy TriggerEvent( this, "destructor" ) end on