PureBasic Forums - English

Code: Select all

Compiler = RunProgram("xh.exe", "--download https://www.purebasic.com/download/PureBasic_Demo_x64.zip", "", #PB_Program_Open | #PB_Program_Read)
  Output$ = ""
  If Compiler
    While ProgramRunning(Compiler)
      If AvailableProgramOutput(Compiler)
        Output$ + ReadProgramString(Compiler) + Chr(13)
      EndIf
    Wend
    Output$ + Chr(13) + Chr(13)
    Output$ + "Exitcode: " + Str(ProgramExitCode(Compiler))
    
    CloseProgram(Compiler)
  EndIf
  MessageRequester("Output", Output$)

Code: Select all

stderr$ = Trim(ReadProgramError(Compiler))
If Len(stderr$)
   Debug stderr$
EndIf

Code: Select all

#CREATE_UNICODE_ENVIRONMENT = $400
Procedure.s XH_GetProgramHeader(url$, DataReturn.s = "tamfichero")
  Protected res$ = ""
  Protected wgetID.i, ExitCode.i
  Protected parametros$
  Protected rutaDestino$
  Protected nlinea.i = 0
  Protected Size.i
  Protected *Buffer = AllocateMemory(4096)
  Protected linea$, porcien$, numPorcientos
  Protected textOut$
  
  parametros$ = " --headers " + url$
  ExitCode = 0
  wgetID   = RunProgram(GetPathPart(ProgramFilename()) + "XH.dat", parametros$, "", #PB_Program_Open | #PB_Program_Read | #PB_Program_Error | #PB_Program_Hide)
  If wgetID And IsProgram(wgetID)
    While ProgramRunning(wgetID)
      linea$ = ""
      Size   = AvailableProgramOutput(wgetID)
      If Size
        Size = ReadProgramData(wgetID, *Buffer, Size)
        If Size
          linea$ = Trim(PeekS(*Buffer, Size, #PB_UTF8 | #PB_ByteLength))
          Debug "|" + Str(nlinea) + "|" + linea$ + "(#)"          
          
          Select DataReturn 
            Case "tamfichero"
              If FindString(LCase(linea$), "content-length:", #PB_String_NoCase)
                res$ = Mid(linea$, FindString(LCase(linea$), "content-length:", #PB_String_NoCase))
                res$ = Trim(StringField(res$, 2, ":"))
                res$ = Trim(Str(Val(res$)))
              EndIf              
            Default
              res$ = linea$
          EndSelect          
          
        EndIf
        
      EndIf

    Wend

    ExitCode = ProgramExitCode(wgetID)
    
    If ExitCode = 0
      Debug "Descarga Correcta"
    Else
      Debug "Error en Descarga, ExitCode: " + Str(ExitCode)
    EndIf
  EndIf
  
  ProcedureReturn res$
  
EndProcedure

Procedure.s XH_ReceiveHttp(url$, filename$, toText.b = #False, gadgetOutputID.i = 0, prefix.s = "", sufix.s = "")
  Protected hReadPipe.l, hWritePipe.l, dwCreationFlags.l, lpPipeAttributes.SECURITY_ATTRIBUTES
  Protected lpStartupInfo.STARTUPINFO
  Protected lpProcessInformation.PROCESS_INFORMATION
  Protected nNumberOfBytesToRead.l
  Protected *lpBuffer
  Protected lpNumberOfBytesRead.l, TotalBytesRead.l
  Protected lpCommandLine$, sizeFile.i
  Protected linea$, textOut$, porcien$, porcienPrevio$, res$, ExitCode.i
  Protected idF.i
  
  res$ = ""
  
  lpCommandLine$ = "xh --headers " + url$
  sizeFile = Val(XH_GetProgramHeader(url$, "tamfichero"))
  Debug "FileSize: " + Str(sizeFile)
  
  If sizeFile
    lpCommandLine$ = "xh --download " + url$
    
    lpPipeAttributes\nLength = SizeOf(SECURITY_ATTRIBUTES)
    lpPipeAttributes\lpSecurityDescriptor = #Null
    lpPipeAttributes\bInheritHandle = #True
  
    If CreatePipe_(@hReadPipe, @hWritePipe, @lpPipeAttributes, 0)
      dwCreationFlags = #NORMAL_PRIORITY_CLASS | #CREATE_UNICODE_ENVIRONMENT
      
      lpStartupInfo\cb = SizeOf(STARTUPINFO)
      lpStartupInfo\dwFlags = #STARTF_USESHOWWINDOW | #STARTF_USESTDHANDLES
      lpStartupInfo\wShowWindow = #SW_HIDE
      lpStartupInfo\hStdOutput = hWritePipe
  
      If CreateProcess_(#Null, @lpCommandLine$, @lpPipeAttributes, @lpPipeAttributes, #True, dwCreationFlags, #Null, #Null, @lpStartupInfo, @lpProcessInformation)
        CloseHandle_(hWritePipe)
        nNumberOfBytesToRead = 2048
        *lpBuffer = AllocateMemory(nNumberOfBytesToRead)
  
        idF = CreateFile(#PB_Any, filename$)
        If IsFile(idF)        
          
          While ReadFile_(hReadPipe, *lpBuffer, nNumberOfBytesToRead, @lpNumberOfBytesRead, #Null)
          
            If lpNumberOfBytesRead
              TotalBytesRead + lpNumberOfBytesRead
              WriteData(idF, *lpBuffer, lpNumberOfBytesRead)
              linea$ = Trim(PeekS(*lpBuffer, lpNumberOfBytesRead, #PB_UTF8 | #PB_ByteLength))
              linea$ = Trim(Str(TotalBytesRead))
              porcien$ = Str(Int(TotalBytesRead *100 / sizeFile)) + "%"
              
              If porcien$ <> porcienPrevio$
                textOut$ = porcien$
                If prefix: textOut$ = prefix + " " + porcien$: EndIf
                If sufix : textOut$ = textOut$ + " " + sufix: EndIf
                Debug textOut$
                If IsGadget(gadgetOutputID)
                  SetGadgetText(gadgetOutputID, textOut$)
                EndIf                
              EndIf
              porcienPrevio$ = porcien$
            Else
              Break
            EndIf
          Wend
          
          CloseFile(idF)
          
          If porcien$ = "100%"      
            Debug "Descarga Correcta"
            res$ = "OK"
          Else
            Debug "Error en Descarga, ExitCode: " + Str(ExitCode)
            res$ = ""          
          EndIf
          
        EndIf
        
        FreeMemory(*lpBuffer)
        CloseHandle_(lpProcessInformation\hThread)
        CloseHandle_(lpProcessInformation\hProcess)
        CloseHandle_(hReadPipe)
      EndIf
    EndIf
    
  EndIf; If sizeFile
    
  If toText = #True And res$ = "OK"
    res$ = ""
    idF = ReadFile(#PB_Any, filename$)
    If IsFile(idF)
      res$ = ReadString(idF, #PB_UTF8, #PB_File_IgnoreEOL)
      CloseFile(idF)
      DeleteFile(filename$)
    EndIf
  EndIf  
  
  ProcedureReturn res$
 
EndProcedure

;-EXAMPLE
CompilerIf #PB_Compiler_IsMainFile
  XH_ReceiveHttp("https://www.purebasic.com/download/PureBasic_Demo_x64.zip", "PureBasic_Demo_x64.zip", #False, 0, "Downloading: ", "please, wait...")
CompilerEndIf