Visualizzazione dei risultati da 1 a 6 su 6

Discussione: [VB6] Web Server

  1. #1

    Sto realizzando un server web mi occorre aiuto

    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.

  2. #2
    Utente di HTML.it
    Registrato dal
    Oct 2002
    Messaggi
    327
    a quel link io non vedo niente, vedo solo la cartella programmi che è vuota

  3. #3
    Utente di HTML.it L'avatar di mhmh
    Registrato dal
    Feb 2002
    Messaggi
    204
    già,è vuota!

  4. #4
    Posta il codice

    così magari capiamo tutti meglio qual'è il problema
    ...Terrible warlords, good warlords, and an english song

  5. #5

    [VB6]Server web

    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


  6. #6
    Utente di HTML.it L'avatar di sebamix
    Registrato dal
    Aug 2000
    Messaggi
    1,028
    La prossima volta usa i tag code e /code così viene indentato e più leggibile


Permessi di invio

  • Non puoi inserire discussioni
  • Non puoi inserire repliche
  • Non puoi inserire allegati
  • Non puoi modificare i tuoi messaggi
  •  
Powered by vBulletin® Version 4.2.1
Copyright © 2024 vBulletin Solutions, Inc. All rights reserved.