PureBoard

Verfasst: **25.10.2017 22:37**

Hallo, ich habe hier einen recht alten Code, den ich in Teilen auch in anderen Projekten nutzte.
Diese Projekte sollen nun auf PB5.6 migriert werden, und da hakts bei mir noch an einer Stelle.
Die PC-Namen sind nur Zeichensalat, klar eine Unicode-Ascii-Sache, aber ich vermag die üblichen Poke$/PeekS
Konvertierungen hier nicht einzubauen ...

Wer weiss Rat ?

Code: Alles auswählen

; http://www.purebasic.fr/german/archive/viewtopic.php?t=834
; Author: PWS32

Structure SERVER_INFO_101
dwPlatformId.l
lpszServerName.l
dwVersionMajor.l
dwVersionMinor.l
dwType.l
lpszComment.l
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
  pHostinfo = gethostbyname_(NameIP)
  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()
      For i = 0 To dwEntriesread - 1
        CopyMemory( bufptr + (nStructSize * i),@se101, nStructSize)
        Buffer.s=Space(512)
        Result=WideCharToMultiByte_(#CP_ACP ,0,se101\lpszServerName,255,@Buffer.s,512,0,0)      ; <-- Denke hier hakts, denn Buffer.s ist Unicode-kryptisch ...
        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
ForEver

Verfasst: **25.10.2017 23:08**

Ich bin etwas verwirrt das dieser Code überhaupt geht, denn die Struktur ist falsch.
lpszServerName.l wäre nämlich eine Integer und keine Long:

Code: Alles auswählen

SERVER_INFO_101
	StructureUnion
		PlatformID.l
		_Align1.i
	EndStructureUnion
	*Name
	MajorVersion.l
	MinorVersion.l
	StructureUnion
		Type.l
		_Align2.i
	EndStructureUnion
	*Comment
EndStructure

Dann kannst du nämlich auch normal den Namen lesen, weil dieser eh Unicode ist!
Bei gethostbyname_() muss du dann aber den namen als Ascii übergeben, also so:

Code: Alles auswählen

; http://www.purebasic.fr/german/archive/viewtopic.php?t=834
; Author: PWS32

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()
      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
ForEver

PS: 'n paar Protected in den Proceduren würden dem alten Code nicht schaden ^^

Verfasst: **25.10.2017 23:32**

Sehr hilfreich ... vielen Dank. Jetzt bekomme ich ein, zwei alte Sachen in die Gegenwart portiert.
Und auch wieder mal mehr Programmierhintergrund als ich vermutete (die Struktur),
ich hätte auf irgendeinen Parameter des WideCharToMultiByte_() getippt oder so.

PureBoard

[Gelöst] PB4.x zu PB5.6 Unicode-Code Problem

[Gelöst] PB4.x zu PB5.6 Unicode-Code Problem

Re: PB4.x zu PB5.6 Unicode-Code Problem

Re: PB4.x zu PB5.6 Unicode-Code Problem