From formular to function (1 Viewer)

[Nsane]

Hello guys!

I have recently been messing with a small piece of code that can send / recieve small text-strings over a network. I finally got it to work, but forgot to think ahead :banghead:. Right now it only works in a formular but i really need to be a function with input / output.

My problem is that i am using the "Withevents" to call the Ostrosoft Winsock network module and "Withevents" does not work in functions.

Do you guys have an idea on how to build this into a function ? Thanks!

Option Compare Database
Option Explicit
Dim sBuffer As String
Dim spage As String
Dim WithEvents wsTCP As OSWINSCK.Winsock

Private Sub cmdView_Click()
On Error GoTo ErrHandler

  Dim sServer As String
  Dim nPort As Long
  Dim Valg As Integer


  If Len(Me.ctlCPR) > 1 Then
        Valg = 1
    Else
        Valg = 2
    End If


  Select Case Valg
    Case 1
        If Len(Me.ctlCPR) < 10 Then
              MsgBox ("Indtast et gyldigt CPR-Nummer")
              spage = ""
              Exit Sub
        Else
              spage = ("    06                  PNR=" & ctlCPR)
        End If
    Case 2
        If Len(Me.ctlNavn) < 3 Or Len(Me.ctlFodDato) < 3 Then
              MsgBox ("Indtast et gyldigt navn og fødselsdato")
              spage = ""
              Exit Sub
        Else
              spage = ("    06                                  " & ctlNavn & "                                                    " & ctlFodDato)
        End If
    End Select
    
    HenttCPR (spage)

  Exit Sub

ErrHandler:
  MsgBox "Error " & Err.Number & ": " & Err.Description
End Sub

Public Function HenttCPR(Indhold As String) As String
    
    Dim sServer As String
    Dim nPort As Long
        
  nPort = 701
  sServer = "localhost"
  
  Set wsTCP = CreateObject("OSWINSCK.Winsock")
  wsTCP.Connect sServer, nPort
  
 End Function
 
Private Sub wsTCP_OnClose()
  wsTCP.CloseWinsock
End Sub

Private Sub wsTCP_OnConnect()
  wsTCP.sendData (spage)
End Sub

Private Sub wsTCP_OnDataArrival(ByVal bytesTotal As Long)
  Dim sBuffer1 As String
  wsTCP.GetData sBuffer
  
  
If Len(sBuffer) < 100 Then
    sBuffer = Mid(sBuffer, 34, 80)
    MsgBox (sBuffer)
Else
    txtForNavn = Mid(sBuffer, 359, 50)
    TxtEfterNavn = Mid(sBuffer, 409, 40)
    TxtAdresse = Mid(sBuffer, 245, 34)
    TxtBy = Mid(sBuffer, 317, 20)
    TxtPostNr = Mid(sBuffer, 313, 4)
    TxTKomKode = Mid(sBuffer, 338, 3)
    txtSource = sBuffer
End If
    
End Sub

Private Sub wsTCP_OnError(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)
  MsgBox Number & ": " & Description
End Sub

Private Sub wsTCP_OnStatusChanged(ByVal Status As String)
  Debug.Print Status
End Sub

 

[arnelgp]

you only need to re-structure your code there:

Private Sub cmdView_Click()

Call RunNewSub(Me.ctlCPR.Value, Me.ctlNavn.Value, Me.ctlFodDato.Value)

End Sub




'****************************************************
'* instruction:
'*
'* paste and transfer the code below to a new module
'*****************************************************

Option Compare Database
Option Explicit
Dim sBuffer As String
Dim spage As String
Dim WithEvents wsTCP As OSWINSCK.Winsock

Public Sub RunNewSub(ctlCPR As String, ctlNavn As String, ctlFodDato As String)
On Error GoTo ErrHandler

Dim sServer As String
Dim nPort As Long
Dim Valg As Integer


If Len(ctlCPR) > 1 Then
Valg = 1
Else
Valg = 2
End If

End If
Select Case Valg
Case 1
If Len(ctlCPR) < 10 Then
MsgBox ("Indtast et gyldigt CPR-Nummer")
spage = ""
Exit Sub
Else
spage = (" 06 PNR=" & ctlCPR)
End If
Case 2
If Len(ctlNavn) < 3 Or Len(ctlFodDato) < 3 Then
MsgBox ("Indtast et gyldigt navn og fødselsdato")
spage = ""
Exit Sub
Else
spage = (" 06 " & ctlNavn & " " & ctlFodDato)
End If
End Select

HenttCPR (spage)

Exit Sub

ErrHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
End Sub


Public Function HenttCPR(Indhold As String) As String

Dim sServer As String
Dim nPort As Long

nPort = 701
sServer = "localhost"

Set wsTCP = CreateObject("OSWINSCK.Winsock")
wsTCP.Connect sServer, nPort

End Function

Private Sub wsTCP_OnClose()
wsTCP.CloseWinsock
End Sub

Private Sub wsTCP_OnConnect()
wsTCP.sendData (spage)
End Sub

Private Sub wsTCP_OnDataArrival(ByVal bytesTotal As Long)
Dim sBuffer1 As String
wsTCP.GetData sBuffer


If Len(sBuffer) < 100 Then
sBuffer = Mid(sBuffer, 34, 80)
MsgBox (sBuffer)
Else
txtForNavn = Mid(sBuffer, 359, 50)
TxtEfterNavn = Mid(sBuffer, 409, 40)
TxtAdresse = Mid(sBuffer, 245, 34)
TxtBy = Mid(sBuffer, 317, 20)
TxtPostNr = Mid(sBuffer, 313, 4)
TxTKomKode = Mid(sBuffer, 338, 3)
txtSource = sBuffer
End If

End Sub

Private Sub wsTCP_OnError(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)
MsgBox Number & ": " & Description
End Sub

Private Sub wsTCP_OnStatusChanged(ByVal Status As String)
Debug.Print Status
End Sub

 

[Nsane]

Hi. I'm sorry, I messed up in the description.
I would like to build this into a function that can be called from the whole project. So I need it to be in a module. But WithEvents is not supported in modules.