Nach lange hin und her, habe ich endlich dieses "project" abgeschlossen.
Code: Alles auswählen
;' This sampler was created by Jim Huff of Edinborg Productions
;' on April 10, 1999. I created this sampler in order to demonstrate
;' how to perform the equivalent of the NBTSTAT -A function which
;' is available from a Command Prompt.
;' Please feel free to use, or modify, this code in whatever method, or
;' fashion, you choose. No warranties of any kind are implicity or
;' explicitly implied by the author of this code.
;' If you include portions of this code into your programs, please
;' give some sort of credit referring to the author of this code.
;' Author's EMail: JimHuff@JimHuff.User.ShenTel.Net
;' JimHuff@ ShenTel.Net
; Author: jpd
; Date: 17.11.2006
Declare recieve_data(sock.l)
Declare ProcessRcvdData(received.l)
Declare FermerSocket(sock.l)
Declare init_snd(ip.s,Win_id.l)
Enumeration
#Window_0
#Combo_0
#Text_0
#Listview_0
#Button_send
#Button_Close
EndEnumeration
Structure HOSTENTS
h_name.l
h_aliases.l
h_addrtype.w
h_length.w
h_addr_list.l
EndStructure
#SOCK_DGRAM = 2
#AF_INET = 2 ; internetwork: UDP, TCP, etc.
#PF_INET = #AF_INET
#IPPROTO_UDP = 17
#__x_sockaddr_COMMON_SIZE = 2 ;SizeOf(unsigned short int)
#INADDR_ANY=0
Global received.l
Structure NBPkt
XactionID.w
Flags.w
QCount.w
ACount.w
NSCount.w
ARCount.w
QName.b [34]
QType.w
QClass.w
EndStructure
Structure NodeName
bName.b[16]
RRFlag.w
EndStructure
Structure Response
TTL.l
RDLength.w
NUM_Names.b
EndStructure
;-rcvdRespPartII
Structure RespPartII
NodeNameArray.NodeName [16]
EndStructure
Structure IN_ADDR
S_addr.l
EndStructure
Structure SOCK_ADDR
sin_family.w ;(unsigned short int)
sin_port.w; /* Port number.
sin_addr.IN_ADDR ; /* Internet address.
sin_zero.b[SizeOf(SOCKADDR)-#__x_sockaddr_COMMON_SIZE-SizeOf(WORD)-SizeOf(IN_ADDR)] ; Pad To size of `struct x_sockaddr' +8
EndStructure
Procedure Open_Window_0()
If OpenWindow(#Window_0, 500, 300, 440, 480, "NBTSTAT -A", #PB_Window_SystemMenu |#PB_Window_ScreenCentered| #PB_Window_SizeGadget | #PB_Window_TitleBar )
If CreateGadgetList(WindowID(#Window_0))
ComboBoxGadget(#Combo_0, 150, 20, 170, 60, #PB_ComboBox_Editable)
TextGadget(#Text_0, 20, 20, 120, 20, "", #PB_Text_Border)
ListIconGadget(#Listview_0, 20, 60, 400, 300,"Name",400/3)
AddGadgetColumn(#Listview_0, 1, "Typ", 400/3)
AddGadgetColumn(#Listview_0, 2, "Status", 400/3)
ButtonGadget(#Button_send, 30, 370, 90, 30, "Send")
ButtonGadget(#Button_Close, 140, 370, 90, 30, "Close")
EndIf
EndIf
EndProcedure
Open_Window_0()
;- Main Code
If InitNetwork()
Hostname$ = Space(255)
gethostname_(Hostname$,255)
;Debug "Hostname: "+Hostname$
SetGadgetText(#Text_0,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)
name$= StrU(PeekB(ipAddress),0)+"."+StrU(PeekB(ipAddress+1),0)+"."+StrU(PeekB(ipAddress+2),0)+"."+StrU(PeekB(ipAddress+3),0)
;Debug name$
AddGadgetItem(#Combo_0,-1,name$)
SetGadgetState(#Combo_0, 0)
AdressNumber+1
Wend
EndIf
EndIf
Else
Debug "Network can't be initialized"
EndIf
Repeat
event=WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case #Button_send
ClearGadgetItemList(#Listview_0)
init_snd(GetGadgetText(#combo_0),#Window_0)
Case #PB_Event_Menu
Case #Button_Close
End
Select EventMenu()
;Case #menu_start
EndSelect
Case #PB_Event_CloseWindow
FermerSocket(sock)
End
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow
FermerSocket(sock)
End
Procedure init_snd(ip.s,Win_id.l)
LocalServer.SOCK_ADDR
rmtserver.SOCK_ADDR
Time$ = FormatDate("%hh:%ii:%ss", Date())
Debug "time: "+Time$
sock.l = SOCKET_(#AF_INET,#SOCK_DGRAM ,#IPPROTO_UDP)
Debug"socket: " +Str(sock)
If sock < 0
Debug "error cannot create socket!"
End
Else
LocalServer\sin_family = #AF_INET
LocalServer\sin_port = 0
LocalServer\sin_addr\S_addr = #INADDR_ANY
CR = bind_(sock, @LocalServer, SizeOf(SOCK_ADDR))
Debug "bind: "+Str(CR)
rmtserver\sin_family = #AF_INET
rmtserver\sin_port = htons_(137)
rmtserver\sin_addr\S_addr = inet_addr_(ip)
rmtserver\sin_zero = 0
rmtserver_l.l = 16
CR =connect_(sock,@rmtserver,SizeOf(SOCK_ADDR))
Debug "connect: "+Str(CR)
EndIf
rqstPkt.NBPkt;=AllocateMemory(SizeOf(NBPkt))
rqstPkt\XactionID = htons_(12345)
rqstPkt\Flags = htons_($16)
rqstPkt\QCount = htons_(1)
rqstPkt\ACount = 0
rqstPkt\NSCount = 0
rqstPkt\ARCount = 0
tempString.s = Chr(32)+ "CKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"; ' Netbios name, length must be 32 (decimal)
MoveMemory( @tempString,@rqstPkt\QName[0], Len(tempString))
rqstPkt\QType = htons_($21) ;' NetBIOS NODE STATUS Resource Record
rqstPkt\QClass = htons_($01) ;' Internet class
;' Convert the Data which is to be transmitted into a string
sDataToNet.s = LSet (Chr(0),SizeOf(NBPkt), Chr(0))
*buffer =AllocateMemory(SizeOf(NBPkt))
CopyMemoryString(sDataToNet, *buffer)
MoveMemory( @rqstPkt,*buffer, SizeOf(NBPkt))
long1 = SizeOf(rqstPkt)
;Dim buff.b(long1 + 1)
;For x = 0 To SizeOf(NBPkt) ;Step 2
; buff(x)=PeekW(*buffer+ x)
;Next
CR = send_(sock, *buffer, SizeOf(NBPkt), 0)
Debug "send = "+ Str(CR)
If CR < 0
Debug "Erreur sur l'envoi du message = " ;+str WSAGetLastError()
FermerSocket(sock)
;Exit Sub
EndIf
Time$ = FormatDate("%hh:%ii:%ss", Date())
Debug "time: "+Time$
CR = WSAAsyncSelect_(sock, WindowID(Win_id), $202, FD_READ)
Debug "WSAAsyncSelect = "+ Str(CR)
If CR < 0
Debug "Erreur sur WSAAsyncSelect = " + Str(WSAGetLastError_())
;FermerSocket sock
FermerSocket(sock)
; Break
Else
;-call process recieved data
*recieved=recieve_data(sock)
If PeekL(*recieved) > 0
Debug PeekL(*recieved)
ProcessRcvdData(*recieved)
EndIf
EndIf
;End Sub
EndProcedure
Procedure recieve_data(sock.l)
Repeat
For x=1 To 50
Debug x
If x=50
Debug "Error #WSAEWOULDBLOCK "+Str(error)
;FermerSocket(sock.l)
Break 2
EndIf
; receive data
buffer_l.l = 1024 ; buffer of 1024 kbytes
*buffer_p = AllocateMemory(buffer_l)
received.l = recv_(sock,*buffer_p,buffer_l,0)
;Debug "socket: " +Str(sock)
;Debug "recieved: " +Str(received)
; received>0 number of bytes received aka transferred to buffer
; received=0 gracefull disconnect (properly closed by other side)
; received<0 error, or no data
If received > 0
closesocket_(sock)
ProcedureReturn *buffer_p
ElseIf received = 0 ; gracefull disconnect
done = #True ; so close the socket
Else
error.l = WSAGetLastError_()
If error=#WSAEWOULDBLOCK ; when non-blocking: no more data to read
;Debug "Error #WSAEWOULDBLOCK "+Str(error)
Delay(100)
Else ; otherwise a real problem
Debug "Error "+Str(error)
close = 1 ; so close the socket
EndIf
EndIf
FreeMemory(buffer_pbh) ; free the read buffer
Sleep_(1) ;x_freepbh(buffer_pbh)
Next ;
Until done = #True
closesocket_(sock) ; close socket
ProcedureReturn *buffer_p
EndProcedure
Procedure ProcessRcvdData(*buffer_p)
;' I am not going to bother explaining this mess. You can see
;' what I did below and compare it to RFC-1001 and RFC-1002 to
;' figure it out.
; ' Simply put, this function processes the received data and
; ' provides the calling subroutine with a text-based result.
rcvdPkt.NBPkt
rcvdResponse.Response
rcvdRespPartII.RespPartII
Dim MACCode.b(5)
Name_Flag.w
udtData.s
sTemp.s
;QName.s
Dim btemp.b(15)
i.w
j.w
CopyMemory(*buffer_p,@rcvdPkt\XactionID,SizeOf(rcvdPkt))
;-for rcvdResponse.Response
CopyMemory(*buffer_p+SizeOf(rcvdPkt),@rcvdResponse\TTL,SizeOf(rcvdResponse))
lenght_RespPartII.l=SizeOf(RespPartII\NodeNameArray)/(SizeOf(NodeName\bName))
Debug "lenght_RespPartII: "+Str(lenght_RespPartII)
For i = 0 To rcvdResponse\NUM_Names -1
CopyMemory (*buffer_p+SizeOf(rcvdPkt)+SizeOf(rcvdResponse)+(i*lenght_RespPartII),@rcvdRespPartII\NodeNameArray[i],lenght_RespPartII)
sTemp = LSet (Chr(0),15, Chr(0))
*sTemp_buffer =AllocateMemory(15)
CopyMemoryString(sTemp, *sTemp_buffer)
name.s=""
For x =0 To 14
CopyMemory (@rcvdRespPartII\NodeNameArray[i]\bName[0+x], *sTemp_buffer,Len(sTemp))
name= name+Chr(rcvdRespPartII\NodeNameArray[i]\bName[x]);
Next ;For j = 1 To Len(sTemp) ' Convert unprintable characters to a dot "."
Debug name
For j = 1 To Len(name) ; ' Convert unprintable characters to a dot "."
; Do
If Asc(Mid(name, j, 1)) < 32
Debug Asc(Mid(name, j, 1))
name = ReplaceString(name, Mid(name, j, 1), "." )
;Mid(name, j, 1) = "."
EndIf
Next j
AddGadgetItem(#Listview_0,-1,name)
btemp(i) = rcvdRespPartII\NodeNameArray[i]\bName[15]
Name_Flag = htons_(rcvdRespPartII\NodeNameArray[i]\RRFlag)
Debug "Name_Flag: "+Str(Name_Flag)
If Int(Name_Flag / 256) & 128 = 128
SetGadgetItemText(#Listview_0,i,"<"+RSet(Hex(btemp(i)), 2, "0")+">"+" GROUP",1)
;RSet(Hex(test), 2, "0")
Else
SetGadgetItemText(#Listview_0,i,"<"+RSet(Hex(btemp(i)), 2, "0")+">"+" UNIQUE",1)
EndIf
status.s=""
If Int(Name_Flag / 256) & 16 = 16:status="DeRegistering":EndIf
If Int(Name_Flag / 256) & 8 = 8 :status="Name Conflict":EndIf
If Int(Name_Flag / 256) & 4 = 4:status="Registered":EndIf
If Int(Name_Flag / 256) & 2 = 2 :status="Permanent Name":EndIf
If status <> ""
SetGadgetItemText(#Listview_0,i,status,2)
EndIf
Next
Debug "rcvdResponse\NUM_Names: " + Str(rcvdResponse\NUM_Names)
CopyMemory (*buffer_p+SizeOf(rcvdPkt)+SizeOf(rcvdResponse)+(rcvdResponse\NUM_Names*lenght_RespPartII),@MACCode(0), rcvdResponse\NUM_Names)
mac.s=""
For x = 0 To 5
If x =< 4
mac= mac + RSet(Hex(MACCode(x)), 2, "0")+"-"
Else
mac= mac + RSet(Hex(MACCode(x)), 2, "0")
EndIf
Next
AddGadgetItem(#Listview_0,-1,"")
AddGadgetItem(#Listview_0,-1,"MAC Address")
AddGadgetItem(#Listview_0,-1,mac)
EndProcedure
Procedure FermerSocket(sock.l)
lngResult.l
If sock <> 0
lngResult = shutdown_(sock, 2)
lngResult = closesocket_(sock)
EndIf
lngResult = WSACancelBlockingCall_()
lngResult = WSACleanup_()
sock = 0
EndProcedure
