Jump to content

SUBIECTE NOI
« 1 / 5 »
RSS
Jocuri Android Multiplayer online...

Diferenta consum smart meter - Co...

Recomandare demontare+instalare ...

CAIET SERVICE PREDEAL II
 Internare spital psihiatrie

CM de snooker 2024

Scot penele dupa montajul tamplar...

Masina de spalat vase si grasimea
 Noua lege de acces in paduri

Sunt ouale proaspete?

Aplicatie invatare limba Germana

Presbiopia - la 43 ani ?
 Termen transcriere autovehicul

Cazare Timisoara pe 4-5 zile

Primele zile ale internetului per...

Ditra 25
 

Probleme... nu stiu exact cu ce...

- - - - -
  • Please log in to reply
1 reply to this topic

#1
Blue Arrow

Blue Arrow

    New Member

  • Grup: Members
  • Posts: 11
  • Înscris: 05.11.2005
salwt, am o mare nelamururire.... lucrez la un program care, funtioneaza cam asa:
exista un server care asculta la portul 777, serverul trimite un msg, la care cel care incearca sa se logheze la el, iar respectivul trebuie sa raspunda cu un anumit raspuns, in cazul in care da un raspuns gresit trece la urmatoarea intrebare si daca nici la aceasta nu raspunde corect conexiunea ii va fi inchisa imediat, cel care tine serverul seteaza aceasta intrebare prin functia SPLIT dintr-un anume fisier care se va gasi unde se afla exe-ul prg-ului:


Dim text() as string
Dim text2() as string


'intrebare - RichTextBox
'raspuns - RichTextBox
'nr - TextBox


Sub Form_Load()

intrebare.LoadFile app.Path  & "\intrebare.txt"
raspuns.LoadFile app.Path & "\raspuns.txt"
tm.Interval=15000

End Sub





Sub cmd1_click()

text = Split(intrebare, vbCrLf, , vbTextCompare)
text2 = Split(raspuns, vbCrLf, , vbTextCompare)



End sub





Sub sock_DataArrival(ByVal bytesTotal as Long)

Dim data1 as String

sock.GetData data1

For i = 1 To Len(data1)

		If Mid(data1, i, Len(text2(nr))) = text2(nr) Then
					  
		 ws.SendData "[Security] Welcome user " & 'si aici nu stiu cum sa fac sa-i ia numele cu care se logheaza: ex: [ALIN].
	   
		   
		End If
Next

End Sub



Sub tm_Timer()

nr=nr+1
sock.SendData text(nr)

End Sub

Multzam anticipat.

P.S. Eroare este 'Subscript out of range' si imi gaseste un bug aici:   If Mid(data1, i, Len(text2(nr))) = text2(nr) Then

Edited by Blue Arrow, 20 November 2005 - 15:30.


#2
Master JeeKO

Master JeeKO

    New Member

  • Grup: Members
  • Posts: 2
  • Înscris: 20.11.2005
Dim USERS() As utilizator
Const MAX = 100
Const intr = "c:\intrebare.txt"
Const rasp = "c:\raspunsuri.txt"

Private Sub Form_Load()
sock(0).LocalPort = 7777
sock(0).Listen
ReDim USERS(0)
End Sub

Private Sub Form_Terminate()
For i = 0 To sock.Count
  sock(i).Close
Next i
End Sub

Private Sub Form_Unload(Cancel As Integer)
For i = 0 To sock.Count
  sock(i).Close
Next i
End Sub

Private Sub sock_ConnectionRequest(Index As Integer, ByVal requestID As Long)
If sock.Count < MAX Then
    n = sock.Count + 1
    Load sock(n)
    If sock(n).State <> sckClosed Then sock(n).Close
    sock(n).Accept requestID
    sock(n).SendData "!user <myuser>" & vbCrLf
Else
    sock(0).Accept requestID
    sock(0).SendData "Server full try later .. " & vbCrLf
End If
End Sub

Private Sub sock_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim MyData As String
sock(Index).GetData MyData
MyData = Mid(MyData, 1, Len(MyData) - 2) ' scadem chr(10) & chr(13) = vbcrlf-ul :D
Select Case rets(MyData)
  Case "!user":
      n = UBound(USERS) + 1
      ReDim Preserve USERS(n)
      USERS(n).nick = retf(MyData)
      USERS(n).ip = sock(Index).RemoteHostIP
      USERS(n).nr = 0 ' a gresit 0 intrebari
      USERS(0).points = 0
      USERS(n).start = False
      sock(Index).SendData "[System] Welcome " & USERS(n).nick & ", your ip is: " & USERS(n).ip & vbCrLf
      sock(Index).SendData "[System] Now you can start the game with !start" & vbCrLf
  Case "!start":
      sock(Index).SendData "[System] Question: " & AskQuestion(intr, 1) & vbCrLf
      sock(Index).SendData "[System] To response type !re <answer>" & vbCrLf
      
      For i = 1 To UBound(USERS)
         If USERS(i).ip = sock(Index).RemoteHostIP Then k = i   'caut ce index are useru care tocmai a primit intrebarea
      Next i                                                    ' ptr a verifica corectitudinea raspunsului lui
      USERS(k).nrintr = 0
  Case "!re":
      For i = 1 To UBound(USERS)
         If USERS(i).ip = sock(Index).RemoteHostIP Then k = i
      Next i
      If rets(retf(MyData)) = LoadAnswer(rasp, USERS(k).nrintr) Then
            USERS(k).points = USERS(k).points + 1
            sock(Index).SendData "[System] Type !next to go to the next question" & vbCrLf
      Else
            USERS(k).nr = USERS(k).nr + 1
      End If
      
      If USERS(k).nr >= 3 Then sock(Index).SendData "[System] disconnect, to many wrong answers :( " & vbCrLf
  Case "!next":
      For i = 1 To UBound(USERS)
         If USERS(i).ip = sock(Index).RemoteHostIP Then k = i
      Next i
      USERS(k).nrintr = USERS(k).nrintr + 1
      sock(Index).SendData "[System] Question: " & AskQuestion(intr, USERS(k).nrintr) & vbCrLf
      sock(Index).SendData "[System] To response type !re <answer>" & vbCrLf
      sock(Index).SendData "[System] .. or !quit to disconnect" & vbCrLf
   Case "!quit":
      For i = 1 To UBound(USERS)
         If USERS(i).ip = sock(Index).RemoteHostIP Then k = i
      Next i
      sock(Index).SendData "[System] Goodbye " & USERS(k).nick & ", your points : " & USERS(k).points & vbCrLf
      sock(Index).Close
End Select
End Sub





Function AskQuestion(ByVal cfile As String, ByVal line As Integer) As String
k = 0
If Dir(cfile) <> "" Then   ' is cfile exist
     Open cfile For Input As #1
       While Not EOF(1)
           Line Input #1, temp
           k = k + 1
           If k = line Then
                 ret = line
           End If
       Wend
     Close #1
End If
AskQuestion = ret
End Function

Function LoadAnswer(ByVal cfile As String, ByVal line As Integer) As String
If Dir(cfile) <> "" Then   ' is cfile exist
     Open cfile For Input As #1
       While Not EOF(1)
           Line Input #1, temp
           k = k + 1
           If k = line Then
                 ret = line
           End If
       Wend
     Close #1
End If
LoadAnswer = ret
End Function













si inca un modul:
Type utilizator
   nick As String ' nick/id
   ip As String 'ip
   nr As Integer ' de cateori a gresit
   points As Integer 'punctaj
   start As Boolean
   nrintr As Integer
End Type


'############################################################################
#####
Public Function rets(s As String) As String
s = s + " "
For i = 1 To Len(s)
   If Mid(s, i, 1) = " " Then
     rets = Mid(s, 1, i - 1)
     Exit Function
   End If
Next
End Function
'############################################################################
#####
Public Function retf(s As String) As String
s = s + " "
For i = 1 To Len(s)
   If Mid(s, i, 1) = " " Then
      retf = Trim(Mid(s, i + 1))
      Exit Function
   End If
Next
End Function
'############################################################################
#####




eu zic ca asta te-ar putea ajuta ..  dak vrei sa vb cu mine 0729 00 18 13 sau [email protected]

Attached Files


Edited by Master JeeKO, 21 November 2005 - 00:58.


Anunturi

Second Opinion Second Opinion

Folosind serviciul second opinion ne puteți trimite RMN-uri, CT -uri, angiografii, fișiere .pdf, documente medicale.

Astfel vă vom putea da o opinie neurochirurgicală, fără ca aceasta să poată înlocui un consult de specialitate. Răspunsurile vor fi date prin e-mail în cel mai scurt timp posibil (de obicei în mai putin de 24 de ore, dar nu mai mult de 48 de ore). Second opinion – Neurohope este un serviciu gratuit.

www.neurohope.ro

0 user(s) are reading this topic

0 members, 0 guests, 0 anonymous users

Forumul Softpedia foloseste "cookies" pentru a imbunatati experienta utilizatorilor Accept
Pentru detalii si optiuni legate de cookies si datele personale, consultati Politica de utilizare cookies si Politica de confidentialitate