求助vb编写ftp服务器端登陆路径的问题！
各位大哥，小弟新手，求助有关vb编写ftp服务器端代码的问题。我从网上找了一段现成的代码。但是在本机上运行有点问题，就是不能列出指定的目录（客户端用flashfxp）。当我在vb中调试这段代码的时候，flashfxp开始都可以与这段代码进行沟通，比如USER，PASS，TYPE等等，直到flashfxp发送“LIST”的时候，server端反馈“150 Opening ASCII mode data connection for /bin/ls”后就停在那里了，正常情况应该是开始列出当前目录中的文件的。我分析问题可能出在当前目录设置上，或者双方的通信上。可是我不知道该怎么解决。还有，这段代码中提及unix的东西，我搞不懂ftp是不是建在unix才可行啊？还请有经验的大人帮助解决啊！小弟跪谢了！
程序很简单，只有一个窗体，一个模块，和一个ini文件。(ft!说帖子太长，module写不下了)
如下：
form1：
Private Sub Form_Load()
Max = 0
s(Max).LocalPort = 21
s(Max).Listen
Form1.Caption = "[" & s(Max).LocalIP & "] - Tribe Software Ftp Server"
List1.AddItem "Tribe Software Ftp Server - Beta"
List1.AddItem "?1999 Joe Morrow"
List1.AddItem ""
List1.AddItem "Listening for connections on port 21"
List1.AddItem ""
End Sub
Private Sub s_ConnectionRequest(Index As Integer, ByVal requestID As Long)
If Index = 0 Then
Max = Max + 1
Load s(Max)
Load c(Max)
Load Data(Max)
Load User(Max)
Load ChkUsr(Max)
Load Password(Max)
Load ChkPwd(Max)
Load PortInfo(Max)
Load CurrentDir(Max)
Load PreviousDir(Max)
Load RealDir(Max)
CurrentDir(Max).Caption = "."
PreviousDir(Max).Caption = "."
c(Max).Close
s(Max).LocalPort = 0
s(Max).Close
s(Max).Accept requestID
List1.AddItem "[" & Max & "] " & s(Index).RemoteHostIP & ": Connected Successfully"
s(Max).SendData "220-Tribe Software Ftp Server - Beta" & vbCrLf
s(Max).SendData "220 ?1999 Joe Morrow" & vbCrLf
End If
End Sub
Private Sub s_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim TheData As String
s(Index).GetData TheData
Data(Index).Caption = TheData
If UCase(Left$(Data(Index).Caption, 4)) = "USER" Then
User(Index).Caption = Mid(Data(Index).Caption, 6, Len(Data(Index).Caption))
ChkUsr(Index).Caption = Mid(User(Index).Caption, 1, (Len(User(Index).Caption) - 2))
List1.AddItem "[" & Max & "] " & s(Index).RemoteHostIP & ": Username: " & ChkUsr(Index).Caption
If ReadINI("USER=" & ChkUsr(Index).Caption, "Enabled", "D:\例程\ftp\ftp server\Tribe.ini") = "Yes" Then
If Max > ReadINI("server", "MaxUsers", "D:\例程\ftp\ftp server\Tribe.ini") Then
s(Index).SendData "421 Too many users. Please try again later" & vbCrLf
s(Index).Close
Else
s(Index).SendData "331 Password required for " & User(Index).Caption
End If
Else
s(Index).SendData "530 Access denied for" & User(Index).Caption
s(Index).Close
End If
End If
If UCase(Left$(Data(Index).Caption, 4)) = "PASS" Then
Password(Index).Caption = Mid(Data(Index).Caption, 6, Len(Data(Index).Caption))
ChkPwd(Index).Caption = Mid(Password(Index).Caption, 1, (Len(Password(Index).Caption) - 2))
List1.AddItem "[" & Max & "] " & s(Index).RemoteHostIP & ": Password: " & ChkPwd(Index).Caption
If ReadINI("USER=" & ChkUsr(Index).Caption, "Password", "D:\例程\ftp\ftp server\Tribe.ini") = ChkPwd(Index).Caption Then
s(Index).SendData "230 Password correct. User " & ChkUsr(Index).Caption & " logged in" & vbCrLf
RealDir(Index).Caption = ReadINI("USER=" & ChkUsr(Index).Caption, "HomeDir", "D:\例程\ftp\ftp server\Tribe.ini")
ElseIf ReadINI("USER=" & ChkUsr(Index).Caption, "Password", "D:\例程\ftp\ftp server\Tribe.ini") = "*" Then
s(Index).SendData "230 Password correct. User " & ChkUsr(Index).Caption & " logged in" & vbCrLf
RealDir(Index).Caption = ReadINI("USER=" & ChkUsr(Index).Caption, "HomeDir", "D:\例程\ftp\ftp server\Tribe.ini")
Else
s(Index).SendData "530 Invalid password for " & User(Index).Caption
s(Index).Close
End If
End If
If UCase(Left$(Data(Index).Caption, 3)) = "PWD" Then
s(Index).SendData "257 " & CurrentDir(Index).Caption & " is the current directory" & vbCrLf
End If
If UCase(Left$(Data(Index).Caption, 4)) = "SYST" Then
s(Index).SendData "215 UNIX Type: Tribe Software Ftp Server" & vbCrLf
End If
If UCase(Left$(Data(Index).Caption, 4)) = "PORT" Then
PortInfo(Index).Caption = Mid(Data(Index).Caption, 6, Len(Data(Index).Caption))
For x = 1 To 4
If Mid(PortInfo(Index).Caption, 2, 1) = "," Then
Ip(x) = Mid(PortInfo(Index).Caption, 1, 1)
PortInfo(Index).Caption = Mid(PortInfo(Index).Caption, 3, Len(PortInfo(Index).Caption))
ElseIf Mid(PortInfo(Index).Caption, 3, 1) = "," Then
Ip(x) = Mid(PortInfo(Index).Caption, 1, 2)
PortInfo(Index).Caption = Mid(PortInfo(Index).Caption, 4, Len(PortInfo(Index).Caption))
ElseIf Mid(PortInfo(Index).Caption, 4, 1) = "," Then
Ip(x) = Mid(PortInfo(Index).Caption, 1, 3)
PortInfo(Index).Caption = Mid(PortInfo(Index).Caption, 5, Len(PortInfo(Index).Caption))
End If
Next x
If Mid(PortInfo(Index).Caption, 2, 1) = "," Then
Port(1) = Mid(PortInfo(Index).Caption, 1, 1)
Port(2) = Mid(PortInfo(Index).Caption, 3, Len(PortInfo(Index).Caption))
ElseIf Mid(PortInfo(Index).Caption, 3, 1) = "," Then
Port(1) = Mid(PortInfo(Index).Caption, 1, 2)
Port(2) = Mid(PortInfo(Index).Caption, 4, Len(PortInfo(Index).Caption))
ElseIf Mid(PortInfo(Index).Caption, 4, 1) = "," Then
Port(1) = Mid(PortInfo(Index).Caption, 1, 3)
Port(2) = Mid(PortInfo(Index).Caption, 5, Len(PortInfo(Index).Caption))
End If
daPort = (256 * Port(1)) + Port(2)
c(Index).Close
c(Index).LocalPort = Port(1)
c(Index).RemoteHost = Ip(1) & "." & Ip(2) & "." & Ip(3) & "." & Ip(4)
c(Index).RemotePort = daPort
c(Index).Connect
Do Until c(Index).State = sckConnected
DoEvents
Loop
s(Index).SendData "200 Port command successful" & vbCrLf
End If
If UCase(Left$(Data(Index).Caption, 4)) = "LIST" Then
s(Index).SendData "150 Opening ASCII mode data connection for /bin/ls" & vbCrLf
s(Index).SendData "226 Transfer complete" & vbCrLf
c(Index).SendData "-rw-r--r-- 1 ayoung user 1640 Aug 29 17:44 contact.gif" & vbCrLf
End If
If UCase(Left$(Data(Index).Caption, 4)) = "NLST" Then
s(Index).SendData "150 Opening ASCII mode data connection for /bin/ls" & vbCrLf
NLSTFiles "C:\", Index
s(Index).SendData "226 Transfer complete" & vbCrLf
End If
If UCase(Left$(Data(Index).Caption, 4)) = "QUIT" Then
s(Index).SendData "221 Goodbye" & vbCrLf
s(Index).Close
End If
If UCase(Left$(Data(Index).Caption, 4)) = "NOOP" Then
s(Index).SendData "200 NOOP Command OK" & vbCrLf
End If
If UCase(Left$(Data(Index).Caption, 4)) = "TYPE" Then
TheType = Mid(Data(Index).Caption, 6, Len(Data(Index).Caption))
s(Index).SendData "200 Type OK" & vbCrLf
End If
If UCase(Left$(Data(Index).Caption, 4)) = "REST" Then
REST = Mid(Data(Index).Caption, 6, Len(Data(Index).Caption))
s(Index).SendData "350 Will attempt to restart at position " & REST & vbCrLf
End If
End Sub
Tribe.ini:
[server]
MaxUsers=20
[USER=anonymous]
Enabled=Yes
Password=*
HomeDir=C:\
MaxUsers=15
[USER=joe]
Enabled=Yes
Password=joe
HomeDir=C:\
MaxUsers=1
问题点数：0、回复次数：3Top
1 楼sushaoxin（爱已成风）回复于 2003-06-06 16:20:06 得分 0
补贴一下module：
Global daPort As Integer
Global Max As Integer
Global Ip(1 To 4) As Integer
Global Port(1 To 2) As Integer
Option Explicit
#If Win16 Then
Declare Function WritePrivateProfileString Lib "Kernel" (ByVal AppName As String, ByVal KeyName As String, ByVal NewString As String, ByVal filename As String) As Integer
Declare Function GetPrivateProfileString Lib "Kernel" Alias "GetPrivateProfilestring" (ByVal AppName As String, ByVal KeyName As Any, ByVal default As String, ByVal ReturnedString As String, ByVal MAXSIZE As Integer, ByVal filename As String) As Integer
#Else
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As Any, ByVal lpFileName As String) As Long
#End If
Function ReadINI(Section, KeyName, filename As String) As String
Dim sRet As String
sRet = String(255, Chr(0))
ReadINI = Left(sRet, GetPrivateProfileString(Section, ByVal KeyName, "", sRet, Len(sRet), filename))
End Function
Function WriteINI(sSection As String, sKeyName As String, sNewString As String, sFileName) As Integer
Dim r
r = WritePrivateProfileString(sSection, sKeyName, sNewString, sFileName)
End Function
Sub ListSubDirs(Path)
On Error Resume Next
Dim Count, D(), I, DirName
DirName = Dir(Path, 16)
Do While DirName <> ""
If DirName <> "." And DirName <> ".." Then
If GetAttr(Path + DirName) = 16 Then
If (Count Mod 10) = 0 Then
ReDim Preserve D(Count + 10)
End If
Count = Count + 1
D(Count) = DirName
End If
End If
DirName = Dir
Loop
For I = 1 To Count
Form1.List1.AddItem Path & D(I)
Next I
DoEvents
End Sub
Sub NLSTFiles(Path As String, iNum As Integer)
On Error Resume Next
Dim Count, D(), I, DirName
DirName = Dir(Path, 6)
Do While DirName <> ""
If DirName <> "." And DirName <> ".." Then
Form1.c(iNum).SendData DirName & vbCrLf
End If
DirName = Dir
Loop
End Sub
Sub UnloadStuff(iNum As Integer)
Unload Form1.s(iNum)
Unload Form1.c(iNum)
Unload Form1.Data(iNum)
Unload Form1.User(iNum)
Unload Form1.ChkUsr(iNum)
Unload Form1.Password(iNum)
Unload Form1.ChkPwd(iNum)
Unload Form1.PortInfo(iNum)
Unload Form1.CurrentDir(iNum)
Unload Form1.PreviousDir(iNum)
Unload Form1.RealDir(iNum)
End Sub
Top
2 楼sushaoxin（爱已成风）回复于 2003-06-06 16:22:18 得分 0
关键是运行到这个IF结束的时候，这个sub就不在执行了！
If UCase(Left$(Data(Index).Caption, 4)) = "LIST" Then
s(Index).SendData "150 Opening ASCII mode data connection for /bin/ls" & vbCrLf
s(Index).SendData "226 Transfer complete" & vbCrLf
c(Index).SendData "-rw-r--r-- 1 ayoung user 1640 Aug 29 17:44 contact.gif" & vbCrLf
End If
Top
3 楼pigsanddogs（我爱吃猪肉,但是长不胖,为什么??）回复于 2003-06-06 18:36:05 得分 0
s(Index).SendData "226 Transfer complete" & vbCrLf
c(Index).SendData "-rw-r--r-- 1 ayoung user 1640 Aug 29 17:44
改成
c(Index).SendData "-rw-r--r-- 1 ayoung user 1640 Aug 29 17:44
c(Index).Close
s(Index).SendData "226 Transfer complete" & vbCrLf
看上面3句就知道，这是个ftp server玩具拉，他根本就不读什么本地文件。
1：TYPE 也是简单的返回，上面不还是ascii mode么，数据通道的文件也是写死的。。
2：用户的验证读ini文件，密码也是，不过用户直接list，type等也可以使用
3：验证的时候他直接发现用户不存在就跳出了，本来是要user xxx， pass xx才去判断的
......
他只是告诉你一个思路, ftp server的流程,学习差不多,千万不要去用哦!
首先要明白一见事:
ftp开启2个端口, 21命令端口, 20数据端口(不过一般这个你不知道)
我们发送dir, ls, get 等的时候 socket分别发送
port list, port nlst, port retr
这里以发送dir命令为例
前面的port就是20端口的开始,数据通道,
他先发一个port,然后服务器(这里是c(index))来连client的port发送的端口,
在s(index)返回s(Index).SendData "200 Port command successful" & vbCrLf
表示我连上你的数据端口了! 你想在想干什么??
然后client说,我没干嘛,不过想list一下而已..于是client发了一个list过去.
然后服务器告诉他, 可以给你拉, 于是s(Index).SendData "150 Opening ASCII mode data connection for /bin/ls" & vbCrLf
接着就开始传文件列表拉,当然他是通过数据通道(20port)传送的.
c(Index).SendData "-rw-r--r-- 1 ayoung user 1640 Aug 29 17:44 contact.gif" & vbCrLf <-- 呵呵,这里是假的.他写死了
传送完毕, 需要c(Index).close,告诉client,我把目录给你拉!
(注意,不同的ftp client判断不一样,有些是等待close,然后判断是否有226 xxxx,所以这里最好加这个)
然后告诉client, s(Index).SendData "226 Transfer complete" & vbCrLf, 刚刚我给你你文件内容
Top
