[VB6] Web Server

[masmacer]

Sono riuscito a realizzare il server che tramite un array di socket gestisce le connessioni dei client.Ora dovrei realizzare un componente che gestisca la richiesta del client senza bloccare il server come posso fare? ho provato con un activexexe inserendo un timer potete vedere il codice qui http://it.briefcase.yahoo.com/masmacer progetti activexexe
Grazie un saluto a tutti.

[ddies]

a quel link io non vedo niente, vedo solo la cartella programmi che è vuota

[mhmh]

già,è vuota!

[Johnny_Depp]

Posta il codice

così magari capiamo tutti meglio qual'è il problema

[masmacer]

Il problema è il seguente:se mando in loop l'activex mi blocca il server mi è stato suggerito di usare un timer ma non capisco in che modo all'ultimo vi metto anche il codice per il client.
Codice del server EXE STANDARD

Dim intIndex As Integer ' Contatore dei socket aperti
Dim skClosedIndex() As Integer ' Array contenente gli indici dei socket chiusi per poterli riutilizzare
Dim skClosedCount As Integer ' Contatore dei socket chiusi
Dim myActivex As New Test.Main
Dim WithEvents mytemp As Test.temp

'Inizializzo il contatore dei socket chiusi
'Dimensiono l'array dei socket chiusi
'Imposto il primo elemento dell'array per capire che è vuoto
'Metto in ascolto il socket server
Private Sub Form_Load()

skClosedCount = 0
ReDim skClosedIndex(skClosedCount)
skClosedIndex(skClosedCount) = 888
wsMaster.Listen

End Sub

Private Sub mytemp_Processed(strResponse As String)

Debug.Print strResponse

End Sub

' Effettua la chiusura del socket con indice (index) e salva l'indice
' nell'array dei socket chiusi
Private Sub ws_Close(Index As Integer)
' On Error GoTo eh


'If Index <> 0 Then
ws(Index).Close
If Index <> 0 Then
Unload ws(Index)
End If
If skClosedCount = 0 Then 'Se il contatore dei socket chiusi è 0
skClosedIndex(skClosedCount) = Index 'assegno l'indice al primo elemento dell'array dei socket chiusi
Else 'altrimenti
ReDim Preserve skClosedIndex(skClosedCount) 'ridimensiono l'array conservando il contenuto
skClosedIndex(skClosedCount) = Index 'e assegno l'indice al nuovo elemento
End If
'If ws.UBound <> 1 Then
skClosedCount = skClosedCount + 1 'incremento il contatore dei socket chiusi
'End If
'eh:
' Dim lstr_ErrorDescription As String
' Dim lint_ErrorCode As Long
' Dim lstr_ErrorSource As String
'
' ' Resetto l'errore appena verificato.
' lint_ErrorCode = Err.Number
' lstr_ErrorDescription = "(Socket " & Index & " - State " & translateSckState(ws(Index + 1).State) & ") - Errore : "
' lstr_ErrorDescription = lstr_ErrorDescription & Err.Description
' lstr_ErrorSource = Err.Source + "(" + lstr_ProcedureName + ")"
' Call Err.Clear
' 'facendo così sollevi l'eccezione (altrimenti scrivi su un file di log)
' 'Err.Raise lint_ErrorCode, lstr_ErrorSource, lstr_ErrorDescription

End Sub

Private Sub ws_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim strData As String

ws(Index).GetData strData
'Set myActivex = New Test.Main

Set mytemp = myActivex.MTemp
'Set mytemp = New temp
DoEvents
myActivex.StartTest1 (strData)
'mytemp.pippo
Text1.Text = "DataArrival socket:" & Index & vbCrLf & Text1.Text & " " & strData


End Sub

' Gestisce la creazione di un nuovo socket o il riutilizzo di un socket chiuso
Private Sub wsMaster_ConnectionRequest(ByVal requestID As Long)

Text1.Text = "conn req " & wsMaster.RemotePort & vbCrLf & Text1.Text



' On Error GoTo eh

If skClosedIndex(UBound(skClosedIndex)) = 888 Then 'se l'array dei socket chiusi è vuoto
ws(intIndex).Accept requestID 'accetto la connessione sul primo elemento dell'array di socket
intIndex = intIndex + 1 'incremento il contatore dei socket aperti
Load ws(intIndex) 'carico il nuovo socket in attesa di una nuova richiesta
Else 'altrimenti
If ((skClosedCount - 1) <> 0) Or (skClosedIndex(skClosedCount - 1) <> 0) Then
Load ws(skClosedIndex(skClosedCount - 1))
End If
ws(skClosedIndex(skClosedCount - 1)).Accept requestID 'accetto la connessione con l'ultimo indice dell'array edi socket chiusi
If skClosedCount <> 0 Then 'se il contatore dei socket chiusi non è = 0
skClosedCount = skClosedCount - 1 'decremento il contatore dei socket chiusi
End If
ReDim Preserve skClosedIndex(skClosedCount) 'ridimensiono l'array dei socket chiusi troncando quello appena riutilizzato
If skClosedCount = 0 Then 'se non ci sono più socket chiusi disponibili
skClosedIndex(skClosedCount) = 888 'Imposto il primo elemento dell'array per capire che è vuoto
End If
End If

'eh:
' Dim lstr_ErrorDescription As String
' Dim lint_ErrorCode As Long
' Dim lstr_ErrorSource As String
'
' ' Resetto l'errore appena verificato.
' lint_ErrorCode = Err.Number
' lstr_ErrorDescription = "(Socket " & Index & " - State " & translateSckState(ws(Index).State) & ") - Errore : "
' lstr_ErrorDescription = lstr_ErrorDescription & lstr_ErrorDescription & Err.Description
' lstr_ErrorSource = Err.Source + "(" + lstr_ProcedureName + ")"
' Call Err.Clear
'facendo così sollevi l'eccezione (altrimenti scrivi su un file di log)
'Err.Raise lint_ErrorCode, lstr_ErrorSource, lstr_ErrorDescription

End Sub

Function translateSckState(lint_StateNumber As Integer) As String
Select Case lint_StateNumber
Case 0 'sckClosed
translateSckState = "Chiusa"
Case 1 'sckOpen
translateSckState = "Aperta"
Case 2 'sckListening
translateSckState = "In attesa"
Case 3 'sckConnectionPending
translateSckState = "In sospeso"
Case 4 'sckResolvingHost
translateSckState = "Risoluzione dell'host in corso"
Case 5 'sckHostResolved
translateSckState = "Host risolto"
Case 6 'sckConnecting
translateSckState = "In corso"
Case 7 'sckConnected
translateSckState = "Connesso"
Case 8 'sckClosing
translateSckState = "Il client sta chiudendo la connessione"
Case 9 'sckError
translateSckState = "Errore"
End Select
End Function

Codice dell'activexEXE
codice module1.bas
Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long

Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
Public lngTimerID As Long
Public MyTemp As temp
Public strDati As String

Sub TimerProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal idEvent As Long, _
ByVal dwTime As Long)



'RaiseEvent Processed("sfghadkfjgh")
' KillTimer 0, lngTimerID
' strDati = "ghjgkjhgkjghkjhgkhjg"
' MyTemp.pippo

End Sub

codice classe Main.cls
Public MTemp As temp
Dim BlnTimer As Boolean

Public Sub StartTest1(strID As String)
'Starts and stops the timer.
Dim h As Long
Dim idT As Long
Dim addr As Long

If BlnTimer = False Then
strDati = strID
lngTimerID = SetTimer(0, 0, 5000, AddressOf TimerProc)
'RaiseEvent Processed("sfghadkfjgh")
If lngTimerID = 0 Then
MsgBox "Timer not created. Ending Program"
Exit Sub
End If
BlnTimer = True
'Command1.Caption = "Stop Timer"
Else
lngTimerID = KillTimer(0, lngTimerID)

If lngTimerID = 0 Then
MsgBox "couldn't kill the timer"
End If
BlnTimer = False
'Command1.Caption = "Start Timer"
End If

End Sub


'Public Sub StartTest(strID As String)
'Dim h As Long
'Dim idT As Long
'Dim addr As Long
'
'idT = 1
' strDati = strID
' lngTimerID = SetTimer(0, 0, 5000, AddressOf TimerProc)
' Me.StartTest1
'
'
'End Sub

Private Sub Class_Initialize()
BlnTimer = False
Set MTemp = New temp
Set MyTemp = MTemp


End Sub

codice temp.cls
Public Event Processed(strResponse As String)
Public Function pippo()

RaiseEvent Processed(strDati)

End Function


CODICE PER IL CLIENT

Private Sub Command1_Click()
On Error Resume Next

'If ws1.State <> (sckConnected) Then
' ws1.RemoteHost = "172.16.5.20"
' ws1.RemotePort = 1001
' Text2.Text = ws1.RemoteHostIP
' ws1.Connect
' Command1.Caption = "Disconnect"
'Else
' ws1.Close
' Label2.Caption = "Disconnesso"
' Command1.Caption = "Connect"
'End If
'Text2.Text = ws1.RemoteHostIP
'If Text2.Text <> "" Then
' ws1.Close
' ws1.Connect Text2.Text, 1001
'
'Else
' MsgBox "server ip!!!!!!!!!!!!"
'
'End If
If ws1.State <> 0 Then ws1.Close
ws1.RemoteHost = "172.16.5.20"
ws1.RemotePort = 1001
Text2.Text = ws1.RemoteHostIP
ws1.Connect

End Sub

Private Sub Command2_Click()

ws1.SendData Text1.Text

End Sub

Private Sub Form_Unload(Cancel As Integer)

ws1.Close

End Sub

Private Sub ws1_Close()
Label2.Caption = " Not connected"
'Command1.Caption = "Connect"
End Sub

Private Sub ws1_Connect()

Command2.Enabled = True
Label2.Caption = "Connected to " & ws1.LocalHostName

Label3.Caption = ws1.LocalPort & " " & ws1.RemotePort



End Sub

Private Sub ws1_DataArrival(ByVal bytesTotal As Long)
Dim a As String
ws1.GetData a
Text3.Text = a & vbCrLf & Text3.Text


End Sub

Private Sub ws1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
'Err.Raise
MsgBox Description
Err = 0

End Sub

[sebamix]

La prossima volta usa i tag code e /code così viene indentato e più leggibile