预览模式: 普通 | 列表

念柳红

作者:青锋幽灵 日期:2008-03-26 10:22

昔日挥泪别西安,今时含笑登鼓山;
远眺榕城繁华处,灯火夕阳映西湖;
适逢冬逝春伊始,缘逢佳人知何时?
天若有情天亦老,苍天笑我轻狂少;
吾幸缘来遇伊人,但求梦境皆亦真;
问君何故将诗颂,心烦意乱念柳红。

法语版(我让别人翻译的)：

Jadis,je parties Xi’an en pleurer, et maintenant escalade la montagne de Gushan en rire;

Regardez les rues animées de Rongcheng au loin, les lampes et le soleil couchant éclairent le Xihu;

Au moment de l’hiver partit et le printemps commença, quand je peux rencontre ma maîtresse?

Si le Dieu a le sentiment, il va vieux jour par jour, le Dieu se moque de mon naïf et imprudent;

Bonne chance, l’affinité predestine est arrive, je rencontre ma maîtresse, j’ espère toutes les choses dans mon rêve est vrai;

On demande que pourquoi vous écrivez le poème, je suis ennuyé parce que je manque Liu Hong.

 

类别: 默认分类 | 引用: 0 | 评论: 0 | 阅读: 1270 | 打印 | 打包

VB用API实现FTP上传文件，创建远程目录(类模块)

作者:青锋幽灵 日期:2008-03-07 23:28

ASP/Visual Basic代码
  1. Option Explicit   
  2. Private Declare Function GetProcessHeap Lib "kernel32" () As Long  
  3. Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long  
  4. Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long  
  5. Private Const HEAP_ZERO_MEMORY = &H8   
  6. Private Const HEAP_GENERATE_EXCEPTIONS = &H4   
  7. Private Declare Sub CopyMemory1 Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)   
  8. Private Declare Sub CopyMemory2 Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Long, hpvSource As Any, ByVal cbCopy As Long)   
  9. Private Const MAX_PATH = 260   
  10. Private Const NO_ERROR = 0   
  11. Private Const FILE_ATTRIBUTE_READONLY = &H1   
  12. Private Const FILE_ATTRIBUTE_HIDDEN = &H2   
  13. Private Const FILE_ATTRIBUTE_SYSTEM = &H4   
  14. Private Const FILE_ATTRIBUTE_DIRECTORY = &H10   
  15. Private Const FILE_ATTRIBUTE_ARCHIVE = &H20   
  16. Private Const FILE_ATTRIBUTE_NORMAL = &H80   
  17. Private Const FILE_ATTRIBUTE_TEMPORARY = &H100   
  18. Private Const FILE_ATTRIBUTE_COMPRESSED = &H800   
  19. Private Const FILE_ATTRIBUTE_OFFLINE = &H1000   
  20. Private Type FILETIME   
  21.         dwLowDateTime As Long  
  22.         dwHighDateTime As Long  
  23. End Type   
  24. Private Type WIN32_FIND_DATA   
  25.         dwFileAttributes As Long  
  26.         ftCreationTime As FILETIME   
  27.         ftLastAccessTime As FILETIME   
  28.         ftLastWriteTime As FILETIME   
  29.         nFileSizeHigh As Long  
  30.         nFileSizeLow As Long  
  31.         dwReserved0 As Long  
  32.         dwReserved1 As Long  
  33.         cFileName As String * MAX_PATH   
  34.         cAlternate As String * 14   
  35. End Type   
  36. Private Const ERROR_NO_MORE_FILES = 18   
  37. Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long  
  38. Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As Long  
  39. Private Declare Function FtpCreateDirectory Lib "wininet.dll" Alias "FtpCreateDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean  
  40. Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" (ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean  
  41. Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hFtpSession As Long, ByVal lpszLocalFile As String, ByVal lpszRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean  
  42. Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean  
  43. Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long  
  44. Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0   
  45. Private Const INTERNET_OPEN_TYPE_DIRECT = 1   
  46. Private Const INTERNET_OPEN_TYPE_PROXY = 3   
  47. Private Const INTERNET_INVALID_PORT_NUMBER = 0   
  48. Private Const FTP_TRANSFER_TYPE_ASCII = &H1   
  49. Private Const FTP_TRANSFER_TYPE_BINARY = &H1   
  50. Private Const INTERNET_FLAG_PASSIVE = &H8000000   
  51. Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long  
  52. Private Const ERROR_INTERNET_EXTENDED_ERROR = 12003   
  53. Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (lpdwError As Long, ByVal lpszBuffer As String, lpdwBufferLength As Long) As Boolean  
  54. Private Const INTERNET_DEFAULT_FTP_PORT = 21   
  55. Private Const INTERNET_DEFAULT_GOPHER_PORT = 70   
  56. Private Const INTERNET_DEFAULT_HTTP_PORT = 80   
  57. Private Const INTERNET_DEFAULT_HTTPS_PORT = 443   
  58. Private Const INTERNET_DEFAULT_SOCKS_PORT = 1080   
  59. Private Const INTERNET_OPTION_CONNECT_TIMEOUT = 2   
  60. Private Const INTERNET_OPTION_RECEIVE_TIMEOUT = 6   
  61. Private Const INTERNET_OPTION_SEND_TIMEOUT = 5   
  62. Private Const INTERNET_OPTION_USERNAME = 28   
  63. Private Const INTERNET_OPTION_PASSWORD = 29   
  64. Private Const INTERNET_OPTION_PROXY_USERNAME = 43   
  65. Private Const INTERNET_OPTION_PROXY_PASSWORD = 44   
  66. Private Const INTERNET_SERVICE_FTP = 1   
  67. Private Const INTERNET_SERVICE_GOPHER = 2   
  68. Private Const INTERNET_SERVICE_HTTP = 3   
  69. Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long  
  70. Private Const INTERNET_FLAG_RELOAD = &H80000000   
  71. Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000   
  72. Private Const INTERNET_FLAG_MULTIPART = &H200000   
  73. Private Const GENERIC_READ = &H80000000   
  74. Private Const GENERIC_WRITE = &H40000000   
  75.   
  76. Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As String, ByVal lOptionalLength As Long) As Integer  
  77. Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer  
  78.   
  79. Private Const HTTP_QUERY_CONTENT_TYPE = 1   
  80. Private Const HTTP_QUERY_CONTENT_LENGTH = 5   
  81. Private Const HTTP_QUERY_EXPIRES = 10   
  82. Private Const HTTP_QUERY_LAST_MODIFIED = 11   
  83. Private Const HTTP_QUERY_PRAGMA = 17   
  84. Private Const HTTP_QUERY_VERSION = 18   
  85. Private Const HTTP_QUERY_STATUS_CODE = 19   
  86. Private Const HTTP_QUERY_STATUS_TEXT = 20   
  87. Private Const HTTP_QUERY_RAW_HEADERS = 21   
  88. Private Const HTTP_QUERY_RAW_HEADERS_CRLF = 22   
  89. Private Const HTTP_QUERY_FORWARDED = 30   
  90. Private Const HTTP_QUERY_SERVER = 37   
  91. Private Const HTTP_QUERY_USER_AGENT = 39   
  92. Private Const HTTP_QUERY_SET_COOKIE = 43   
  93. Private Const HTTP_QUERY_REQUEST_METHOD = 45   
  94. Private Const HTTP_STATUS_DENIED = 401   
  95. Private Const HTTP_STATUS_PROXY_AUTH_REQ = 407   
  96. Private Const HTTP_QUERY_FLAG_REQUEST_HEADERS = &H80000000   
  97. Private Const HTTP_QUERY_FLAG_NUMBER = &H20000000   
  98. Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer  
  99. Private Declare Function InternetWriteFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumberOfBytesToRead As Long, lNumberOfBytesRead As Long) As Integer  
  100. Private Declare Function FtpOpenFile Lib "wininet.dll" Alias "FtpOpenFileA" (ByVal hFtpSession As Long, ByVal sFileName As String, ByVal lAccess As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long  
  101. Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean  
  102. Private Declare Function InternetSetOption Lib "wininet.dll" Alias "InternetSetOptionA" (ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByVal lBufferLength As Long) As Integer  
  103. Private Declare Function InternetSetOptionStr Lib "wininet.dll" Alias "InternetSetOptionA" (ByVal hInternet As Long, ByVal lOption As Long, ByVal sBuffer As String, ByVal lBufferLength As Long) As Integer  
  104. Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer  
  105. Private Declare Function InternetQueryOption Lib "wininet.dll" Alias "InternetQueryOptionA" (ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long) As Integer  
  106. Private Const INTERNET_OPTION_VERSION = 40   
  107. Private Type tWinInetDLLVersion   
  108.     lMajorVersion As Long  
  109.     lMinorVersion As Long  
  110. End Type   
  111. Private Declare Function HttpAddRequestHeaders Lib "wininet.dll" Alias "HttpAddRequestHeadersA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lModifiers As Long) As Integer  
  112. Private Const HTTP_ADDREQ_FLAG_ADD_IF_NEW = &H10000000   
  113. Private Const HTTP_ADDREQ_FLAG_ADD = &H20000000   
  114. Private Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000   
  115. '=====================================================================   
  116. '软件版本   
  117. '=====================================================================   
  118. Private Const scUserAgent = "CMSDreamFTP ActiveX V1.0"  
  119.   
  120. Private hConnection     As Long  
  121. Public LocalFile        As String  
  122. Public RemoteFile       As String  
  123. Public ServerName       As String  
  124. Public UserName         As String  
  125. Public Password         As String  
  126.   
  127. '=====================================================================   
  128. '连接服务器   
  129. '=====================================================================   
  130. Public Function Connect(Optional m_ServerName As String, _   
  131.                         Optional m_UserName As String, _   
  132.                         Optional m_Password As String) As Boolean  
  133.     Dim hOpen As Long  
  134.     hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)   
  135.     If Trim(m_ServerName) <> "" Then ServerName = m_ServerName   
  136.     If Trim(m_UserName) <> "" Then UserName = m_UserName   
  137.     If Trim(m_Password) <> "" Then Password = m_Password   
  138.     hConnection = InternetConnect(hOpen, _   
  139.                                   ServerName, _   
  140.                                   INTERNET_INVALID_PORT_NUMBER, _   
  141.                                   UserName, _   
  142.                                   Password, _   
  143.                                   INTERNET_SERVICE_FTP, _   
  144.                                   INTERNET_FLAG_PASSIVE, _   
  145.                                   0)   
  146.     Connect = CBool(hConnection)   
  147.     If Not Connect Then Err.Raise vbObjectError + 510, "Connect Function", "Connect to server failed:" & Err.Description   
  148. End Function  
  149.   
  150. '=====================================================================   
  151. '从服务器断开连接   
  152. '=====================================================================   
  153. Public Function DisConnect() As Boolean  
  154.     DisConnect = True  
  155.     If hConnection <> 0 Then  
  156.         hConnection = 0   
  157.         DisConnect = CBool(InternetCloseHandle(hConnection))   
  158.     End If  
  159. End Function  
  160.   
  161. '=====================================================================   
  162. '文件传送   
  163. '=====================================================================   
  164. Public Function Transfer(Optional v_LocalFile As String, _   
  165.                          Optional v_RemoteFile As String, _   
  166.                          Optional m_ServerName As String, _   
  167.                          Optional m_UserName As String, _   
  168.                          Optional m_Password As String) As Boolean  
  169.                             
  170.     If Trim(v_LocalFile) <> "" Then LocalFile = v_LocalFile   
  171.     If Trim(v_RemoteFile) <> "" Then RemoteFile = v_RemoteFile   
  172.        
  173.     If Err.Number <> 0 Then Err.Clear   
  174.     On Error Resume Next  
  175.     Dim v_RemotePath As String: v_RemotePath = GetRemoteFolder(RemoteFile)   
  176.        
  177.     If hConnection = 0 Then  
  178.         If Trim(m_ServerName) <> "" Then ServerName = m_ServerName   
  179.         If Trim(m_UserName) <> "" Then UserName = m_UserName   
  180.         If Trim(m_Password) <> "" Then Password = m_Password   
  181.         Call Connect(ServerName, UserName, Password)   
  182.     End If  
  183.     '=========================   
  184.     '创建远程文件夹   
  185.     '=========================   
  186.     If v_RemotePath <> "" Then  
  187.         If Right(v_RemotePath, 1) <> "/" Then v_RemotePath = v_RemotePath & "/"  
  188.         Call CreateRemoteFolder(v_RemotePath)   
  189.     End If  
  190.        
  191.     If Dir(LocalFile) = "" Then  
  192.         Err.Raise vbObjectError + 512, "Transfer Function", "The local file is not exists:" & LocalFile   
  193.         Err.Clear   
  194.     End If  
  195.        
  196.     Transfer = FtpPutFile(hConnection, LocalFile, RemoteFile, FTP_TRANSFER_TYPE_BINARY, 0)   
  197.     If Err Then  
  198.         Err.Raise vbObjectError + 513, "Transfer Function", "Transfer the file failed:" & Err.Description   
  199.         Err.Clear   
  200.     End If  
  201. End Function  
  202.   
  203. '=====================================================================   
  204. '创建远程文件夹   
  205. '=====================================================================   
  206. Public Sub CreateRemoteFolder(ByVal RemotePath As String)   
  207.     If Trim(RemotePath) = "" Then Exit Sub  
  208.     On Error Resume Next  
  209.     Dim v_RemotePath As String: v_RemotePath = RemotePath   
  210.     Dim aFolder As String, sPosition As Long  
  211.     Dim i As Long: i = 0   
  212.     sPosition = InStr(v_RemotePath, "/")   
  213.     aFolder = ""  
  214.     Do While sPosition > 0 And i < 100   
  215.         sPosition = InStr(v_RemotePath, "/")   
  216.         aFolder = aFolder & Left(v_RemotePath, sPosition)   
  217.         v_RemotePath = Mid(v_RemotePath, sPosition + 1)   
  218.         If Not (aFolder = "/" Or aFolder = "") Then  
  219.             If Not FtpCreateDirectory(hConnection, aFolder) Then  
  220.                 Err.Raise vbObjectError + 511, "CreateRemoteFolder Sub", "Create a remote folder failed:" & Err.Description   
  221.                 Err.Clear   
  222.             End If  
  223.         End If  
  224.         i = i + 1   
  225.     Loop  
  226. End Sub  
  227.   
  228. Private Function GetRemoteFolder(ByVal RemoteFilePath As String) As String  
  229.     GetRemoteFolder = RemoteFilePath   
  230.     If Trim(RemoteFilePath) = "" Then Exit Function  
  231.     RemoteFilePath = Replace(RemoteFilePath, "\", "/")  
  232.     If Right(RemoteFilePath, 1) = "/" Then Exit Function  
  233.     GetRemoteFolder = Left(RemoteFilePath, InStrRev(RemoteFilePath, "/"))   
  234. End Function  
  235.   
  236. Private Sub Class_Initialize()   
  237.     '   
  238. End Sub  
  239.   
  240. Private Sub Class_Terminate()   
  241.     DisConnect   
  242. End Sub  
标签: api ftp
类别: VB | 引用: 0 | 评论: 0 | 阅读: 1735 | 打印 | 打包
  • 1