Un petit problème ??

[PAPIPP]

EN 2009 j'avais réalisé un prg PUNCH d'aide à MSDOS qui fonctionnait parfaitement.
https://www.purebasic.fr/french/viewtop ... os#p187031
https://www.purebasic.fr/french/viewtop ... os#p187031

Je viens de compiler ce prg avec PB573 86 ou 64 bits et le résultat n’est pas conforme à ce que j’avais trouvé à l’époque.
Alors que l’exe de l’époque donne toujours de bons résultats.
Pour simplifier le pb que j’ai rencontré voici un programme réduit à sa plus simple expression.
En fait il apparait des caractères qui ne sont pas éditables en hexa $FDFF à la place de caractères éditables.
Or si vous vous placez en MSDOS avec la commande CMD vous pouvez taper HELP ASSOC pour vérifier
que tous les caractères sont éditables comme l’exécution du prg.EXE de 2009 exécuté aujourd’hui.
Alors que la même commande avec prg=RunProgram("cmd"," /C "+CM$,"",30) avec CM$= ‘HELP ASSOC ‘
Il apparait le caractère $FDFF avec PB573 soit en 32 bits soit en 64.
Le prg que je vous présente doit être compilé avec l’option debugger DebuggerError("Un Caractère >$7F")
Qui stop le prg et ce qui permet de vérifier les zones mémoires.
Obtenez-vous la même erreur que moi. Si oui il doit y avoir une erreur quelque part soit dans mon prg qui fonctionnait et qui fonctionne toujours bien ou dans PB573 32 ou 64 bits qui ajoute des caractères non éditables.
Une rapide analyse fait apparaitre que ce sont les caractères accentués comme é è à qui sont remplacés par $FDFF.
Une bogue certainement.
Pour le plaisir des yeux après avoir ouvert MSDOS avec la commande CMD tapez ‘ TREE c:\windows’
Cette commande donne des résultats déplorables dans le prg que j' ai proposé.

Code : Tout sélectionner

Macro _q_t_
"
EndMacro
Macro _n (__n)
_q_t_#__n#=_q_t_+Str(__n)+" "
EndMacro
Macro _s (__S)
_q_t_#__S#=_q_t_+__S+" "
EndMacro
EnableDebugger
Debug _n(#PB_Compiler_Debugger)
CompilerIf #PB_Compiler_Debugger = 1

  Global alpha$
  For i=$20 To $7F
    ALPHA$+Chr(i)
  Next
  Debug  _s(alpha$)
  Procedure cont(chain$)
    Debug  _s(chain$)
    ln=Len(chain$)
    For i=1 To ln
      ch$=Mid(chain$,i,1)
      pos=FindString(alpha$,ch$,1,#PB_String_CaseSensitive)
      If pos=0
        If lnm<>ln
          ;           dumph(@chain$,ln*2) 
          ;           ShowAssemblyViewer()
          Debug  _s(chain$)
          ShowMemoryViewer(@chain$, ln*2)
          DebuggerWarning("warning Un Caractère >$7F")
          DebuggerError("Un Caractère >$7F")
          lnm=ln
        EndIf
        Debug _n(i)+_s(ch$)+_N(Asc(ch$))+" ce caractère n'est pas dans l'alphabet"
      EndIf
    Next
  EndProcedure
  
  Procedure.s AFCH(Cm$)
    prg=RunProgram("cmd","  "+CM$,"",30)
;     prg=RunProgram("cmd"," /C "+CM$,"",30)
    As$=Space($FFFF)
    If prg
      As$=ReadProgramString(prg)
      cont(As$)
      sortie$=Cm$+" :"+As$ 
      While ProgramRunning(prg)
        As$ =ReadProgramString(prg)
        cont(As$)
        ln=Len(As$)*2
        sortie$+ As$
      Wend
    EndIf
    ProcedureReturn sortie$
  EndProcedure
  sort$=AFCH("help assoc")
;   sort$=AFCH("TREE c:\windows")
  Debug _s(sort$)
  
CompilerElse

   Debug "*************    mettez le debuger en service   **************"

CompilerEndIf

A+

[kernadec]

bjr PAPIPP
j'ai essayer ton code test voilà ce que j’obtiens
cordialement

Windows Seven 32 : PureBasic 5.73 LTS (Windows - x86) : intel CPU Quad Q9550

01F445F8 43 00 6F 00 70 00 79 00 72 00 69 00 67 00 68 00 C.o.p.y.r.i.g.h.
01F44608 74 00 20 00 28 00 63 00 29 00 20 00 32 00 30 00 t. .(.c.). .2.0.
01F44618 30 00 39 00 20 00 4D 00 69 00 63 00 72 00 6F 00 0.9. .M.i.c.r.o.
01F44628 73 00 6F 00 66 00 74 00 20 00 43 00 6F 00 72 00 s.o.f.t. .C.o.r.
01F44638 70 00 6F 00 72 00 61 00 74 00 69 00 6F 00 6E 00 p.o.r.a.t.i.o.n.
01F44648 2E 00 20 00 54 00 6F 00 75 00 73 00 20 00 64 00 .. .T.o.u.s. .d.
01F44658 72 00 6F 00 69 00 74 00 73 00 20 00 72 00 FD FF r.o.i.t.s. .r.ýÿ
01F44668 73 00 65 00 72 00 76 00 FD FF 73 00 2E 00 ...... s.e.r.v.ýÿs...


#PB_Compiler_Debugger=1
alpha$= !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~
chain$=Microsoft Windows [version 6.1.7601]
chain$=Copyright (c) 2009 Microsoft Corporation. Tous droits r serv s.
chain$=Copyright (c) 2009 Microsoft Corporation. Tous droits r serv s.

;Rapport
[09 :03 :48] Attente du démarrage du programme...
[09 :03 :48] Type d'exécutable: Windows - x86 (32bit, Unicode)
[09 :03 :48] Exécutable démarré.
[09 :03 :48] [AVERTISSEMENT] Ligne: 31
[09 :03 :48] [AVERTISSEMENT] warning Un Caractère >$7F
[09 :03 :48] [ERREUR] Ligne: 32
[09 :03 :48] [ERREUR] Un Caractère >$7F

[Mesa]

jhpjhp a fait cette console qui marche bien chez moi.

ici http://frazier.wood.free.fr/pb/AltConsole.rar tu trouveras plein d'exemples intéressant.

Code : Tout sélectionner

Structure CONSOLE_HANDLES
  hStdInput.l
  hStdOutput.l
  hStdError.l
EndStructure

Structure CONSOLE_FONT_INFO
  nFont.l
  dwFontSize.COORD
EndStructure

Global altHandle.CONSOLE_HANDLES
Global cmdHandle.CONSOLE_HANDLES
Global ascRawKey.c

Prototype protoGetConsoleWindow()
Prototype protoAttachConsole(dwProcessId)

Procedure ShowConsole(State = 1)
  If State < 0 : State = 1 : EndIf
  If State > 3 : State = 1 : EndIf

  Protected GetConsoleWindow.protoGetConsoleWindow
  kernel32 = OpenLibrary(#PB_Any, "kernel32.dll")

  If IsLibrary(kernel32)
    GetConsoleWindow = GetFunction(kernel32, "GetConsoleWindow")
    hConsole = GetConsoleWindow()
    ShowWindow_(hConsole, State)
    CloseLibrary(kernel32)
  EndIf
EndProcedure

Procedure BringWindowToTop(hWnd)
  ForeThread = GetWindowThreadProcessId_(GetForegroundWindow_(), #Null)
  AppThread = GetCurrentThreadId_()

  If ForeThread <> AppThread
    AttachThreadInput_(ForeThread, AppThread, #True)
    BringWindowToTop_(hWnd)
    ShowWindow_(hWnd, #SW_SHOW)
    AttachThreadInput_(ForeThread, AppThread, #False)
  Else
    BringWindowToTop_(hWnd)
    ShowWindow_(hWnd, #SW_SHOW)
  EndIf
EndProcedure

Procedure.w GetColors(CharacterColor, BackgroundColor)
  wAttribute.w = #Null

  Select CharacterColor
    Case 0
    Case 1 : wAttribute = #FOREGROUND_BLUE
    Case 2 : wAttribute = #FOREGROUND_GREEN
    Case 3 : wAttribute = #FOREGROUND_BLUE | #FOREGROUND_GREEN
    Case 4 : wAttribute = #FOREGROUND_RED
    Case 5 : wAttribute = #FOREGROUND_RED | #FOREGROUND_BLUE
    Case 6 : wAttribute = #FOREGROUND_RED | #FOREGROUND_GREEN
    Case 7 : wAttribute = #FOREGROUND_RED | #FOREGROUND_BLUE | #FOREGROUND_GREEN
    Case 8 : wAttribute = #FOREGROUND_INTENSITY
    Case 9 : wAttribute = #FOREGROUND_BLUE | #FOREGROUND_INTENSITY
    Case 10 : wAttribute = #FOREGROUND_GREEN | #FOREGROUND_INTENSITY
    Case 11 : wAttribute = #FOREGROUND_BLUE | #FOREGROUND_GREEN | #FOREGROUND_INTENSITY
    Case 12 : wAttribute = #FOREGROUND_RED | #FOREGROUND_INTENSITY
    Case 13 : wAttribute = #FOREGROUND_RED | #FOREGROUND_BLUE | #FOREGROUND_INTENSITY
    Case 14 : wAttribute = #FOREGROUND_RED | #FOREGROUND_GREEN | #FOREGROUND_INTENSITY
    Case 15 : wAttribute = #FOREGROUND_RED | #FOREGROUND_BLUE | #FOREGROUND_GREEN | #FOREGROUND_INTENSITY
    Default : wAttribute = #FOREGROUND_RED | #FOREGROUND_BLUE | #FOREGROUND_GREEN
  EndSelect

  Select BackgroundColor
    Case 1 : wAttribute | #BACKGROUND_BLUE
    Case 2 : wAttribute | #BACKGROUND_GREEN
    Case 3 : wAttribute | #BACKGROUND_BLUE | #BACKGROUND_GREEN
    Case 4 : wAttribute | #BACKGROUND_RED
    Case 5 : wAttribute | #BACKGROUND_RED | #BACKGROUND_BLUE
    Case 6 : wAttribute | #BACKGROUND_RED | #BACKGROUND_GREEN
    Case 7 : wAttribute | #BACKGROUND_RED | #BACKGROUND_BLUE | #BACKGROUND_GREEN
    Case 8 : wAttribute | #BACKGROUND_INTENSITY
    Case 9 : wAttribute | #BACKGROUND_BLUE | #BACKGROUND_INTENSITY
    Case 10 : wAttribute | #BACKGROUND_GREEN | #BACKGROUND_INTENSITY
    Case 11 : wAttribute | #BACKGROUND_BLUE | #BACKGROUND_GREEN | #BACKGROUND_INTENSITY
    Case 12 : wAttribute | #BACKGROUND_RED | #BACKGROUND_INTENSITY
    Case 13 : wAttribute | #BACKGROUND_RED | #BACKGROUND_BLUE | #BACKGROUND_INTENSITY
    Case 14 : wAttribute | #BACKGROUND_RED | #BACKGROUND_GREEN | #BACKGROUND_INTENSITY
    Case 15 : wAttribute | #BACKGROUND_RED | #BACKGROUND_BLUE | #BACKGROUND_GREEN | #BACKGROUND_INTENSITY
  EndSelect
  ProcedureReturn wAttribute
EndProcedure

Procedure HandlerRoutine(dwCtrlType)
  Select dwCtrlType
    Case #CTRL_CLOSE_EVENT
      SetConsoleCtrlHandler_(@HandlerRoutine(), #False)
      FreeConsole_() : End
  EndSelect
  ProcedureReturn #True
EndProcedure

Procedure altOpenConsole(State = 1, Title.s = "Alternative Console", xColumn = 80, yRow = 300)
  Protected GetConsoleWindow.protoGetConsoleWindow
  Result = #False

  If AllocConsole_()
    If State < 0 : State = 1 : EndIf
    If State > 3 : State = 1 : EndIf

    SetConsoleTitle_(Title)
    altHandle\hStdInput = GetStdHandle_(#STD_INPUT_HANDLE)
    altHandle\hStdOutput = GetStdHandle_(#STD_OUTPUT_HANDLE)
    altHandle\hStdError = GetStdHandle_(#STD_ERROR_HANDLE)
    dwSize.COORD
    dwSize\x = xColumn
    dwSize\y = yRow
    SetConsoleScreenBufferSize_(altHandle\hStdOutput, PeekL(@dwSize))

    If State <> 1 : ShowConsole(State) : EndIf

    If State = 1 Or State = 3
      kernel32 = OpenLibrary(#PB_Any, "kernel32.dll")

      If IsLibrary(kernel32)
        GetConsoleWindow = GetFunction(kernel32, "GetConsoleWindow")
        hConsole = GetConsoleWindow()
        BringWindowToTop(hConsole)
        CloseLibrary(kernel32)
      EndIf
    EndIf
    SetConsoleCtrlHandler_(@HandlerRoutine(), #True)
    Result = #True
  EndIf
  ProcedureReturn Result
EndProcedure

Procedure altConsoleTitle(Title.s = "Alternative Console")
  SetConsoleTitle_(Title)
EndProcedure

Procedure.s altPrint(Text.s = " ", nRepeat = 1)
  For rtnCount = 1 To nRepeat
    WriteConsole_(altHandle\hStdOutput, Text, Len(Text), @lpNumberOfCharsWritten, #Null)
  Next
EndProcedure

Procedure.s altPrintN(Text.s = #Null$, nRepeat = 1)
  Text + Chr(10)

  For rtnCount = 1 To nRepeat
    WriteConsole_(altHandle\hStdOutput, Text, Len(Text), @lpNumberOfCharsWritten, #Null)
  Next
EndProcedure

Procedure altFillChar(Character, nLength = 1)
  If nLength <= 0 : nLength = 1 : EndIf

  lpConsoleScreenBufferInfo.CONSOLE_SCREEN_BUFFER_INFO

  If GetConsoleScreenBufferInfo_(altHandle\hStdOutput, @lpConsoleScreenBufferInfo)
    dwWriteCoord.COORD
    dwWriteCoord\x = lpConsoleScreenBufferInfo\dwCursorPosition\x
    dwWriteCoord\y = lpConsoleScreenBufferInfo\dwCursorPosition\y
    FillConsoleOutputCharacter_(altHandle\hStdOutput, Character, nLength, PeekL(@dwWriteCoord), @lpNumberOfCharsWritten)
  EndIf
EndProcedure

Procedure altFillColor(CharacterColor = 7, BackgroundColor = 0, nLength = 1)
  If nLength <= 0 : nLength = 1 : EndIf

  wAttribute.w = GetColors(CharacterColor, BackgroundColor)
  lpConsoleScreenBufferInfo.CONSOLE_SCREEN_BUFFER_INFO

  If GetConsoleScreenBufferInfo_(altHandle\hStdOutput, @lpConsoleScreenBufferInfo)
    dwWriteCoord.COORD
    dwWriteCoord\x = lpConsoleScreenBufferInfo\dwCursorPosition\x
    dwWriteCoord\y = lpConsoleScreenBufferInfo\dwCursorPosition\y
    FillConsoleOutputAttribute_(altHandle\hStdOutput, wAttribute, nLength, PeekL(@dwWriteCoord), @lpNumberOfAttrsWritten)
  EndIf
EndProcedure

Procedure altConsoleColor(CharacterColor = 7, BackgroundColor = 0, Mode = 0)
  If Mode < 0 : Mode = 0 : EndIf

  wAttribute.w = GetColors(CharacterColor, BackgroundColor)

  If Mode
    lpConsoleScreenBufferInfo.CONSOLE_SCREEN_BUFFER_INFO

    If GetConsoleScreenBufferInfo_(altHandle\hStdOutput, @lpConsoleScreenBufferInfo)
      nLength = lpConsoleScreenBufferInfo\dwSize\x * lpConsoleScreenBufferInfo\dwSize\y
      dwCursorPosition.COORD
      dwCursorPosition\x = 0
      dwCursorPosition\y = 0
      FillConsoleOutputAttribute_(altHandle\hStdOutput, wAttribute, nLength, PeekL(@dwCursorPosition), @lpNumberOfAttrsWritten)
    EndIf
  EndIf
  SetConsoleTextAttribute_(altHandle\hStdOutput, wAttribute)
EndProcedure

Procedure altConsoleLocate(xColumn, yRow)
  dwCursorPosition.COORD
  dwCursorPosition\x = xColumn
  dwCursorPosition\y = yRow
  SetConsoleCursorPosition_(altHandle\hStdOutput, PeekL(@dwCursorPosition))
EndProcedure

Procedure.s altReadConsoleData(xColumn = 0, yRow = 0, nLength = 0)
  Result.s = #Null$
  lpConsoleScreenBufferInfo.CONSOLE_SCREEN_BUFFER_INFO

  If GetConsoleScreenBufferInfo_(altHandle\hStdOutput, @lpConsoleScreenBufferInfo)
    If nLength <= 0 : nLength = lpConsoleScreenBufferInfo\dwSize\x * lpConsoleScreenBufferInfo\dwSize\y : EndIf

    nLength * SizeOf(Character)
    lpCharacter.s = Space(nLength)
    dwReadCoord.COORD
    dwReadCoord\x = xColumn
    dwReadCoord\y = yRow
    ReadConsoleOutputCharacter_(altHandle\hStdOutput, @lpCharacter, nLength, PeekL(@dwReadCoord), @lpNumberOfCharsRead)
    lpCharacter = RTrim(lpCharacter)
    nLength = lpConsoleScreenBufferInfo\dwSize\x

    While xPos < Len(lpCharacter)
      Result + RTrim(Mid(lpCharacter, xPos + 1, nLength)) + Chr(10)
      xPos + nLength
    Wend
    Result = Left(Result, Len(Result) - 1)
  EndIf
  ProcedureReturn Result
EndProcedure

Procedure altClearConsole(xColumn = 0, yRow = 0, nLength = 0)
  lpConsoleScreenBufferInfo.CONSOLE_SCREEN_BUFFER_INFO

  If GetConsoleScreenBufferInfo_(altHandle\hStdOutput, @lpConsoleScreenBufferInfo)
    If nLength <= 0 : nLength = lpConsoleScreenBufferInfo\dwSize\x * lpConsoleScreenBufferInfo\dwSize\y : EndIf

    dwCursorPosition.COORD
    dwCursorPosition\x = xColumn
    dwCursorPosition\y = yRow
    FillConsoleOutputCharacter_(altHandle\hStdOutput, Asc(" "), nLength, PeekL(@dwCursorPosition), @lpNumberOfCharsWritten)
    FillConsoleOutputAttribute_(altHandle\hStdOutput, #FOREGROUND_RED | #FOREGROUND_BLUE | #FOREGROUND_GREEN, nLength, PeekL(@dwCursorPosition), @lpNumberOfAttrsWritten)
    SetConsoleCursorPosition_(altHandle\hStdOutput, PeekL(@dwCursorPosition))
  EndIf
EndProcedure

Procedure altNewConsole(State = 99, Title.s = #Null$)
  Protected GetConsoleWindow.protoGetConsoleWindow
  kernel32 = OpenLibrary(#PB_Any, "kernel32.dll")

  If IsLibrary(kernel32)
    GetConsoleWindow = GetFunction(kernel32, "GetConsoleWindow")
    hConsole = GetConsoleWindow()

    If IsWindowVisible_(hConsole)
      lpwndpl.WINDOWPLACEMENT
      lpwndpl\Length = SizeOf(lpwndpl)
      GetWindowPlacement_(hConsole, @lpwndpl)

      If State = 99
        Select lpwndpl\showCmd
          Case 0 : State = 0
          Case 1 : State = 1
          Case 2 : State = 2
          Case 3 : State = 3
          Default : State = 1
        EndSelect
      Else
        If State < 0 : State = 1 : EndIf
        If State > 3 : State = 1 : EndIf
      EndIf
    Else
      State = 0
    EndIf
    CloseLibrary(kernel32)
  EndIf

  If Title = #Null$
    Title = Space(#MAX_PATH)
    GetConsoleTitle_(@Title, #MAX_PATH)
  EndIf
  FreeConsole_()
  altOpenConsole(State, Title)
EndProcedure

Procedure.s altInkey()
  Dim lpBuffer.INPUT_RECORD(1)
  nLength = 1 * SizeOf(Character)
  PeekConsoleInput_(altHandle\hStdInput, @lpBuffer(), nLength, @lpNumberOfEventsRead)

  If lpBuffer(0)\EventType = #KEY_EVENT
    If lpBuffer(0)\Event\KeyEvent\uChar > 0
      ReadConsoleInput_(altHandle\hStdInput, @lpBuffer(), nLength, @lpNumberOfEventsRead)

      If lpBuffer(0)\Event\KeyEvent\bKeyDown
        ascRawKey = lpBuffer(0)\Event\KeyEvent\wVirtualKeyCode
        ProcedureReturn Chr(ascRawKey)
      EndIf
    EndIf
  ElseIf lpBuffer(0)\EventType
    ReadConsoleInput_(altHandle\hStdInput, @lpBuffer(), nLength, @lpNumberOfEventsRead)
  EndIf
  ProcedureReturn #Null$
EndProcedure

Procedure altRawKey()
  If ascRawKey
    tmpRawKey.c = ascRawKey
    ascRawKey = 0
  Else
    Dim lpBuffer.INPUT_RECORD(1)
    nLength = 1 * SizeOf(Character)
    PeekConsoleInput_(altHandle\hStdInput, @lpBuffer(), nLength, @lpNumberOfEventsRead)

    If lpBuffer(0)\EventType = #KEY_EVENT
      ReadConsoleInput_(altHandle\hStdInput, @lpBuffer(), nLength, @lpNumberOfEventsRead)

      If lpBuffer(0)\Event\KeyEvent\bKeyDown
        ascRawKey = lpBuffer(0)\Event\KeyEvent\wVirtualKeyCode
        tmpRawKey = ascRawKey
      EndIf
    ElseIf lpBuffer(0)\EventType
      ReadConsoleInput_(altHandle\hStdInput, @lpBuffer(), nLength, @lpNumberOfEventsRead)
    EndIf
  EndIf
  ProcedureReturn tmpRawKey
EndProcedure

Procedure altConsoleImage(ImageName.s = #Null$, nDelay = 1000)
  UseJPEGImageDecoder() : UsePNGImageDecoder()
  lpConsoleCurrentFont.CONSOLE_FONT_INFO
  GetCurrentConsoleFont_(altHandle\hStdOutput, #True, @lpConsoleCurrentFont)
  FontSize = GetConsoleFontSize_(altHandle\hStdOutput, lpConsoleCurrentFont\nFont)
  lpConsoleCurrentFont\dwFontSize\x = FontSize & $FFFF
  lpConsoleCurrentFont\dwFontSize\y = (FontSize >> 16) & $FFFF
  fRatio.d = lpConsoleCurrentFont\dwFontSize\x / lpConsoleCurrentFont\dwFontSize\y
  lpConsoleScreenBufferInfo.CONSOLE_SCREEN_BUFFER_INFO

  If GetConsoleScreenBufferInfo_(altHandle\hStdOutput, @lpConsoleScreenBufferInfo)
    iWidth = lpConsoleScreenBufferInfo\dwSize\x - 1
    Dim cArray.s(11) : Define sFactor.d, cImage.s
    cArray(0) = "#" : cArray(1) = "@" : cArray(2) = "&" : cArray(3) = "%" : cArray(4) = "=" : cArray(5) = "+"
    cArray(6) = "*" : cArray(7) = ":" : cArray(8) = "-" : cArray(9) = "." : cArray(10) = " "
    aSize = ArraySize(cArray()) - 1

    Select #True
      Case Bool(FileSize(ImageName) = -1)
        ImageName = OpenFileRequester("Draw Console Image", #PB_Compiler_FilePath + "images\", "Images Files|*.jpg;*.png;*.bmp", 0, #PB_Requester_MultiSelection)

        While ImageName
          If LCase(Right(ImageName, 4)) = ".jpg" Or LCase(Right(ImageName, 4)) = ".png" Or LCase(Right(ImageName, 4)) = ".bmp"
            hImage = LoadImage(#PB_Any, ImageName)

            If IsImage(hImage)
              tWidth = ImageWidth(hImage)
              tHeight = ImageHeight(hImage)
              sFactor = iWidth / tWidth
              iHeight = (tHeight * sFactor) * fRatio
              ResizeImage(hImage, iWidth, iHeight)
              cImage = #Null$

              If StartDrawing(ImageOutput(hImage))
                For yPos = 0 To iHeight - 1
                  For xPos = 0 To iWidth - 1
                    pColor = Point(xPos, yPos)
                    gScale = (Red(pColor) + Green(pColor) + Blue(pColor)) / 3
                    cIndex = Round(gScale * aSize / 255, #PB_Round_Up)
                    cImage + cArray(cIndex)
                  Next
                  cImage + Chr(10)
                Next
                StopDrawing()
              EndIf
              FreeImage(hImage)
              altClearConsole()
              altPrint(cImage)
              altConsoleLocate(0, 0)
              Delay(nDelay)
            EndIf
          EndIf
          ImageName = NextSelectedFileName()
        Wend
      Case Bool(FileSize(ImageName) = -2)
        FolderName.s = ImageName
        PathAddBackslash_(FolderName)

        If ExamineDirectory(0, FolderName, "*.*")
          While NextDirectoryEntry(0)
            If DirectoryEntryType(0) = #PB_DirectoryEntry_File
              ImageName = FolderName + DirectoryEntryName(0)

              If LCase(Right(ImageName, 4)) = ".jpg" Or LCase(Right(ImageName, 4)) = ".png" Or LCase(Right(ImageName, 4)) = ".bmp"
                hImage = LoadImage(#PB_Any, ImageName)

                If IsImage(hImage)
                  tWidth = ImageWidth(hImage)
                  tHeight = ImageHeight(hImage)
                  sFactor = iWidth / tWidth
                  iHeight = (tHeight * sFactor) * fRatio
                  ResizeImage(hImage, iWidth, iHeight)
                  cImage = #Null$

                  If StartDrawing(ImageOutput(hImage))
                    For yPos = 0 To iHeight - 1
                      For xPos = 0 To iWidth - 1
                        pColor = Point(xPos, yPos)
                        gScale = (Red(pColor) + Green(pColor) + Blue(pColor)) / 3
                        cIndex = Round(gScale * aSize / 255, #PB_Round_Up)
                        cImage + cArray(cIndex)
                      Next
                      cImage + Chr(10)
                    Next
                    StopDrawing()
                  EndIf
                  FreeImage(hImage)
                  altClearConsole()
                  altPrint(cImage)
                  altConsoleLocate(0, 0)
                  Delay(nDelay)
                EndIf
              EndIf
            EndIf
          Wend
          FinishDirectory(0)
        EndIf
    EndSelect
  EndIf
EndProcedure

Procedure altConsoleAnimate(hImage)
  lpConsoleCurrentFont.CONSOLE_FONT_INFO
  GetCurrentConsoleFont_(altHandle\hStdOutput, #True, @lpConsoleCurrentFont)
  FontSize = GetConsoleFontSize_(altHandle\hStdOutput, lpConsoleCurrentFont\nFont)
  lpConsoleCurrentFont\dwFontSize\x = FontSize & $FFFF
  lpConsoleCurrentFont\dwFontSize\y = (FontSize >> 16) & $FFFF
  fRatio.d = lpConsoleCurrentFont\dwFontSize\x / lpConsoleCurrentFont\dwFontSize\y
  lpConsoleScreenBufferInfo.CONSOLE_SCREEN_BUFFER_INFO

  If GetConsoleScreenBufferInfo_(altHandle\hStdOutput, @lpConsoleScreenBufferInfo)
    iWidth = lpConsoleScreenBufferInfo\dwSize\x - 1
    Dim cArray.s(11) : Define sFactor.d, cImage.s
    cArray(0) = "#" : cArray(1) = "@" : cArray(2) = "&" : cArray(3) = "%" : cArray(4) = "=" : cArray(5) = "+"
    cArray(6) = "*" : cArray(7) = ":" : cArray(8) = "-" : cArray(9) = "." : cArray(10) = " "
    aSize = ArraySize(cArray()) - 1
    tWidth = ImageWidth(hImage)
    tHeight = ImageHeight(hImage)
    sFactor = iWidth / tWidth
    iHeight = (tHeight * sFactor) * fRatio
    ResizeImage(hImage, iWidth, iHeight)

    If StartDrawing(ImageOutput(hImage))
      For yPos = 0 To iHeight - 2
        For xPos = 0 To iWidth - 4
          pColor = Point(xPos, yPos)
          gScale = (Red(pColor) + Green(pColor) + Blue(pColor)) / 3
          cIndex = Round(gScale * aSize / 255, #PB_Round_Up)
          cImage + cArray(cIndex)
        Next
        cImage + Chr(10)
      Next
      StopDrawing()
    EndIf
    FreeImage(hImage)
    WriteConsole_(altHandle\hStdOutput, cImage, Len(cImage), @lpNumberOfCharsWritten, #Null)
    dwCursorPosition.COORD
    dwCursorPosition\x = 0
    dwCursorPosition\y = 0
    SetConsoleCursorPosition_(altHandle\hStdOutput, PeekL(@dwCursorPosition))
  EndIf
EndProcedure

Procedure.s altInput(Text.s = #Null$)
  lpBuffer.s = #Null$
  lpConsoleScreenBufferInfo.CONSOLE_SCREEN_BUFFER_INFO

  If GetConsoleScreenBufferInfo_(altHandle\hStdOutput, @lpConsoleScreenBufferInfo)
    If Len(Text) > 0
      altConsoleLocate(0, lpConsoleScreenBufferInfo\srWindow\bottom)
      altPrint(Text)
    EndIf
    nNumberOfCharsToRead = lpConsoleScreenBufferInfo\dwSize\x * lpConsoleScreenBufferInfo\dwSize\y
    nNumberOfCharsToRead - lpConsoleScreenBufferInfo\dwCursorPosition\x * lpConsoleScreenBufferInfo\dwCursorPosition\y
    lpBuffer = Space(nNumberOfCharsToRead)
    ReadConsole_(altHandle\hStdInput, @lpBuffer, nNumberOfCharsToRead, @lpNumberOfCharsRead, #Null)
  EndIf
  ProcedureReturn RTrim(lpBuffer)
EndProcedure

Procedure cmdOpenConsole(State = 1, Title.s = "Command Console")
  Protected AttachConsole.protoAttachConsole
  Protected GetConsoleWindow.protoGetConsoleWindow

  If State < 0 : State = 1 : EndIf
  If State > 3 : State = 1 : EndIf

  Result = #False
  lpStartupInfo.STARTUPINFO
  lpStartupInfo\cb = SizeOf(STARTUPINFO)
  lpStartupInfo\lpReserved = #Null
  lpStartupInfo\lpDesktop = #Null
  lpStartupInfo\lpTitle = @Title
  lpStartupInfo\dwX = 0
  lpStartupInfo\dwY = 0
  lpStartupInfo\dwXSize = 640
  lpStartupInfo\dwYSize = 300
  lpStartupInfo\dwXCountChars = 80
  lpStartupInfo\dwYCountChars = 5000
  lpStartupInfo\dwFillAttribute = #FOREGROUND_RED | #BACKGROUND_RED | #BACKGROUND_GREEN | #BACKGROUND_BLUE
  lpStartupInfo\dwFlags = #STARTF_USECOUNTCHARS | #STARTF_USEFILLATTRIBUTE | #STARTF_USEPOSITION | #STARTF_USESHOWWINDOW | #STARTF_USESIZE
  lpStartupInfo\wShowWindow = State
  lpStartupInfo\cbReserved2 = 0
  lpStartupInfo\lpReserved2 = #Null
  lpStartupInfo\hStdInput = #Null
  lpStartupInfo\hStdOutput = #Null
  lpStartupInfo\hStdError = #Null
  lpProcessAttributes.SECURITY_ATTRIBUTES
  lpProcessAttributes\nLength = SizeOf(SECURITY_ATTRIBUTES)
  lpProcessAttributes\lpSecurityDescriptor = #Null
  lpProcessAttributes\bInheritHandle = #False
  lpThreadAttributes.SECURITY_ATTRIBUTES
  lpThreadAttributes\nLength = SizeOf(SECURITY_ATTRIBUTES)
  lpThreadAttributes\lpSecurityDescriptor = #Null
  lpThreadAttributes\bInheritHandle = #False
  lpProcessInformation.PROCESS_INFORMATION
  lpCommandLine.s = "cmd.exe"

  If CreateProcess_(#Null, @lpCommandLine, lpProcessAttributes, lpThreadAttributes, #False, #CREATE_NEW_CONSOLE | #NORMAL_PRIORITY_CLASS, #Null, #Null, lpStartupInfo, @lpProcessInformation)
    Delay(200)
    kernel32 = OpenLibrary(#PB_Any, "kernel32.dll")

    If IsLibrary(kernel32)
      AttachConsole = GetFunction(kernel32, "AttachConsole")

      If AttachConsole(lpProcessInformation\dwProcessId)
        cmdHandle\hStdInput = GetStdHandle_(#STD_INPUT_HANDLE)
        cmdHandle\hStdOutput = GetStdHandle_(#STD_OUTPUT_HANDLE)
        cmdHandle\hStdError = GetStdHandle_(#STD_ERROR_HANDLE)

        If State = 1 Or State = 3
          GetConsoleWindow = GetFunction(kernel32, "GetConsoleWindow")
          hConsole = GetConsoleWindow()
          BringWindowToTop(hConsole)
        EndIf
        SetConsoleCtrlHandler_(@HandlerRoutine(), #True)
        Result = #True
      EndIf
      CloseLibrary(kernel32)
    EndIf
  EndIf
  ProcedureReturn Result
EndProcedure

Procedure cmdChangeColor(CharacterColor = 7, BackgroundColor = 0)
  wAttribute.w = GetColors(CharacterColor, BackgroundColor)
  lpConsoleScreenBufferInfo.CONSOLE_SCREEN_BUFFER_INFO

  If GetConsoleScreenBufferInfo_(cmdHandle\hStdOutput, @lpConsoleScreenBufferInfo)
    nLength = lpConsoleScreenBufferInfo\dwSize\x * lpConsoleScreenBufferInfo\dwSize\y
    dwCursorPosition.COORD
    dwCursorPosition\x = 0
    dwCursorPosition\y = 0
    FillConsoleOutputAttribute_(cmdHandle\hStdOutput, wAttribute, nLength, PeekL(@dwCursorPosition), @lpNumberOfAttrsWritten)
    SetConsoleTextAttribute_(cmdHandle\hStdOutput, wAttribute)
  EndIf
EndProcedure

Procedure cmdAddAlias(Source.s, Target.s, ExeName.s = "cmd.exe")
  AddConsoleAlias_(Source, Target, ExeName)
EndProcedure

Procedure cmdRunScript(Text.s, RunAndWait = #False)
  If LCase(Right(Text, 4)) <> "exit" : Text + Chr(13) : EndIf

  nLength = Len(Text) + 1

  If nLength > 1
    Dim lpBuffer.INPUT_RECORD(nLength)

    For rtnCount = 0 To nLength - 2
      ascKey = Asc(Mid(Text, rtnCount + 1, 1))
      vkKey = VkKeyScanEx_(ascKey, GetKeyboardLayout_(0)) & $FF
      lpBuffer(rtnCount)\EventType = #KEY_EVENT
      lpBuffer(rtnCount)\Event\KeyEvent\bKeyDown = #True
      lpBuffer(rtnCount)\Event\KeyEvent\dwControlKeyState = 0
      lpBuffer(rtnCount)\Event\KeyEvent\uChar = ascKey
      lpBuffer(rtnCount)\Event\KeyEvent\wRepeatCount = 1
      lpBuffer(rtnCount)\Event\KeyEvent\wVirtualKeyCode = vkKey
      lpBuffer(rtnCount)\Event\KeyEvent\wVirtualScanCode = MapVirtualKey_(vkKey, 0)
    Next
    lpBuffer(nLength - 1)\EventType = #KEY_EVENT
    lpBuffer(nLength - 1)\Event\KeyEvent\bKeyDown = #True
    lpBuffer(nLength - 1)\Event\KeyEvent\dwControlKeyState = 0
    lpBuffer(nLength - 1)\Event\KeyEvent\uChar = #VK_RETURN
    lpBuffer(nLength - 1)\Event\KeyEvent\wRepeatCount = 1
    lpBuffer(nLength - 1)\Event\KeyEvent\wVirtualKeyCode = #VK_RETURN
    lpBuffer(nLength - 1)\Event\KeyEvent\wVirtualScanCode = MapVirtualKey_(#VK_RETURN, 0)
    WriteConsoleInput_(cmdHandle\hStdInput, @lpBuffer(), nLength, @lpNumberOfCharsWritten)

    If RunAndWait
      Repeat
        Result = WaitForSingleObject_(cmdHandle\hStdInput, 100)

        Select Result
          Case #WAIT_ABANDONED : Break
          Case #WAIT_OBJECT_0 : Delay(100)
          Case #WAIT_TIMEOUT : Break
          Case #WAIT_FAILED : Break
        EndSelect
      ForEver
    Else
      Delay(200)
    EndIf
  EndIf
EndProcedure

Procedure cmdRunBatch(FileName.s = #Null$, RunAndWait = #False)
  If FileName = #Null$
    FileName = OpenFileRequester("Alternative Command Console", StandardFile$, "Batch Files (*.bat)|*.bat|Text Files (*.txt)|*.txt", 0)
  EndIf

  If FileSize(FileName) > 0
    If ReadFile(0, FileName)
      While Not Eof(0)
        cmdRunScript(ReadString(0), RunAndWait)
      Wend
      CloseFile(0)
    EndIf
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure

Procedure.s cmdReadConsole(nLeft = 0, nTop = 0, nRight = 0, nBottom = 0)
  Result.s = #Null$
  lpConsoleScreenBufferInfo.CONSOLE_SCREEN_BUFFER_INFO

  If GetConsoleScreenBufferInfo_(cmdHandle\hStdOutput, @lpConsoleScreenBufferInfo)
    If nLeft < 0
      nLeft = 0
    Else
      If nLeft > lpConsoleScreenBufferInfo\dwSize\x - 1 : nLeft = 0 : EndIf
    EndIf

    If nTop < 0
      nTop = 0
    Else
      If nTop > lpConsoleScreenBufferInfo\srWindow\bottom - 1 : nTop = 0 : EndIf
    EndIf

    If nRight <= 0
      nRight = lpConsoleScreenBufferInfo\dwSize\x - 1
    Else
      If nRight > lpConsoleScreenBufferInfo\dwSize\x - 1 : nRight = lpConsoleScreenBufferInfo\dwSize\x - 1 : Else : nRight + 1 : EndIf
    EndIf

    If nBottom <= 0
      nBottom = lpConsoleScreenBufferInfo\srWindow\bottom
    Else
      If nBottom > lpConsoleScreenBufferInfo\srWindow\bottom : nBottom = lpConsoleScreenBufferInfo\srWindow\bottom : EndIf
    EndIf

    If nBottom > 150 : BufferSize = 150 : Else : BufferSize = nBottom : EndIf

    Dim lpBuffer.CHAR_INFO(BufferSize, nRight - 1) : Define.s cRow

    Repeat
      dwBufferSize.COORD
      dwBufferSize\x = nRight
      dwBufferSize\y = BufferSize + 1
      dwBufferCoord.COORD
      dwBufferCoord\x = 0
      dwBufferCoord\y = 0
      lpReadRegion.SMALL_RECT
      lpReadRegion\left = nLeft
      lpReadRegion\top = nTop + Increment
      lpReadRegion\right = nRight - 2
      lpReadRegion\bottom = BufferSize - 1 + Increment
      ReadConsoleOutput_(cmdHandle\hStdOutput, @lpBuffer(), PeekL(@dwBufferSize), PeekL(@dwBufferCoord), @lpReadRegion)

      For yPos = 0 To BufferSize - 1
        cRow = #Null$

        For xPos = 0 To nRight - 2
          cRow + Chr(lpBuffer(yPos, xPos)\Char)
        Next
        Result + RTrim(cRow) + Chr(10)

        If Increment + yPos >= nBottom : Break 2 : EndIf

      Next
      Increment + 150
    ForEver

    While Right(Result, 1) = Chr(10)
      Result = Left(Result, Len(Result) - 1)
    Wend
  EndIf
  ProcedureReturn Result
EndProcedure

Procedure cmdCloseConsole()
  cmdRunScript("exit")
  FreeConsole_()
EndProcedure




;=============MAIN===========
If cmdOpenConsole()
  cmdRunScript("help assoc", #True)
  cmdRunScript("tree c:\windows", #True)
  ConsoleText.s = cmdReadConsole()
;   cmdCloseConsole()
  Debug ConsoleText
EndIf

M.

[PAPIPP]

Merci à kernadece et à Mesa
A Kernadec
Le pb est bien présent on voit que les caractères accentués sont remplacés par $FDFF
Le pb est toujours présent chez toi

A Mesa
Merci pour ces prg mais cela ne résout pas mon pb
En effet le prg fonctionne bien, mais il utilise plus d’une dizaine d’API de chez Microsoft 75 fois
Le pb se situe sur l’instruction runprogram avec pour commande CMD qui renvoie des chaines de caractères altérés.
La bogue est très certainement dans l’instruction runprogram mais je voudrai en être certain.
C’est pourquoi je vous ai fait part de mon pb
A+

[Mesa]

Voici mon avis : J'ai toujours entendu dire que ce problème était insoluble (sauf à utiliser le code donné) car les fonctions que l'on passe par CMD, n'ont pas toutes été codées en même temps, loin de là, certaines sont très anciennes et sont restées en ascii, etc...
Ce qui fonctionnera pour "help", ne fonctionnera pas pour "tree", et c'est du cas par cas... Il faut donc un grand nombre d'api.

Je ne pense pas que runprogram soit boggué.

M.

[PAPIPP]

Merci Mesa de ta réponse

Je suis absent sur le forum depuis 2 ans et c’est pourquoi cette erreur m’a échappée.
Pour rattraper le temps perdu je me suis payé toutes les compiles purebasic depuis le PB530 jusqu'à aujourd’hui.
Les compiles avec vérifications ont été réalisées sous window7 64 bits et sous Window10 64 bits en PB 32 bits
En mode ASCII quand le prg l’acceptait et dans tous les autres cas en mode unicode.
Le programme testé est celui qui a été signalé ci-dessus .Je le replace ici pour que vous puissiez le tester vous-même.

RESULTATS

PB530 sous W7 W10 en mode unicode ou ASCII c’est tout BON
PB541 sous W7 W10 en mode unicode ou ASCII c’est tout BON
PB545 sous W7 W10 en mode unicode ou ASCII c’est tout BON c’est le dernier qui donne des résultats OK
Maintenant et à partir de PB 551 où il n’y avait plus la possibilité de compiler au choix en ASCII ou en UNICODE
Les résultats sont mauvais.

J’en tire les conclusions suivantes.
Il y a une bogue dans les purebasic depuis le PB551 cela est peut être lié avec l’option de compiler en UNICODE seulement.
Il me semble qu’il serait bon de le signaler.

Code : Tout sélectionner

;*****************************************************************************
;*
;* PurePunch Contest #3
;*
;* Name     : "Help MSDOS Normal" Aide Msdos Double cliquez sur une ligne
;* Author   : PAPIPP
;* Category : UTIL
;* Date     : 15 / 07 / 09
;*
;*****************************************************************************
;----0---_____1____----2-----_____3____-----4----_____5____-----6----_____7____-
;2345678901234567890123456789012345678901234567890123456789012345678901234567890
Ci$="CMD COMP DATE LABEL MORE PAUSE SORT TIME"
Macro M:Macro : EndMacro:M AGI:AddGadgetItem:EndMacro:#W0=0:#L0=0:#L1=1:#G=2
M RPS :ReadProgramString:EndMacro
:Procedure OW0():
If OpenWindow(#W0, 0, 0, 800, 600, "Dbl Clic")
:ListViewGadget(#L0, 0, 0, 800, 300)
:EditorGadget(#L1, 0, 300, 800, 300,#PB_Editor_ReadOnly)
GadgetToolTip(#L0, "Double Cliquez sur une des ligne pour une aide")
:EndIf
EndProcedure
:Procedure AFCH(Gd,Cm$)
prg=RunProgram("cmd"," /C "+CM$,"",30)
As$=Space($FFFF):ClearGadgetItems(Gd)
:If prg:As$=RPS(prg)
OemToChar_(@as$,@as$)
:AGI(gd,-1,Cm$+" :"+As$)
While ProgramRunning(prg)
:As$ =RPS(prg)
:OemToChar_(@as$,@as$)
;
; Petite remarque sur a fonction OemToChar() :
; [url]http://msdn.microsoft.com/en-us/library/ms647493(VS.85).aspx[/url]
; En ASCII (contrairement donc au mode UNICODE) pas besoin d'allouer une variable pour le résultat,
; il suffit de mettre le même pointeur qu'en entrée : OemToChar_(@text$, @text$),
;  un remplacement octet par octet est effectué dans la chaine passée en premier argument.

:AGI(Gd,-1, As$)
Wend
:EndIf
:EndProcedure
:OW0():Font1 = LoadFont(#PB_Any, "Courier New",8)
SetGadgetFont(#L0, FontID(Font1)):SetGadgetFont(#L1, FontID(Font1))
AFCH(#L0,"Help ")
:Repeat: WWE = WaitWindowEvent()
:Select WWE
:Case #PB_Event_Gadget
:EG = EventGadget():ET = EventType()
:If EG = #L0
 : EL.l=GetGadgetState(#L0)
 :EL$= GetGadgetItemText(#L0, El):Pos= FindString(el$, " ", 1):
 :CMD$=Mid(el$,1,pos-1)
; :If ET = #PB_EventType_LeftClick ;= 0
   If ET=0
    cmd$="Help "+CMD$
   :AFCH(#L1, CMD$)
   EndIf
: If ET=2
     
   If FindString(Ci$,cmd$, 0)=0
     rs=MessageRequester ("EXECUTION DE "+CMD$,"Voulez vous exécutez cette Cmd", #PB_MessageRequester_YesNo )
     If rs=#PB_MessageRequester_Yes
      Texte$ = InputRequester("EXECUTION "+cmd$ , "Complétez la commande", cmd$+" ")
     ; Controler la commande pour éviter les conneries
      cmd$=texte$
     :AFCH(#L1, CMD$)
     EndIf
     Else
     MessageRequester(cmd$+" Interdite"," Cette cmd : "+ cmd$+" bloque le prg",#PB_MessageRequester_Ok)
    EndIf 
 :EndIf
:EndIf
:Case #PB_Event_CloseWindow
:EW = EventWindow()
:If EW = #W0:CloseWindow(#W0)
:Break
:EndIf
:EndSelect
ForEver
; **********************************

A+

[ChrisR]

Bonjour,

Il n'est pas un bug, il faut utiliser OemToChar API pour Traduire la chaîne de caractères OEM en unicode
Essaye avec ce code :

Code : Tout sélectionner

prog$ = GetEnvironmentVariable("COMSPEC")
;dosbox = RunProgram(prog$, "/c help assoc", "", #PB_Program_Open|#PB_Program_Read|#PB_Program_Write|#PB_Program_Hide|#PB_Program_Ascii)
;dosbox = RunProgram(prog$, "/c Tree c:\windows", "", #PB_Program_Open|#PB_Program_Read|#PB_Program_Write|#PB_Program_Hide|#PB_Program_Ascii)
dosbox = RunProgram(prog$, "", "", #PB_Program_Open|#PB_Program_Read|#PB_Program_Write|#PB_Program_Hide|#PB_Program_Ascii)  ;Ouvre la console sans paramètre, écrit ensuite via WriteProgramStringN : WriteProgramData 

If dosbox 
  OpenWindow(0,0,0,600,500,"Results from DosBox",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
  WriteProgramStringN(dosbox, "help assoc", #PB_Ascii)   ;A commenter si on utilise cmd /c help assoc
  WriteProgramData(dosbox, #PB_Program_Eof, 0)           ;A commenter si on utilise cmd /c help assoc
  ListViewGadget(0,0,0,600,500)
  
  While ProgramRunning(dosbox)
    If AvailableProgramOutput(dosbox)
      sOEM_in_unicode.s = ReadProgramString(dosbox, #PB_Ascii)
      iByteLength = Len(sOEM_in_unicode) + 2
      sOem_in_Ascii.s = Space(iByteLength)
      PokeS(@sOem_in_Ascii, sOEM_in_unicode, -1, #PB_Ascii)
      sUnicode.s = Space(iByteLength)
      OemToChar_(@sOem_in_Ascii, @sUnicode)
      
      AddGadgetItem(0, -1, sUnicode)
      While WindowEvent() : Wend
    EndIf
  Wend
  CloseProgram(dosbox)
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
Else
  MessageRequester("OOPS!", "Can't find " + prog$ )
EndIf

Voir sujet Windows console OEM unicode output

[PAPIPP]

Merci ChrisR

je viens de m'apercevoir que l'instruction runprogram a été modifiée entre PB540 et PB550.
Ceci qui correspond aux résultats que j'ai trouvés.

Je vais étudier ces nouvelles instructions

et encore MERCI ChrisR

A+

[PAPIPP]

Après une plongée dans l’histoire de l’informatique pour trouver une réponse à ce qui m’est arrivé avec ce programme d’aide à MSDOS ,j’ai trouvé et je remercie ici les 3 personnes
1) Kernadec pour avoir confirmé l’erreur constatée
2) Mesa pour m’avoir dit qu’il n’y avait pas de bogue mais que c’était très compliqué (tout est vrai)
3) Chrisr pour m’avoir montré un prg qui fonctionnait correctement.

Pour ceux qui seraient pressés par l’explication qui va suivre, voici le prg corrigé avec une procédure que j’ai appelé BIDOUILLE. Il y a d’autres possibilités
1) l’API multibytetowidecar
2) ou encore avec chaque table de chaque environnement trouver la correspondance.
Le pb avait déjà été abordé en 2016
https://www.purebasic.fr/french/viewtop ... 22#p186422
Pour résumer je reprends à mon compte la formule de djes » mer. 14/sept./2016 18:40

C'est quand je vois ce genre de sujet que j'ai l'impression d'être un dinosaure. (Attention souvenirs de vieux combattant) Que de temps passé, que de travail sur des problèmes de normes, de choix industriels foireux, avec le DOS et ses pages de codes débiles, l'ASCII bancal qui hésitait entre texte et codes de commande (beep ! ), les terminaux genre Minitel et l'ANSI mode BBS avec ses astuces de sioux Esc[s;Esc[u; et aujourd'hui l'unicode qui n'en finit pas de devenir un standard et qui au final ne l'est plus du tout ..

Rien n’a changé c’est toujours de la BIDOUILLE

Code : Tout sélectionner

;*****************************************************************************
;* PurePunch Contest #3
;*
;* Name     : "Help MSDOS Normal" Aide Msdos Double cliquez sur une ligne
;* Author   : PAPIPP
;* Category : UTIL
;* Date     : 15 / 07 / 09
;*
;*****************************************************************************
;----0---_____1____----2-----_____3____-----4----_____5____-----6----_____7____-
;2345678901234567890123456789012345678901234567890123456789012345678901234567890
Global ca.b, PB_Ascii_UNICODE
Ca.b=PeekB(@"AA"+1)
If ca =0;;;;;;  A la place de compilif #PB_Compiler_Unicode
  PB_Ascii_UNICODE=128;;;; =#PB_Program_Ascii = 128
 Else
  PB_Ascii_UNICODE=0 
EndIf  
Procedure.s bidouille(sortie$)
  sortie1$=Space(Len(sortie$)*3)
  sortie2$=sortie1$
  sortie1$=sortie$
  If ca=0;;;  A la place de compilif #PB_Compiler_Unicode
    PokeS(@sortie1$,sortie$,-1,#PB_Ascii) ;;; conversion dans l'environnement UNICODE de l'inicode en ASCII
  EndIf  
  OemToChar_(@sortie1$,@sortie2$) ;;;; conversion ASCII en  UNICODE  (les caractères EQM sont convertis en caractères unicode editables en environnement unicode)
  ProcedureReturn sortie2$
EndProcedure
Ci$="CMD COMP DATE LABEL MORE PAUSE SORT TIME"
; Macro M
;   Macro
;   EndMacro
;   M AGI:AddGadgetItem
; EndMacro
#W0=0:#L0=0:#L1=1:#G=2
; M RPS
; ReadProgramString
; EndMacro
Procedure OW0():
  If OpenWindow(#W0,0,0,800,600,"Dbl Clic")
    ListViewGadget(#L0,0,0,800,300)
    EditorGadget(#L1,0,300,800,300,#PB_Editor_ReadOnly)
    GadgetToolTip(#L0,"Double Cliquez sur une des ligne pour une aide")
  EndIf
EndProcedure
Procedure AFCH(Gd,Cm$)
  ;   #PB_Program_Wait   : Attend jusqu'à ce que le programme lancé se termine.
  ;   #PB_Program_Hide   : Lance le programme en mode invisible.
  ;   #PB_Program_Open   : Ouvre des canaux de communication entre le programme lancé et le programme PureBasic.
  ;   #PB_Program_Read   : Lecture possible sur la sortie standard (stdout).
  ;   #PB_Program_Write  : Ecriture possible sur l'entrée standard (stdin).
  ;   #PB_Program_Error  : Lecture possible sur la sortie d'erreur(stderr).
  ;   #PB_Program_Connect: Connecte la sortie d'un autre programme à l'entrée du programme PureBasic.
  ;   #PB_Program_Ascii  : Les opérations de lecture/écriture se font en mode ASCII.
  ;   #PB_Program_Unicode: Les opérations de lecture/écriture se font en mode Unicode.
  ;   #PB_Program_UTF8   : Les opérations de lecture/écriture se font en mode UTF8. (Par défaut)
  
  ; prg=RunProgram("cmd"," /C "+CM$,"", #PB_Program_Open | #PB_Program_Read |   #PB_Program_UTF8 )
    prg=RunProgram("cmd"," /C "+CM$,"",#PB_Program_Open | #PB_Program_Read | PB_Ascii_UNICODE)
;     prg=RunProgram("cmd"," /C "+CM$,"",#PB_Program_Open | #PB_Program_Read )
  As$=Space($FFFF)
  Bs$=As$
  ClearGadgetItems(Gd)
  If prg: As$=ReadProgramString(prg)
    Bs$=bidouille(As$)
    ; OemToChar_(@as$,@as$)
    ; Debug  mp_h(@as$,128,0)
    AddGadgetItem(gd,-1,Cm$+" :"+Bs$)
    While ProgramRunning(prg)
      As$ =ReadProgramString(prg)
      bs$=bidouille(As$)  ; Debug  mp_h(@as$,128,0)
                          ; OemToChar_(@as$,@as$)
                          ; Debug  mp_h(@as$,128,0)
      
      ;
      ; Petite remarque sur a fonction OemToChar() :
      ; [url]http://msdn.microsoft.com/en-us/library/ms647493(VS.85).aspx[/url]
      ; En ASCII (contrairement donc au mode UNICODE) pas besoin d'allouer une variable pour le résultat,
      ; il suffit de mettre le même pointeur qu'en entrée : OemToChar_(@text$, @text$),
      ;  un remplacement octet par octet est effectué dans la chaine passée en premier argument.
      
      AddGadgetItem(Gd,-1, Bs$)
    Wend
  EndIf
EndProcedure
OW0():Font1 = LoadFont(#PB_Any, "Courier New",8)
SetGadgetFont(#L0, FontID(Font1)):SetGadgetFont(#L1, FontID(Font1))
help$="Help "
AFCH(#L0,help$)

Repeat: WWE = WaitWindowEvent()
  Select WWE
    Case #PB_Event_Gadget
      EG = EventGadget():ET = EventType()
      If EG = #L0
        EL.l=GetGadgetState(#L0)
        EL$= GetGadgetItemText(#L0, El):Pos= FindString(el$, " ", 1):
        CMD$=Mid(el$,1,pos-1)
        ; if ET = #PB_EventType_LeftClick ;= 0
        If ET=0
          cmd$="Help "+CMD$
          AFCH(#L1, CMD$)
        EndIf
        If ET=2
          If FindString(Ci$,cmd$, 0)=0
            rs=MessageRequester ("EXECUTION DE "+CMD$,"Voulez vous exécutez cette Cmd", #PB_MessageRequester_YesNo )
            If rs=#PB_MessageRequester_Yes
              Texte$ = InputRequester("EXECUTION "+cmd$ , "Complétez la commande", cmd$+" ")
              ; Controler la commande pour éviter les conneries
              cmd$=texte$
              AFCH(#L1, CMD$)
            EndIf
          Else
            MessageRequester(cmd$+" Interdite"," Cette cmd : "+ cmd$+" bloque le prg",#PB_MessageRequester_Ok)
          EndIf 
        EndIf
      EndIf
    Case #PB_Event_CloseWindow
      EW = EventWindow()
      If EW = #W0
        CloseWindow(#W0)
        Break
      EndIf
  EndSelect
Until WWE  = #PB_Event_CloseWindow
; **********************************

Explication /
Tous les windows depuis l’origine ont pour base un MSDOS qui comprend plusieurs prg intéressants.
MSDOS a une police de base appelée codepage OEM de chez IBM. Pour connaitre ce codepage sous MSDOS tapez CHCP vous connaitrez alors le codepage de votre MSDOS le mien est le 850 utilisé en Europe occidentale.

Tous les windows ont aussi une police de base appelée codepage différente du codepage de MSDOS .
Elles sont définies pour écrire avec un usage propre à chaque pays.
En effet les alphabets français allemand ou grec etc.. ne sont strictement pas identiques car les lettres accentuées n’existe pas dans tous les pays.
Windows-1252 qui est généralement le codebase de windows en Europe occidentale n'est pas reconnu dans d'autres systèmes d'exploitation : DOS n'utilise que les pages de codes d'IBM, et Linux/Unix utilisent nativement les pages de codes ISO (exemple ISO-8859-15) ou UTF-8.

On voit apparaitre les difficultés.

Tant que l’on reste dans un environnement ASCII (codage de caractère sur UN seul octet)
Microsoft propose l’API OEMtoChar_ qui fonctionnait parfaitement dans le prg depuis 2009.

Mais Purebasic est passé dans un environnement UNICODE (codage des caractères sur 2 octets) alors les Bidouilles sont apparues car avec runprogramm on ne sait pas quel prg sera lancé et la combinatoire déjà importante a augmentée considérablement..
La conversion est donc laissée au libre arbitre du développeur puisqu’il est censé avoir une connaissance du programme qu’il lance à travers runprogram.

Dans l’exemple qui nous intéresse la fonction CMD et ses instructions envoie des caractères OEM850 codé sur un octet mais laissés sur un octet par purebasic dans un environnement ASCII ou ANSI.

Dans l’univers UNICODE n’oubliez pas dans runprogram l’option #PB_PROGRAM_ASCII (Si vous lancez un prg avec une sortie de caractères codés en ASCII).
La même fonction(CMD) envoie toujours des caractères OEM850 sur un octet mais ces caractères sont codés sur 2 octets par purebasic dans l’environnement UNICODE.

Si purebasic lorsqu’il est passé en UNICODE avait laissé passer les informations codées d’origine nous n’aurions pas ce pb (C’est une option prise par les développeurs de purebasic et elle peut se défendre car pour lire le code il faudrait le coder sur deux octets en UNICODE).

Voilà le PB posé.

Avec CMD dans runprogram les codes OEM sont codés SUR 2 octets par purebasic pour appliquer OEMtoCHAR il faut convertir ce code en ASCII (codage sur un octet) voir les conversions de ce type dans

https://www.purebasic.fr/french/viewtop ... 23#p196823

et ensuite on applique OEMTOCHAR qui restitue après codage OEM850 en sortie sur 2 octets en environnement UNICODE un code éditable alors que sur un octet il ne serait pas lisible facilement (essayez et vous verrez.)

UNE VRAI BIDOUILLE

A+

[Kwai chang caine]

Marche nickel !!!
Mon p'tit dej du matin en échange de "BIDOUILLES" comme celle là
Qu'est ce que j'aimerais moi aussi "Bidouiller" comme ça
J'adore les programmes qui communiquent avec la console Windows, alors merci pour ce partage

[Mesa]

Pour info, il y a un problème bizarre en utilisant PB 32bit sur un windows 32bits, certain help ne s'affiche pas du tout, un double clic ne lance pas la commande(?) et n'affiche rien et d'autres commande font une erreur mémoire.

Les commandes qui ne fonctionnent pas avec un simple clic;
Help CHCP :Help CHKDSK :Help COMP :Help CONVERT :Help FC :Help MORE :Help REPLACE :Help XCOPY :

Les commandes qui ne fonctionnent pas avec un double clic;
Pas testé sauf chcp qui effectivemet n'envoie rien après un double clic

Les erreurs: avec Help CHKNTFS :Help DOSKEY :Help FIND :

M.

[PAPIPP]

Bonjour Mesa

Chez mois sous window10 et pb573 32bits ou 64bits

Tous les help(s) fonctionnent normalement à part graftabl que microsoft a du oublier et diskpart qui est une fonction particulière.

Pour le double clic il y a une possibilité c’est de jouer sur le temps entre les deux clics voir souris sous w10 dans panneau de configuration.
et retirer le minuteur comme cela WaitWindowEvent()

Pour éviter le plantage certaines commandes sont interdites à l’exécution voir dans le prg la variable Ci$.

A+