GetHostName - HELP! (Winsock problem)

b1be · Post by **b1be** » Sun Mar 05, 2006 2:33 pm

WinsockFunctions.pb

Code: Select all

Declare AcceptConnection(sck)
Declare AssignSocketIndex()
Declare CheckHostType(host$)
Declare CloseSocket(sck.l)
Declare ConnectTask(sck)
Declare ConnectTCP(host$,port.l,thrRes)
Declare CreateSocket(ProtocolType.l)
Declare FindSocketIndex(sck)
Declare.s GetHostName(h$)
Declare InitWinsock()
Declare InitUDP(localport.l)
Declare ListenTCP(Port.l)
Declare ProcessWinsockEvents()
Declare RefuseConnection(sck)
Declare RetrieveData(sck,strAddr,sckidx)
Declare SendTCP(sck.l,strAddr,Lenght.l)
Declare SendUDP(sck,strAddr,lenght.l,remotehost.s,remoteport.l)
Declare TerminateWinsock()
Declare wMessages(WindowID, Message, wParam, lParam)

Structure IPType
 Reserved.w
 Port.w 
  StructureUnion
   IPLong.l
   IP.b[4]
  EndStructureUnion
 Zeros.l[2]
EndStructure

Structure HOST
    hName.l
    hAliases.l
    hAddrType.w
    hLength.w
    hAddrList.l
EndStructure

Structure SckInf
 sck.l
 protocol.l
 localport.l
 remoteport.l
 remotehost.s
 localhost.s
 LocalServerPort.l
 state.b
 incoming.b
 Closing.b
 thrid.l
 newconn.l
 Failed.b
 ConnectionEstablished.b
EndStructure
Dim Sockets.SckInf(512)

Structure in_addr
  s_addr.l
EndStructure
Structure sockaddr_in2
  sin_family.w
  sin_port.w
  sin_addr.in_addr
  sin_zero.b[8]
EndStructure

Structure protoent
    p_name.s
    p_aliases.l
    p_proto.l
EndStructure

Structure sockev
 EventID.l
 sck.l
 idx.l
EndStructure

Global udtWinsockData.WSAData,m_udtWinsockData.WSAData,HighSock.l,wsHnd.l
Dim SockEvents.sockev(512)
Global udtAddr.sockaddr_in2,udtRemoteAddr.sockaddr_in
#Protocol_ICMP=1:#Protocol_TCP=6:#Protocol_UDP=17
#INCOMING_DATA=1:#INCOMING_CONNECTION=2:#CONNECTION_CLOSING=3:#CONNECTION_FAILED=-1
#CONNECTION_ESTABLISHED=7


Procedure.l InitWinsock()
HighSock=0
lngRetVal.l:strErrorMsg.s:lngType.l:lngProtocol.l
lngRetVal = WSAStartup_(101$, udtWinsockData)
CopyMemory(@udtWinsockData,@m_udtWinsockData,SizeOf(WSAData))
If lngRetVal <> 0
   Select lngRetVal
    Case #WSASYSNOTREADY
          strErrorMsg = "The underlying network subsystem is not ready for network communication."
    Case #WSAVERNOTSUPPORTED
          strErrorMsg = "The version of Windows Sockets API support requested is not provided by this particular Windows Sockets implementation."
    Case #WSAEINVAL
          strErrorMsg = "The Windows Sockets version specified by the application is not supported by this DLL."
   EndSelect
    a$=strErrorMsg
EndIf
If a$=""
   wsHnd=OpenWindow(1000,200,100,40,40, #PB_Window_Invisible ,"winsock api handle")
   SetWindowCallback(@wMessages())
   ProcedureReturn udtWinsockData\wVersion
  Else
   ProcedureReturn 0
EndIf
EndProcedure


Procedure.l InitUDP(localport.l)
sck=CreateSocket(#Protocol_UDP):If sck=#INVALID_SOCKET:ProcedureReturn -3:EndIf
ss=AssignSocketIndex()
Sockets(ss)\State=0:Sockets(ss)\sck=sck:Sockets(ss)\Incoming=0:Sockets(ss)\Closing=#False
Sockets(ss)\LocalServerport=0:Sockets(ss)\Failed=0:Sockets(ss)\remotehost=host$
Sockets(ss)\localport=localport:Sockets(ss)\Protocol=#Protocol_UDP
udtAddr.sockaddr_in2
udtAddr\sin_family = #AF_INET
udtAddr\sin_addr\s_addr=#INADDR_ANY
udtAddr\sin_port =htons_(localport)
res=bind_(sck,@udtAddr,SizeOf(sockaddr_in2)*2)
If res=-1:ProcedureReturn -1:EndIf
Sockets(ss)\State=5
CR = WSAAsyncSelect_(sck, wsHnd, #WM_USER+ss,#FD_READ)
If ss>0:ProcedureReturn ss:EndIf
EndProcedure

Procedure.l CreateSocket(ProtocolType.l)
Select ProtocolType
 Case #Protocol_TCP
  sck = SOCKET_(2, 1, #Protocol_TCP)
 Case #Protocol_UDP
  sck = SOCKET_(2, 2, #Protocol_UDP)
 EndSelect
ProcedureReturn sck 
EndProcedure

Procedure.l CheckHostType(host$)
a$=UCase(host$)
For gg=1 To Len(a$)
 aa=Asc(Mid(a$,gg,1))
 If aa>45 And aa<58
    Else
     ProcedureReturn 1
 EndIf
 Next
ProcedureReturn 0
EndProcedure

Procedure TerminateWinsock()
For gg=1 To HighSock
 If Sockets(gg)\sck:closesocket_(Sockets(gg)\sck):EndIf
 Next
WSACleanup_()
EndProcedure

Procedure.s GetHostName(h$)
lngRet= gethostbyname_(h$)
If lngRet<>0
   CopyMemory(lngRet,@udtHost.HOST,SizeOf(HOST)*2)
   CopyMemory(@udtHost\hAddrList,@lngPointer.l,4)
   CopyMemory(lngPointer,@lngIPAddress,4)
   Dim arrIpAddress.b(udtHost\hLength-1)
   CopyMemory(lngIPAddress,@arrIpAddress(0),udtHost\hLength)
   For gg=0 To 3
   ip$=ip$+StrU(arrIpAddress(gg),#Byte):If gg<>3:ip$=ip$+".":EndIf    ;<--- Here  is the Error
   Next
EndIf
ProcedureReturn ip$
EndProcedure





Procedure.l ListenTCP(port.l)
sck=CreateSocket(#Protocol_TCP):If sck=#INVALID_SOCKET:ProcedureReturn -3:EndIf
udtAddr.sockaddr_in2
udtAddr\sin_family = #AF_INET
udtAddr\sin_addr\s_addr=htonl_(#INADDR_ANY)
udtAddr\sin_port =htons_(port)
If bind_(sck, @udtAddr, SizeOf(sockaddr_in2)*2) = #ERROR_SUCCESS
   listen_(sck,#SOMAXCONN)
  Else
   ProcedureReturn -1
EndIf
ss=AssignSocketIndex()
CR = WSAAsyncSelect_(sck, wsHnd, #WM_USER+ss,#FD_READ|#FD_ACCEPT|#FD_CLOSE)
Sockets(ss)\State=2:Sockets(ss)\sck=sck:Sockets(ss)\Incoming=0:Sockets(ss)\Closing=0
Sockets(ss)\remotehost="":Sockets(ss)\Protocol=#Protocol_TCP:Sockets(ss)\LocalServerport=port
ProcedureReturn sck
EndProcedure


Procedure.l ConnectTCP(host$,port.l,thrRes)
Shared thrRes
sck=CreateSocket(#Protocol_TCP):If sck=#INVALID_SOCKET:ProcedureReturn -3:EndIf
ss=AssignSocketIndex()
Sockets(ss)\State=6:Sockets(ss)\sck=sck:Sockets(ss)\Incoming=0:Sockets(ss)\Closing=#False
Sockets(ss)\LocalServerport=0:Sockets(ss)\Failed=0:Sockets(ss)\remotehost=host$
Sockets(ss)\Protocol=#Protocol_TCP:Sockets(ss)\remoteport=port
xx=CheckHostType(host$)
If xx:ip$=GetHostName(host$):If ip$="":ProcedureReturn -2:EndIf:Else:ip$=host$:EndIf
udtAddr.sockaddr_in2
udtAddr\sin_family = #AF_INET
udtAddr\sin_addr\s_addr=inet_addr_(ip$)
udtAddr\sin_port =htons_(port)
thrRes=CreateThread(@ConnectTask(),ss)
Sockets(ss)\thrid=thrRes
Sockets(ss)\remotehost=ip$
ProcedureReturn ss
EndProcedure


Procedure ConnectTask(ss) ;NEW CONNECTION
sck=Sockets(ss)\sck
res=connect_(sck,@udtAddr,SizeOf(sockaddr_in2)*2):If res<>0:Sockets(ss)\Failed=#True:ss=-1:ProcedureReturn:EndIf
CR = WSAAsyncSelect_(sck, wsHnd, #WM_USER+ss,#FD_READ|#FD_ACCEPT|#FD_CLOSE)
Sockets(ss)\State=7
Sockets(ss)\ConnectionEstablished=#True
Sockets(ss)\thrID=0
ProcedureReturn ss
EndProcedure


Procedure.l SendTCP(sck.l,strAddr,Lenght.l)
res=send_(sck, strAddr, Lenght, 0)
ProcedureReturn res
EndProcedure

Procedure.l SendUDP(sck,strAddr,lenght.l,remotehost.s,remoteport.l)
udtAddr\sin_family = #AF_INET
udtAddr\sin_addr\s_addr=inet_addr_(remotehost)
udtAddr\sin_port =htons_(remoteport)
res=sendto_(sck, strAddr, Lenght, 0,@udtAddr,SizeOf(sockaddr_in)*2)
ProcedureReturn res
EndProcedure

Procedure.l RetrieveData(sck,strAddr,sckidx)
Shared strAddr,sckidx
sckidx=FindSocketIndex(sck)
argp.l=1:ioctlsocket_(Sockets(sckidx)\sck,#FIONREAD,@argp)
If argp>0
   Dim arrBuffer(argp):strAddr=@arrBuffer(0)
   Sockets(sckidx)\Incoming=0
   Select Sockets(sckidx)\Protocol
    Case #Protocol_TCP
     ll = recv_(sck,strAddr, argp, 0)
    Case #Protocol_UDP
     kk=SizeOf(sockaddr_in2)*2:ll = recvfrom_(sck,strAddr, argp, 0,@remoteinfo.sockaddr_in2,@kk)
     If ll>0:Sockets(sckidx)\remotehost=IPString(remoteinfo\sin_addr\s_addr):EndIf
    EndSelect
   Sockets(sckidx)\incoming=#False
   ProcedureReturn ll
EndIf
EndProcedure

Procedure CloseSocket(sck)
For gg=1 To HighSock
 If Sockets(gg)\sck=sck
    Sockets(gg)\sck=0:Sockets(gg)\Incoming=0:Sockets(gg)\Closing=0
    Sockets(gg)\Protocol=0:Sockets(gg)\State=0:Sockets(gg)\LocalServerport=0
    Sockets(gg)\localport=0:Sockets(gg)\remoteport=0:Sockets(gg)\remotehost=""
    Sockets(gg)\localhost=""
 EndIf
 Next
closesocket_(sck)
EndProcedure

Procedure.l ProcessWinsockEvents()
Total=0:Dim SockEvents.sockev(1000)
For gg=1 To HighSock
 If Sockets(gg)\sck
    If Sockets(gg)\Incoming=#True
       Total=Total+1:SockEvents(Total)\EventID=#INCOMING_DATA
       SockEvents(Total)\sck=Sockets(gg)\sck:SockEvents(Total)\idx=gg
    EndIf
    If Sockets(gg)\newconn
       Total=Total+1:SockEvents(Total)\EventID=#INCOMING_CONNECTION
       SockEvents(Total)\sck=Sockets(Sockets(gg)\newconn)\sck:SockEvents(Total)\idx=Sockets(Sockets(gg)\newconn)\newconn
       Sockets(gg)\newconn=0
    EndIf
    If Sockets(gg)\Closing=#True
       Total=Total+1:SockEvents(Total)\EventID=#CONNECTION_CLOSING:SockEvents(Total)\idx=gg:Sockets(gg)\Closing=0
       SockEvents(Total)\sck=Sockets(gg)\sck:Sockets(gg)\State=8
    EndIf
    If Sockets(gg)\Failed=#True
       Total=Total+1
       SockEvents(Total)\EventID=#CONNECTION_FAILED:SockEvents(Total)\idx=gg:SockEvents(Total)\sck=Sockets(gg)\sck
    EndIf
    If Sockets(gg)\ConnectionEstablished=#True
       Total=Total+1:SockEvents(Total)\EventID=#CONNECTION_ESTABLISHED:SockEvents(Total)\idx=gg:Sockets(gg)\ConnectionEstablished=0
       SockEvents(Total)\sck=Sockets(gg)\sck:length.l = SizeOf(IPType)
       If getsockname_(Sockets(gg)\sck,@IP.IPType,@length)=0
          ip$ = StrU(IP\IP[0],#Byte)+"."+StrU(IP\IP[1], #Byte)+"."
          ip$ + StrU(IP\IP[2],#Byte)+"."+StrU(IP\IP[3], #Byte)
          Sockets(gg)\localhost=ip$:pp.l=Val(StrU(IP\Port,#Word))
          b2=pp & 255:b1=(pp/256) & 255:Sockets(gg)\localport=b1+b2*256
         Else
          Debug "internal winsock error " +Str(WSAGetLastError_())
       EndIf
    EndIf
 EndIf
Next
ProcedureReturn Total
EndProcedure

Procedure.l AcceptConnection(sck)
For gg=1 To HighSock
 If Sockets(gg)\sck=sck
    CR = WSAAsyncSelect_(sck, wsHnd, #WM_USER+gg,#FD_READ|#FD_ACCEPT|#FD_CLOSE)
    Sockets(gg)\State=7
    ProcedureReturn gg:EndIf
 Next
ProcedureReturn 0
EndProcedure

Procedure.l RefuseConnection(sck)
CloseSocket(sck)
EndProcedure

Procedure wMessages(WindowID, Message, wParam, lParam)
mm=Message
If WindowID=wsHnd
   If mm>1024
      Select lParam
       Case #FD_READ
        Sockets(mm-1024)\Incoming=#True
       Case #FD_CLOSE
        Sockets(mm-1024)\Closing=#True
       Case #FD_ACCEPT
        sck=Sockets(mm-1024)\sck
        ll.l=SizeOf(sockaddr_in)*2
        res=accept_(sck,@RemoteAddr.sockaddr_in,@ll)
        If res<>#INVALID_SOCKET
           closesocket_(sck):Sockets(mm-1024)\sck=0
           ss=AssignSocketIndex()
           Sockets(ss)\State=4:Sockets(ss)\sck=res:Sockets(ss)\Incoming=0:Sockets(ss)\Closing=0
           Sockets(ss)\Protocol=#Protocol_TCP:Sockets(ss)\newconn=ss
           Sockets(ss)\LocalServerport=Sockets(mm-1024)\LocalServerport:Sockets(ss)\thrid=0:Sockets(ss)\Failed=0
           length.l = SizeOf(IPType)
           If getpeername_(res,@IP.IPType,@length)=0
              ip$ = StrU(IP\IP[0],#Byte)+"."+StrU(IP\IP[1], #Byte)+"."
              ip$ + StrU(IP\IP[2],#Byte)+"."+StrU(IP\IP[3], #Byte)
              Sockets(ss)\remotehost=ip$
           EndIf   
        EndIf
      EndSelect  
   EndIf
EndIf
ProcedureReturn #PB_ProcessPureBasicEvents 
EndProcedure 

Procedure.l FindSocketIndex(sck)
For gg=1 To 512
 If Sockets(gg)\sck=sck:ProcedureReturn gg:EndIf
 Next
ProcedureReturn -1
EndProcedure
Procedure.l AssignSocketIndex()
For gg=1 To 512
 If Sockets(gg)\sck=0
    If HighSock<gg:HighSock=gg:EndIf
    ProcedureReturn gg:EndIf
 Next
ProcedureReturn 0
EndProcedure

well .. this is the code .. not mine ...
i need to Get IP from Hostname - GetHostName does that ... (in most cases) .. but i get this ERROR ...

Code: Select all

[15:25:09] Waiting for executable to start...
[15:25:09] Executable started.
[15:25:09] [ERROR] WinsockFunctions.pb (Line: 168)
[15:25:09] [ERROR] Invalid memory access.
[15:25:16] The Program was killed.

in other cases (mostly!),
with this source

Code: Select all

includefile "WinsockFunctions.pb"
Initwinsock()
Debug gethostname("MAX")
terminatewinsock()

i'll apreciate any help ... thank you (in advance) to anyone who replies ..

moogle · Post by **moogle** » Sun Mar 05, 2006 5:12 pm

yep i get the same problem. its to do with this procedure

Procedure.s GetHostName(h$)
lngRet= gethostbyname_(h$)
If lngRet<>0
CopyMemory(lngRet,@udtHost.HOST,SizeOf(HOST)*2)
CopyMemory(@udtHost\hAddrList,@lngPointer.l,4)
CopyMemory(lngPointer,@lngIPAddress,4)
Dim arrIpAddress.b(udtHost\hLength-1)
CopyMemory(lngIPAddress,@arrIpAddress(0),udtHost\hLength)
For gg=0 To 3
ip$=ip$+StrU(arrIpAddress(gg),#Byte)
If gg<>3
ip$=ip$+"."
EndIf
Next
EndIf
ProcedureReturn ip$
EndProcedure

its form the PB_Winsock_API lib or code.

i dont know why its caused tho

LuCiFeR[SD] · Post by **LuCiFeR[SD]** » Sun Mar 05, 2006 7:55 pm

no idea what version of PB you guys are using... but perhaps this little lot will help? this works for me nicely though... perhaps you can adapt it to your needs?

Code: Select all

;- About
;
;=-=-=-=-=-=-=-=-=-=-=-=-
;Original author: ??????
;=-=-=-=-=-=-=-=-=-=-=-=-
;
;Code working with Purebasic v3.94 & v4 Beta 5.
;Should work on all windows operating systems, but only tested on WindowsXP.
;PB version 4 does have it's own network commands to handle this though
;so this can be considered obsolete.
;

;- Structures
Structure HOSTENTS 
    h_name.l 
    h_aliases.l 
    h_addrtype.w 
    h_length.w 
    h_addr_list.l 
EndStructure 

;- Main Code
If InitNetwork()
       
      Hostname$ = Space(255)
             
      gethostname_(Hostname$,255)
            
      Debug "Hostname: "+Hostname$
            
      pHostinfo = gethostbyname_(Hostname$)
             
            If pHostinfo = 0
             
            Debug "Unable to resolve domain name."
             
            Else
            
            CopyMemory (pHostinfo, hostinfo.HOSTENTS, SizeOf(HOSTENTS))
             
                  If hostinfo\h_addrtype <> #AF_INET 
                  
                  Debug "A non-IP address was returned."
                  
                        Else
                                          
                              While PeekL(hostinfo\h_addr_list+AdressNumber*4)
                              
                                    ipAddress = PeekL(hostinfo\h_addr_list+AdressNumber*4)
                                                                   
                                    Debug StrU(PeekB(ipAddress),0)+"."+StrU(PeekB(ipAddress+1),0)+"."+StrU(PeekB(ipAddress+2),0)+"."+StrU(PeekB(ipAddress+3),0) 
                                                                  
                                    AdressNumber+1 
                              Wend
                                           
                        EndIf 
                  
                  EndIf 
                  
            Else
      
      Debug "Network can't be initialized"
       
EndIf



;- Purebasic 4 built in commands to get hostname & IP addresses on the host machine.
;uncomment them to get them to work in PB4.
;
;
;Hostname$=Hostname()

;Debug Hostname$
      
;If ExamineIPAddresses()
      
;      Repeat
      
;            IP_Address=NextIPAddress()
;            IP_Address$ = IPString(IP_Address)
                        
 ;           If IP_Address <>0
            
;                  Debug IP_Address$
            
;            EndIf
      
;      Until IP_Address=0
      
;EndIf

Shannara · Post by **Shannara** » Sun Mar 05, 2006 10:17 pm

Are you planning on making this a library available for PB?

Code: Select all

Procedure.l ListenTCP(IP.s, port.l)
sck=CreateSocket(#Protocol_TCP):If sck=#INVALID_SOCKET:ProcedureReturn -3:EndIf
udtAddr.sockaddr_in2
udtAddr\sin_family = #AF_INET
udtAddr\sin_addr\s_addr=htonl_(IP)
udtAddr\sin_port =htons_(port)
If bind_(sck, @udtAddr, SizeOf(sockaddr_in2)*2) = #ERROR_SUCCESS
   listen_(sck,#SOMAXCONN)
  Else
   ProcedureReturn -1
EndIf
ss=AssignSocketIndex()
CR = WSAAsyncSelect_(sck, wsHnd, #WM_USER+ss,#FD_READ|#FD_ACCEPT|#FD_CLOSE)
Sockets(ss)\State=2:Sockets(ss)\sck=sck:Sockets(ss)\Incoming=0:Sockets(ss)\Closing=0
Sockets(ss)\remotehost="":Sockets(ss)\Protocol=#Protocol_TCP:Sockets(ss)\LocalServerport=port
ProcedureReturn sck
EndProcedure

"may" make this server grade

b1be · Post by **b1be** » Sun Mar 05, 2006 11:33 pm

thank you ... LuCiFeR[SD] .. works ...
@Shannara if your question was addressed to me .. well This code is not mine... forgot to mention that i got it from this forum ...

... a long time ago...

HAnil · Post by **HAnil** » Mon Mar 06, 2006 7:26 pm

This works.

Code: Select all

Procedure.s GetHostName(h$)
lngRet= gethostbyname_(h$)
If lngRet<>0
   CopyMemory(lngRet,@udtHost.HOST,SizeOf(HOST)*2)
   CopyMemory(@udtHost\hAddrList,@lngPointer.l,4)
   CopyMemory(lngPointer,@lngIPAddress,4)
   Dim arrIpAddress.b(udtHost\hLength-1)
   CopyMemory(lngIPAddress,@arrIpAddress(0),udtHost\hLength)
   ip$ = ""
   For gg=0 To 3
      ip$=ip$+StrU(arrIpAddress(gg),#Byte)
      If gg<>3
         ip$=ip$+"."
      EndIf
   Next
EndIf
ProcedureReturn ip$
EndProcedure

Shannara · Post by **Shannara** » Fri Apr 07, 2006 11:01 pm

My apologies

B1be. Did HAnil's response help you? Do you happen to have a little sample on sending recieving text using the code your using?