Aktuelle Zeit: 22.09.2020 15:02

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 3 Beiträge ] 
Autor Nachricht
 Betreff des Beitrags: [Gelöst] PB4.x zu PB5.6 Unicode-Code Problem
BeitragVerfasst: 25.10.2017 22:37 
Offline
Benutzeravatar

Registriert: 20.07.2010 23:59
Wohnort: NRW
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:
; 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.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: PB4.x zu PB5.6 Unicode-Code Problem
BeitragVerfasst: 25.10.2017 23:08 
Offline
Kommando SG1
Benutzeravatar

Registriert: 01.11.2005 13:34
Wohnort: Glienicke
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:
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:
; 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 ^^

_________________
Bild
 
BildBildBild


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: PB4.x zu PB5.6 Unicode-Code Problem
BeitragVerfasst: 25.10.2017 23:32 
Offline
Benutzeravatar

Registriert: 20.07.2010 23:59
Wohnort: NRW
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. <)


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 3 Beiträge ] 

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: Majestic-12 [Bot] und 3 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye