Newsgroup: it.comp.lang.visual-basic
Titolo: [LUNGHETTO] Problemi di caduta rete...

Ciao a tutti. Espongo il mio problema:
Il mio programma deve accedere ad un database ( ACCESS ) residente su di un
server ogni circa 10 secondi. Prima di accedere a tale DB faccio una
verifica se il DB è accessibile, tramite la seguente funzione:
Public Function TestDatabase() As Boolean
   Dim nFile As Long
   Dim PathDBRifaRemoto As String
   PathDBRifaRemoto = Param.Stringa("PercorsoServer") &
Param.Stringa("NomeMacchina") & "\DBRifa.mdb"
   If Not FileExists(PathDBRifaRemoto) Then
      Messaggio True, "Connessione al server in corso", "Attendere qualche
secondo..."
      TestDatabase = False
      Exit Function
   Else
      AdoCommesseRemoto.ConnectionString
="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
PathDBRifaRemoto & ";Persist Security Info=False"
      AdoCommesseRemoto.CommandType = adCmdTable
      AdoCommesseRemoto.RecordSource = "Commesse"
      AdoCommesseRemoto.Refresh
      Messaggio False
      TestDatabase = True
   End If
End Function
(
FileExists è una funzione che testa l'esistenza del file:
Public Function FileExists(ByVal a_FullPathName As String) As Boolean
    If (Len(a_FullPathName) = 0) Then Exit Function
    Dim hFile As Long, wfd As WIN32_FIND_DATA
    hFile = FindFirstFile(a_FullPathName, wfd)
    If (hFile = INVALID_HANDLE) Then Exit Function
    FindClose (hFile)
    FileExists = True
End Function
mentre messaggio mi visualizza semplicemente un form con un avviso:
Public Sub Messaggio(Mostra As Boolean, Optional Titolo As String, Optional
Descrizione As String)
On Error GoTo HELL
   If Mostra = True Then
      FormMsg.LabelTitolo = Titolo
      FormMsg.LabelDescrizione = Descrizione
      If FormMsg.Visible = False Then
         FormMsg.Show
      End If
   Else
      If FormMsg.Visible = True Then
         FormMsg.Hide
      End If
   End If
HELL:
End Sub
)
Il problema è questo:
Se la rete cade, la funzione TestDatabase mi ritorna FALSO come dovrebbe
essere, ed evito quindi di effettuare operazioni sul DB.
Se la rete si ripristina, L'INTERO PROGRAMMA ( e sembra anche il pc ) si
blocca per un tempo X ( da circa 20 secondi a 2 minuti) e poi riparte.
Alcune volte, dopo il tempo X, il progr. si blocca con un errore del tipo
"Errore Di Rete O Disco", tanto che devo terminare l'applicazione dal Task
Manager di win.
A questo punto chiedo:
 - Per testare lo stato della rete è giusto andare a verificare se un dato
file esiste?
 - O c'è qualche altro metodo ( tipo API ) per testare lo stato della rete
( Abilitata/Disabilitata)?
 - Perchè quando la rete viene ripristinata il programma ( e anche il pc )
si blocca? ( Noto questo fenomeno anche quando tento di accedere ad un file
in rete con
   esplora risorse )
N.B. La rete sotto accusa è una wireless, e cade abbastanza spesso.
Vi ringrazio per l'attenzione che mi avete dedicato, e mi scuso ancora della
lunghezza del post.
Ciao. Roby.

Se il problema è solamente quello di testare la connessione e il
protocollo utilizzato è il tcp/ip puoi, invece del controllo
dell'esistenza del file, eseguire un ping all'indirizzo della macchina che
ti interessa.
Questa soluzione, quanto meno, evita che il sistema operativo ti
restituisca il messaggio "Errore di rete o disco" in fase di verifica
della disponibilità della risorsa.
Certo, questo, non può garantirti che, una volta connesso al db remoto la
linea rimanga stabile.
Ti invio il codice per eseguire il PING da Vb
Ciao ;)
'Inizio Codice -----------------------------------------------------------
Option Compare Database
Option Explicit
Private Const IP_SUCCESS                As Long = 0
Private Const IP_STATUS_BASE            As Long = 11000
Private Const IP_BUF_TOO_SMALL          As Long = (11000 + 1)
Private Const IP_DEST_NET_UNREACHABLE   As Long = (11000 + 2)
Private Const IP_DEST_HOST_UNREACHABLE  As Long = (11000 + 3)
Private Const IP_DEST_PROT_UNREACHABLE  As Long = (11000 + 4)
Private Const IP_DEST_PORT_UNREACHABLE  As Long = (11000 + 5)
Private Const IP_NO_RESOURCES           As Long = (11000 + 6)
Private Const IP_BAD_OPTION             As Long = (11000 + 7)
Private Const IP_HW_ERROR               As Long = (11000 + 8)
Private Const IP_PACKET_TOO_BIG         As Long = (11000 + 9)
Private Const IP_REQ_TIMED_OUT          As Long = (11000 + 10)
Private Const IP_BAD_REQ                As Long = (11000 + 11)
Private Const IP_BAD_ROUTE              As Long = (11000 + 12)
Private Const IP_TTL_EXPIRED_TRANSIT    As Long = (11000 + 13)
Private Const IP_TTL_EXPIRED_REASSEM    As Long = (11000 + 14)
Private Const IP_PARAM_PROBLEM          As Long = (11000 + 15)
Private Const IP_SOURCE_QUENCH          As Long = (11000 + 16)
Private Const IP_OPTION_TOO_BIG         As Long = (11000 + 17)
Private Const IP_BAD_DESTINATION        As Long = (11000 + 18)
Private Const IP_ADDR_DELETED           As Long = (11000 + 19)
Private Const IP_SPEC_MTU_CHANGE        As Long = (11000 + 20)
Private Const IP_MTU_CHANGE             As Long = (11000 + 21)
Private Const IP_UNLOAD                 As Long = (11000 + 22)
Private Const IP_ADDR_ADDED             As Long = (11000 + 23)
Private Const IP_GENERAL_FAILURE        As Long = (11000 + 50)
Private Const MAX_IP_STATUS             As Long = (11000 + 50)
Private Const IP_PENDING                As Long = (11000 + 255)
Private Const PING_TIMEOUT              As Long = 500
Private Const WS_VERSION_REQD           As Long = &H101
Private Const MIN_SOCKETS_REQD          As Long = 1
Private Const SOCKET_ERROR              As Long = -1
Private Const INADDR_NONE               As Long = &HFFFFFFFF
Private Const MAX_WSADescription        As Long = 256
Private Const MAX_WSASYSStatus          As Long = 128
Private Type ICMP_OPTIONS
    Ttl             As Byte
    Tos             As Byte
    Flags           As Byte
    OptionsSize     As Byte
    OptionsData     As Long
End Type
Public Type ICMP_ECHO_REPLY
    Address         As Long
    Status          As Long
    RoundTripTime   As Long
    DataSize        As Long 'formerly integer
   'Reserved        As Integer
    DataPointer     As Long
    Options         As ICMP_OPTIONS
    DATA            As String * 250
End Type
Private Type WSADATA
   wVersion                                 As Integer
   wHighVersion                             As Integer
   szDescription(0 To MAX_WSADescription)   As Byte
   szSystemStatus(0 To MAX_WSASYSStatus)    As Byte
   wMaxSockets                              As Long
   wMaxUDPDG                                As Long
   dwVendorInfo As Long
End Type
Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
Private Declare Function IcmpCloseHandle Lib "icmp.dll" _
   (ByVal IcmpHandle As Long) As Long
 
Private Declare Function IcmpSendEcho Lib "icmp.dll" _
   (ByVal IcmpHandle As Long, _
    ByVal DestinationAddress As Long, _
    ByVal RequestData As String, _
    ByVal RequestSize As Long, _
    ByVal RequestOptions As Long, _
    ReplyBuffer As ICMP_ECHO_REPLY, _
    ByVal ReplySize As Long, _
    ByVal Timeout As Long) As Long
 
Private Declare Function WSAGetLastError Lib "wsock32" () As Long
Private Declare Function WSAStartup Lib "wsock32" _
   (ByVal wVersionRequired As Long, _
    lpWSADATA As WSADATA) As Long
 
Private Declare Function WSACleanup Lib "wsock32" () As Long
Private Declare Function gethostname Lib "wsock32" _
   (ByVal szHost As String, _
    ByVal dwHostLen As Long) As Long
 
Private Declare Function gethostbyname Lib "wsock32" _
   (ByVal szHost As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (xDest As Any, _
   xSource As Any, _
   ByVal nbytes As Long)
 
Private Declare Function inet_addr Lib "wsock32" _
   (ByVal s As String) As Long
 
Public Function GetStatusCode(Status As Long) As String
   Dim msg As String
 
   Select Case Status
      Case IP_SUCCESS:               msg = "ip success"
      Case INADDR_NONE:              msg = "inet_addr: bad IP format"
      Case IP_BUF_TOO_SMALL:         msg = "ip buf too_small"
      Case IP_DEST_NET_UNREACHABLE:  msg = "ip dest net unreachable"
      Case IP_DEST_HOST_UNREACHABLE: msg = "ip dest host unreachable"
      Case IP_DEST_PROT_UNREACHABLE: msg = "ip dest prot unreachable"
      Case IP_DEST_PORT_UNREACHABLE: msg = "ip dest port unreachable"
      Case IP_NO_RESOURCES:          msg = "ip no resources"
      Case IP_BAD_OPTION:            msg = "ip bad option"
      Case IP_HW_ERROR:              msg = "ip hw_error"
      Case IP_PACKET_TOO_BIG:        msg = "ip packet too_big"
      Case IP_REQ_TIMED_OUT:         msg = "ip req timed out"
      Case IP_BAD_REQ:               msg = "ip bad req"
      Case IP_BAD_ROUTE:             msg = "ip bad route"
      Case IP_TTL_EXPIRED_TRANSIT:   msg = "ip ttl expired transit"
      Case IP_TTL_EXPIRED_REASSEM:   msg = "ip ttl expired reassem"
      Case IP_PARAM_PROBLEM:         msg = "ip param_problem"
      Case IP_SOURCE_QUENCH:         msg = "ip source quench"
      Case IP_OPTION_TOO_BIG:        msg = "ip option too_big"
      Case IP_BAD_DESTINATION:       msg = "ip bad destination"
      Case IP_ADDR_DELETED:          msg = "ip addr deleted"
      Case IP_SPEC_MTU_CHANGE:       msg = "ip spec mtu change"
      Case IP_MTU_CHANGE:            msg = "ip mtu_change"
      Case IP_UNLOAD:                msg = "ip unload"
      Case IP_ADDR_ADDED:            msg = "ip addr added"
      Case IP_GENERAL_FAILURE:       msg = "ip general failure"
      Case IP_PENDING:               msg = "ip pending"
      Case PING_TIMEOUT:             msg = "ping timeout"
      Case Else:                     msg = "unknown  msg returned"
   End Select
 
   GetStatusCode = CStr(Status) & "   [ " & msg & " ]"
 
End Function
Public Function Ping(sAddress As String, _
                     sDataToSend As String, _
                     ECHO As ICMP_ECHO_REPLY) As Long
  'If Ping succeeds :
  '.RoundTripTime = time in ms for the ping to complete,
  '.Data is the data returned (NULL terminated)
  '.Address is the Ip address that actually replied
  '.DataSize is the size of the string in .Data
  '.Status will be 0
  '
  'If Ping fails .Status will be the error code
 
   Dim hPort        As Long
   Dim dwAddress    As Long
 
  'convert the address into a long representation
   dwAddress = inet_addr(sAddress)
 
  'if a valid address..
   If dwAddress <> INADDR_NONE Then
 
     'open a port
      hPort = IcmpCreateFile()
 
     'and if successful,
      If hPort Then
 
        'ping it.
         Call IcmpSendEcho(hPort, _
                           dwAddress, _
                           sDataToSend, _
                           Len(sDataToSend), _
                           0, _
                           ECHO, _
                           Len(ECHO), _
                           PING_TIMEOUT)
        'return the status as ping succes and close
         Ping = ECHO.Status
         Call IcmpCloseHandle(hPort)
 
      End If
 
   Else:
        'the address format was probably invalid
         Ping = INADDR_NONE
 
   End If
 
End Function
 
Public Sub SocketsCleanup()
 
   If WSACleanup() <> 0 Then
       MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
   End If
 
End Sub
Public Function SocketsInitialize() As Boolean
   Dim WSAD     As WSADATA
 
   SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
 
End Function
Public Function TestConnection() As Boolean
Dim ECHO    As ICMP_ECHO_REPLY
Dim success As Long
 
   If SocketsInitialize() Then
 
     'ping the ip passing the address, text to send, and the ECHO
structure.
      success = Ping(IniInf.IFXip, "echo this", ECHO)
 
      If success = 0 Then
 
        TestConnection = True
 
      Else
 
        TestConnection = False
 
      End If
 
      SocketsCleanup
 
   Else
 
      MsgBox "Windows Sockets for 32 bit Windows " & _
             "environments is not successfully responding."
 
   End If
End Function
'Fine Codice -------------------------------------------------------------
-- 
-------------------------------------
[F] Freestyler
-------------------------------------
Legge di Osborn:
Le variabili non mutano mai,
le costanti sì !!!
questo articolo e` stato inviato via web dal servizio gratuito 
http://www.newsland.it/news
 segnala gli abusi ad 
ab...@newsland.it

 ( Abilitata/Disabilitata)?
Puoi usare questo per testare lo stato della rete:
http://vbnet.mvps.org/index.html?code/network/isnetworkalive.htm
	maxx
-- 
NOSPAM: Rimuovere i trattini dallo username!
Cut hyphens from my username!

 ha scritto nel messaggio
news:356ljeF...@individual.net...
