Quellcode
Hallo, hatte wenig Zeit gehabt! Aber hier ist jetzt der Quellcode.
Ich hoffe mir kann jemand helfen. Ich habe einige Teile entfernt. (Das lesen und speichern der Benutzerdaten aus der verschlüsselten Datei und die Auswerteroutine [Fehlerbehandlung]).
Deswegen sind auch die meisten Zeilen genummert, um genau den Ort zu bestimmen, falls ein Fehler auftritt!!!
Aber alle Grundlegenden Dinge wie Datentransfer sind enthalten.
Habe das Programm nach der RFT 959 geschrieben. Ein oder zwei Tipps von ActiveVB.de habe ich auch noch eingebaut.
'#######################
'Server… Startroutine!
'#######################
Public Function ServerStarten()
'Grundeinstellungen laden
Call GrundeinstellungenLaden
'Dieses Winsock-Objekt durchgehen alle Clienten, wenn sie sich einlogen.
HPT.KommandoSock(0).LocalPort = FTPDaten.Port
HPT.KommandoSock(0).Listen
End Function
'###########################
'Verbindung wird angefordert
'###########################
Private Sub KommandoSock_ConnectionRequest(Index As Integer, ByVal requestID As Long)
20 If Index = 0 Then
30 Call Status(„Eine Verbindung wird angefordert…“ & requestID, Index)
40 NeueVerbindung requestID
60 End If
70 Exit Sub
End Sub
'#########################
'Neue Verbindung erstellen
'#########################
Public Sub NeueVerbindung(ByVal requestID As Long)
Dim Socket As Integer
Dim objTmp As Variant
'Prüfe zuerst welches Winsock unbenutzt ist und erstelle dann
'ein neues Objekt
For Each objTmp In HPT.KommandoSock
If HPT.KommandoSock(objTmp.Index).State = sckClosed Then
If objTmp.Index 0 Then Socket = objTmp.Index
End If
Next
If Socket = 0 Then
Socket = HPT.KommandoSock.Count
Load HPT.KommandoSock(Socket) 'Erstelle neues Winsockinstance für den Verbundenen Clienten
Load HPT.DatenSock(Socket) 'Erstelle neues Datenwinsocketinstance für den CLienten
End If
HPT.KommandoSock(Socket).Accept requestID
'Sende Willkommen Meldung
SendeAntwortAnClient Socket, "220 Hallo und willkommen beim " & FTPDaten.Name & ". " & FTPDaten.WillkommenMeldung
End Sub
'###############################################
'WinSock Datentransfer (Kommandos und Argumente)
'###############################################
Private Sub KommandoSock_DataArrival(Index As Integer, ByVal totalBytes As Long)
10 On Error GoTo Fehler
20 Dim DatenVonSock As String
30 KommandoSock(Index).GetData DatenVonSock 'Empfange die Daten die der Client gesendet hat
40 Call VerarbeiteKommandos(Index, DatenVonSock) 'Verarbeite empfangene Daten
50 Client(Index).LetzteKommando = Now 'Setzte letzt Aktion auf Zeit = 0
60 Exit Sub
End Sub
'#####################################
'Verabeitet FTP-Kommandos vom Clienten
'#####################################
Public Function VerarbeiteKommandos(Socket As Integer, DatenVonSock As String)
Dim Data
Dim FtpKommando As String
Dim FtpArgumente As String
Data = Replace(DatenVonSock, vbCrLf, „“) 'Entferne die Zeichen ‚‚vbCrLf‘‘ aus dem empfangenen Packet
If InStr(Data, " ") = 0 Then
FtpKommando = Data 'Kommando enthält keine Argumente
Else
FtpKommando = Left(Data, (InStr(Data, " ") - 1)) 'Lese Kommandos heraus
FtpArgumente = Right(Data, (Len(Data) - InStr(Data, " "))) 'Lese Argumente heraus
End If
'Letze aktivität speichern
Client(Socket).LetzteKommando = Now
'Befehle und Argumente verarbeiten
Select Case UCase(FtpKommando)
Case „USER“
Case „PASS“
Case „PASV“
Case „TYPE“
Case „REST“
'Das aktuelle Arbeitsverzeichnis
Case „PWD“
'Wenn das aktuelle Arbeitsverzeichnis übermittelt wird, dann muss es
'in (") stehe, sonst wird es ignoriert.
SendeAntwortAnClient Socket, „257 " & Chr(34) & Client(Socket).aktServerVerzeichnis & Chr(34) & " ist das aktuelle Verzeichnis.“
Case „OPTS“
Case „SYST“
Case „SITE“
If UCase(FtpArgumente) = „HELP“ Then
End If
Case „SIZE“
Case „RNFR“
Case „RNTO“
Case „ALLO“
Case „CWD“
'Arbeitsverzeichnis wechseln
Dim ResultOrdner
ResultOrdner = VerzeichnisWechseln(Socket, FtpArgumente)
If ResultOrdner = 1 Then
SendeAntwortAnClient Socket, „250 In Verzeichnis ‚‘“ & Client(Socket).aktServerVerzeichnis & „’’ gewechselt.“
End If
If ResultOrdner = 0 Then
SendeAntwortAnClient Socket, „550 Verzeichnis nicht gefunden!“
End If
If ResultOrdner = -1 Then
SendeAntwortAnClient Socket, „550 Sie verfügen nicht über die nötigen Zugriffsrechte!“
End If
Case „PORT“
'Berechne den Remoteport zum Client
Dim tempArray1 As Variant
tempArray1 = Split(FtpArgumente, „,“)
Client(Socket).RemotePort = tempArray1(4) * 256 Or tempArray1(5)
SendeAntwortAnClient Socket, „200 Freigabe für Remoteport " & Client(Socket).RemotePort & " erfolgreich ausgeführt.“
Case „LIST“
SendeAntwortAnClient Socket, „150 Verzeichnis- und Dateiliste wird erstellt…“
Call SendeDaten(Socket, ErstelleVerzeichnisliste(Socket))
SendeAntwortAnClient Socket, „226 Datentransfer abgeschlossen.“
Case „STOR“
SendeAntwortAnClient Socket, „150 Empfange Datei.“
ÖffneDateiZumEmpfangen Socket, FtpArgumente
Case „RETR“
If ÖffneDateiZumSenden(Socket, FtpArgumente) = 1 Then
SendeAntwortAnClient Socket, "550 " & FtpArgumente & „: Fehler bei der Datenübertragung.“
End If
Case „NOOP“
Case „DELE“
Case „RMD“
Case „MKD“
Case Else
SendeAntwortAnClient Socket, „502 Der FTP-Server aktzeptiert diesen Befehl nicht! Kommando: Kommando: ->“ & FtpKommando & „“ & FtpArgumente & " 0 Then
30 If Client(Index).GesamteBytes = Client(Index).AktuelleBytes Then
40 DatenSock(Index).Close
50 Close #Client(Index).Dateinummer
60 SendeAntwortAnClient Index, „226 Datentransfer komplett.“
70 Call Status("–> 226 Datentransfer komplett.", 0)
80 Client(Index).AktuelleBytes = 0
90 Client(Index).GesamteBytes = 0
100 Client(Index).aktDatei = „“
110 Else
120 Call SendeDateiDaten(Index)
130 End If
140 End If
150 Exit Sub
End Sub
'###########
'Sende Datei
'###########
Public Sub SendeDateiDaten(Socket As Integer)
10 On Error GoTo fehler
20 Dim Data As String
30 Dim BlockSize As Integer
40 BlockSize = 1024 'immer 1 Kilobyte
50 If BlockSize > (Client(Socket).GesamteBytes - Client(Socket).AktuelleBytes) Then
60 BlockSize = (Client(Socket).GesamteBytes - Client(Socket).AktuelleBytes)
70 End If
80 Data = Space$(BlockSize) 'Speicher erstellen, für die 1kB Datenblöcke.
90 Get Client(Socket).Dateinummer, , Data 'Daten einlesen
100 Client(Socket).AktuelleBytes = Client(Socket).AktuelleBytes + BlockSize
110 HPT.DatenSock(Socket).SendData Data
120 Exit Sub
End Sub
'##########################
'Datenverbindung schliessen
'##########################
Private Sub DatenSock_Close(Index As Integer)
10 On Error GoTo fehler
20 Close #Client(Index).Dateinummer
30 DatenSock(Index).Close
32 Client(Index).AktuelleBytes = 0
34 Client(Index).GesamteBytes = 0
36 Client(Index).aktDatei = „“
'Melde dem Clienten, Datei erfolgreich übertragen
40 SendeAntwortAnClient Index, „226 Datentransfer komplett“
60 Exit Sub
End Sub
'##########################
'Öffne Datei für das senden
'##########################
Public Function ÖffneDateiZumSenden(Socket As Integer, Dateiname As String)
10 On Error GoTo fehler
20 Dim fso As New Scripting.FileSystemObject
30 If Len(Client(Socket).aktLokalVerzeichnis) = 4 Then
40 If fso.FileExists(Mid$(Client(Socket).aktLokalVerzeichnis, 1, 3) & Dateiname) = False Then
50 ÖffneDateiZumSenden = 1 'Datei existiert nicht
60 Exit Function
70 End If
80 Else
90 If fso.FileExists(Client(Socket).aktLokalVerzeichnis & Dateiname) = False Then
100 ÖffneDateiZumSenden = 1 'Datei existiert nicht
110 Exit Function
120 End If
130 End If
140 Set fso = Nothing
150 SendeAntwortAnClient Socket, „150 Verbinde im BINARY-Modus für die Dateiübertragung ‚‘“ & Dateiname & „’’. Sende Datei.“
170 Call ErstelleDatenverbindung(Socket)
180 If Len(Client(Socket).aktLokalVerzeichnis) = 4 Then
190 Client(Socket).aktDatei = Mid$(Client(Socket).aktLokalVerzeichnis, 1, 3) & Dateiname
200 Else
210 Client(Socket).aktDatei = Client(Socket).aktLokalVerzeichnis & Dateiname
220 End If
230 Client(Socket).GesamteBytes = FileLen(Client(Socket).aktDatei)
235 Client(Socket).AktuelleBytes = 0
240 Client(Socket).Dateinummer = FreeFile
250 Open (Client(Socket).aktDatei) For Binary Access Read As #Client(Socket).Dateinummer
260 DoEvents
270 SendeDateiDaten Socket
280 Exit Function
End Function
