Acettare Id Tramite Autenticazione

[djcuca]

salve ho un problema in vb cm sapete nn lo conosco bene cmq...
ho fatto un prog di file transfer tra due pc..
praticamente vorrei che il server quando ha la richiesta di connessione del client, accetta solo tramite un nome utente e password che il client deve dare...
cm devo fare?

[bsummer]

Un modo molto semplice è...una volta accettata la connessione il programma che funge da server attende dei dati...i primi, che so, 32 byte rappresentano user è password dell'utente connesso. Li verifica e se sono ok, bene, altrimenti chiude la connessione...

Ho fatto anch'io recentemente un programma di questo tipo (scambio file tra 2 pc)...puoi dirmi che funzionalità hai inserito?

Aloha!

[djcuca]

potresti darmi una mano per fare quello ke hai detto?

questo è il client:

Option Explicit

Dim buffer() As Byte
Dim lBytes As Long
Dim temp As String

Private Sub cmdBrowse_Click()
dlg.ShowOpen
txtFile = dlg.FileName
End Sub

Private Sub cmdSend_Click()
cmdSend.Enabled = False
lBytes = 0
ReDim buffer(FileLen(dlg.FileName) - 1)
Open dlg.FileName For Binary As 1
Get #1, 1, buffer
Close #1
Load wsTCP(1)
wsTCP(1).RemoteHost = txtIP
wsTCP(1).RemotePort = 999
wsTCP(1).Connect
lblStatus = "Connecting..."
End Sub



Private Sub wsTCP_Close(Index As Integer)
lblStatus = "Connection closed"
Unload wsTCP(1)
End Sub

Private Sub wsTCP_Connect(Index As Integer)
lblStatus = "Connected"

wsTCP(1).SendData dlg.FileTitle & vbCrLf
End Sub

Private Sub wsTCP_DataArrival(Index As Integer, ByVal bytesTotal As Long)
wsTCP(1).GetData temp
If InStr(temp, vbCrLf) <> 0 Then temp = Left(temp, InStr(temp, vbCrLf) - 1)
If temp = "OK" Then
wsTCP(1).SendData buffer
Else
lblStatus = "Something wrong"
Unload wsTCP(1)
cmdSend.Enabled = True
End If
End Sub

Private Sub wsTCP_SendComplete(Index As Integer)
If temp = "OK" Then
lblStatus = "Send complete"
temp = ""
Unload wsTCP(1)
cmdSend.Enabled = True
End If
End Sub

Private Sub wsTCP_SendProgress(Index As Integer, ByVal bytesSent As Long, ByVal bytesRemaining As Long)
If temp = "OK" Then
lBytes = lBytes + bytesSent
lblStatus = lBytes & " out of " & UBound(buffer) & " bytes sent"
End If
End Sub

e questo è il server:


Option Explicit

Dim lPos As Long
Dim bOK As Boolean
Dim fname As String

Private Sub cmdRun_Click()
If cmdRun.Caption = "Run" Then
cmdRun.Caption = "Stop"
wsTCP(0).LocalPort = 999
wsTCP(0).Listen
Else
wsTCP(0).Close
cmdRun.Caption = "Run"
End If
End Sub

Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive & "\"
End Sub




Private Sub wsTCP_Close(Index As Integer)
Close #1
Unload wsTCP(1)
bOK = False
End Sub

Private Sub wsTCP_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Load wsTCP(1)
wsTCP(1).Accept requestID
lblip = wsTCP(0).RemoteHostIP
lblhost = wsTCP(0).RemoteHost
End Sub

Private Sub wsTCP_DataArrival(Index As Integer, ByVal bytesTotal As Long)
If Not bOK Then
wsTCP(1).GetData fname
If InStr(fname, vbCrLf) <> 0 Then fname = Left(fname, InStr(fname, vbCrLf) - 1)
bOK = True
If Dir(Dir1.Path & "\" & fname) <> "" Then Kill Dir1.Path & "\" & fname
Open Dir1.Path & "\" & fname For Binary As 1
lPos = 1
wsTCP(1).SendData "OK" & vbCrLf
Else
Dim buffer() As Byte
wsTCP(1).GetData buffer
Put #1, lPos, buffer
lPos = lPos + UBound(buffer) + 1
End If
End Sub


grazie

[bsummer]

Più che editare il tuo codice preferisco farti un esempio.

Definiamo un tipo di dati enumerativo:

Private Enum LoginState
	verifyLogin = 0
	clientConnected = 1
	waitForConnect = 2
End Enum

e definiamo pure una variabile globale

dim serverState as LoginState

Quando inizializzi il server poni

serverState = waitForConnect

Quando nel server hai l'evento ConnectionRequest, all'interno di tale procedura fai l'assegnazione :

serverState = verifyLogin

Ed eccoci al cuore di tutto, la procedura dell'evento DataArrival

Private Sub WinSock1_DataArrival(ByVal bytesTotal As Long)

	dim MyData

	with WinSock1
	select case serverState
		case verifylogin:
			if . BytesReceived < 32 then exit sub
			.GetData MyData, vbArray + vbByte, 32
			if checkLogin(MyData) = false then 
				.close
				serverState= waitForConnect
			else
				serverState= clientConnected
			end if

		case ClientConnected:
			.GetData MyData
			call useData(MyData)
		
	end select
	end with
End Sub

Private function checkLogin(MyData() as byte) as boolean
	' fai un controllo che i primi 16 byte corrispondano ad un nome di login conosciuto
	' e che i 16 byte successivi siano la password ad esso associata. Naturalmente puoi usare
	' anche meno bytes, che so, 16, 8 per la login e 8 per la passw. Se c'è un riscontro
	' positivo restituisci true, altrimenti false
end function

Private sub useData(myData)
	' Quando sei connesso utilizza i dati come meglio credi ;)
end Sub

Il tutto è molto semplice. All'inizio poni lo stato del server come non connesso ad alcun client. Quando un client chiede la connessione il server subito l'accetta, e passa il suo stato in verifica login...Qui attende i primi 32 bytes (ma puoi scegliere benissimo tu il formato della login/password) e appena li riceve (infatti nel caso arrivino meno di 32 byte la procedura termina senza fare nulla) chiama una funzione apposita (che dovrai crearti) che controlla se l'utente è tra quelli noti. Se si allora il server passa in modalità di trasferimento dati normale, se no il server chiude la connessione e ne attende una nuova.

Aloha!