- '*************************************************************************
- ' TRUERND - Obtenir de VRAIs nombres aléatoire grâce au service random.org
- '
- ' NECESSITE UNE CONNEXION INTERNET
- '
- 'Auteur : Egyde (sendoval_fr@yahoo.fr)
- 'Date de création : 28/02/06
- '*************************************************************************
-
- Option Explicit
-
- Private strmem As String
- Private truernd() As String
-
- Private Sub Command1_Click()
- 'on se connecte à Random.org
- Winsock1.Close
- Text1.Text = ""
- Winsock1.Connect "random.org", 80
- End Sub
-
- Private Sub Winsock1_Connect()
-
- Dim cmd As String
-
- 'raz du buffer de réception
- strmem = ""
-
- 'on formate la requête
- cmd = "GET /cgi-bin/randnum?num=" & txtTotalNb.Text & "&min=" & txtSmallest.Text & "&max=" & txtLargest.Text & "&col=1" & vbCrLf & _
- "Accept: text" & vbCrLf & _
- "Referer: http://www.random.org" & vbCrLf & _
- "Host: www.random.org"
-
- 'note : le contenu des textbox devrait être vérifiés mais bon...
-
- 'envoi de la requête
- Winsock1.SendData cmd
-
- End Sub
-
- Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
-
- Dim Buffer As String
- Dim Reconnect As Boolean
-
- Winsock1.GetData Buffer
-
- strmem = strmem & Buffer
-
- If IsAllReceived Then
- truernd = Split(strmem, vbLf) ' à convertir en Double éventuellement
- Text1.Text = Replace(strmem, vbLf, vbCrLf)
- strmem = ""
- Winsock1.Close
- End If
-
- End Sub
-
- 'fonction qui retourne vrai ssi on a reçu tous les nombres aléatoires
- Private Function IsAllReceived() As Boolean
-
- Dim i As Long
- Dim nboccur As Long
-
- 'chaque nombre retourné par random.org est séparé par le caractère
- 'VbLf. Pour déterminer si la page a été reçu dans son intégralité,
- 'on compte simplement le nb d'occurence de ce caractères.
- i = 1
- nboccur = 0
- While InStr(i, strmem, vbLf) > 0
- nboccur = nboccur + 1
- i = InStr(i, strmem, vbLf) + 1
- Wend
- If nboccur = CLng(txtTotalNb.Text) Then
- IsAllReceived = True
- End If
-
- End Function
'*************************************************************************
' TRUERND - Obtenir de VRAIs nombres aléatoire grâce au service random.org
'
' NECESSITE UNE CONNEXION INTERNET
'
'Auteur : Egyde (sendoval_fr@yahoo.fr)
'Date de création : 28/02/06
'*************************************************************************
Option Explicit
Private strmem As String
Private truernd() As String
Private Sub Command1_Click()
'on se connecte à Random.org
Winsock1.Close
Text1.Text = ""
Winsock1.Connect "random.org", 80
End Sub
Private Sub Winsock1_Connect()
Dim cmd As String
'raz du buffer de réception
strmem = ""
'on formate la requête
cmd = "GET /cgi-bin/randnum?num=" & txtTotalNb.Text & "&min=" & txtSmallest.Text & "&max=" & txtLargest.Text & "&col=1" & vbCrLf & _
"Accept: text" & vbCrLf & _
"Referer: http://www.random.org" & vbCrLf & _
"Host: www.random.org"
'note : le contenu des textbox devrait être vérifiés mais bon...
'envoi de la requête
Winsock1.SendData cmd
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim Buffer As String
Dim Reconnect As Boolean
Winsock1.GetData Buffer
strmem = strmem & Buffer
If IsAllReceived Then
truernd = Split(strmem, vbLf) ' à convertir en Double éventuellement
Text1.Text = Replace(strmem, vbLf, vbCrLf)
strmem = ""
Winsock1.Close
End If
End Sub
'fonction qui retourne vrai ssi on a reçu tous les nombres aléatoires
Private Function IsAllReceived() As Boolean
Dim i As Long
Dim nboccur As Long
'chaque nombre retourné par random.org est séparé par le caractère
'VbLf. Pour déterminer si la page a été reçu dans son intégralité,
'on compte simplement le nb d'occurence de ce caractères.
i = 1
nboccur = 0
While InStr(i, strmem, vbLf) > 0
nboccur = nboccur + 1
i = InStr(i, strmem, vbLf) + 1
Wend
If nboccur = CLng(txtTotalNb.Text) Then
IsAllReceived = True
End If
End Function