Hallo zusammen,
nach einer etwas längeren PB-Pause (in der ich mich eher in diversen µController-IDE's abmühen musste
)brauchte ich wieder mal ein Tool das u.a. die PC-Namen und IPs im Netzwerk listet.
Also dazu meinen alten "Lieblingscode" hervorgekramt .... und direkt auf ein seltsames Verhalten mit aktuellem PB gestolpert.
In dem Code von PB5.6 wird noch InitNetwork() benutzt, damit läuft auch alles. (Mit/ohne Debugger und als EXE)
Um dem Compiler-deprecated-Mecker zu entgehen habe ich einfach in GetLANList() das "if InitNetwork() ...." durch "if 1=1 ...." ersetzt.
Nun funktioniert es nur noch mit Debugger, aber nicht ohne Debugger oder als EXE.
(Program gibt Fehler aus: "Unable to resolve domain name")
Hier der Code.
BTW.: Diesen mit EnableExplicit und Protected-Variablen abzusichern steht noch auf meiner ToDo-Liste.
Code: Alles auswählen
; http://www.purebasic.fr/german/archive/viewtopic.php?t=834
; Author: PWS32
; Updated to PB5.6 from Stargate in thread https://www.purebasic.fr/german/viewtopic.php?p=343212&hilit=pws32#p343212
Structure SERVER_INFO_101
StructureUnion
PlatformID.l
_Align1.i
EndStructureUnion
*Name
MajorVersion.l
MinorVersion.l
StructureUnion
Type.l
_Align2.i
EndStructureUnion
*Comment
EndStructure
#MAX_PREFERRED_LENGTH = -1
#SV_TYPE_ALL = $FFFFFFFF
#NERR_SUCCESS = 0
#ERROR_MORE_DATA = 234
#MainWindow = 100
#MMTB = 200
Global MMTextBox
Procedure Message (M.s)
WriteMessage.s
WriteMessage +Chr(13)+Chr(10)+M
SetGadgetText(#MMTB,GetGadgetText(#MMTB) + WriteMessage )
SendMessage_(MMTextBox,$00B6,0,10000)
EndProcedure
Procedure.s GetIPbyName (NameIP.s)
TheIPAdress.s
*Ascii = Ascii(NameIP)
pHostinfo = gethostbyname_(*Ascii) : FreeMemory(*Ascii)
If pHostinfo = 0
TheIPAdress = "Unable to resolve domain name"
Else
CopyMemory (pHostinfo, hostinfo.HOSTENT, SizeOf(HOSTENT))
If hostinfo\h_addrtype <> #AF_INET
MessageRequester("Info","A non-IP address was returned",0)
Else
While PeekL(hostinfo\h_addr_list+AdressNumber*4)
ipAddress = PeekL(hostinfo\h_addr_list+AdressNumber*4)
TheIPAdress = StrU(PeekB(ipAddress),#PB_Byte)+"."+StrU(PeekB(ipAddress+1),#PB_Byte)+"."+StrU(PeekB(ipAddress+2),#PB_Byte)+"."+StrU(PeekB(ipAddress+3),#PB_Byte) ; Schon für PB5.60 editiert
AdressNumber+1
Wend
EndIf
EndIf
ProcedureReturn TheIPAdress
EndProcedure
Procedure GetLANList()
IPResult.s
se101.SERVER_INFO_101
nStructSize = SizeOf(SERVER_INFO_101)
RetCode = NetServerEnum_(0, 101, @bufptr, #MAX_PREFERRED_LENGTH, @dwEntriesread, @dwTotalentries, #SV_TYPE_ALL, 0, @dwResumehandle)
If RetCode = #NERR_SUCCESS And RetCode <> #ERROR_MORE_DATA
If InitNetwork() ; <<<<<<<<< HIER
For i = 0 To dwEntriesread - 1
CopyMemory( bufptr + (nStructSize * i),@se101, nStructSize)
Buffer.s = PeekS(se101\Name, #PB_Default, #PB_Unicode)
IPResult = GetIPbyName (Buffer)
Message ("No : "+ Str(i+1) + " " + Buffer + " --> " + IPResult)
Next
Else
MessageRequester("Info","Network can't be initialized",0)
EndIf
Else
MessageRequester("Info","Failed",0)
EndIf
NetApiBufferFree_(bufptr)
SendMessage_(MMTextBox,$00B6,0,30)
EndProcedure
hWnd = OpenWindow(#MainWindow, 100, 150, 300, 250, " Name > IP", #PB_Window_SystemMenu)
ButtonGadget(1, 1, 224, WindowWidth(#MainWindow)-1,26, "Get Name and IP")
MMTextBox=StringGadget(#MMTB, 0, 2, WindowWidth(#MainWindow)-1,WindowHeight(#MainWindow)-30 ,"Name > IP by P.Spisla 2003 ",#ES_MULTILINE|#ES_AUTOVSCROLL|#WS_VSCROLL|#PB_String_ReadOnly)
Message("--------------------------------------------")
Repeat
Select WaitWindowEvent()
Case #PB_Event_Gadget
Select EventGadget()
Case 1
Message ("Examine the Network, please wait !")
GetLANList()
Message ("End of List")
EndSelect
Case #PB_Event_CloseWindow
End
EndSelect
ForEverAuch Posts wie "Vergiss den alten Kram, nimm das hier [LINK]" sind natürlich willkommen.
Grüsse.