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

Für allgemeine Fragen zur Programmierung mit PureBasic.
Benutzeravatar
TheCube
Beiträge: 150
Registriert: 20.07.2010 23:59
Computerausstattung: Risen 3400G 16MB Win10-64Bit
Wohnort: NRW

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

Beitrag von TheCube »

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 ... :oops:
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
Zuletzt geändert von TheCube am 27.10.2017 00:28, insgesamt 2-mal geändert.
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 6996
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

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

Beitrag von STARGÅTE »

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 ^^
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Benutzeravatar
TheCube
Beiträge: 150
Registriert: 20.07.2010 23:59
Computerausstattung: Risen 3400G 16MB Win10-64Bit
Wohnort: NRW

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

Beitrag von TheCube »

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. <)
Antworten