Спецификация HTA ​​/ VBScript c ошибка загрузки файла, возможно, из-за размера - PullRequest
Новая
       96

Спецификация HTA ​​/ VBScript c ошибка загрузки файла, возможно, из-за размера

1 голос
/ 19 апреля 2020

Я пытался разобраться с этой проблемой уже 3 дня, и я хочу навредить себе.

Я создал небольшую утилиту для загрузки файлов с сервера. Скрипт просто перебирает список введенных пользователем сериалов и добавляет каждый в URL файла. Похоже, что он работает нормально по большей части, пока не попадет в большой файл. «Large» - третий сериал, который является единственным тестовым случаем 500 Мб, с которым я столкнулся. Первые два меньше 20мб. Файлы меньшего размера скачиваются нормально, но файл большего размера выдает «Недостаточно ресурсов памяти для выполнения этой операции». ошибка. У меня 16 ГБ оперативной памяти (почти не используется) и более чем достаточно места для хранения.

Вот действительно странная часть, если я только пытаюсь загрузить файл 500 МБ (введите только последний серийный номер), иногда это работает. Я не могу прийти к выводу, в чем причина.

Я включил сильно раздетую версию своего кода. Я думал, что вытаскивание частей может решить проблему или, по крайней мере, пролить свет, но это не устранено. Я был бы благодарен любому, кто может помочь мне решить эту проблему.

Чтобы воссоздать, скопируйте мой скрипт ниже в текстовый файл и переименуйте расширение из .txt в .hta. Чтобы использовать, введите 3 сериала ниже (включая запятые) в текстовое поле и нажмите «Загрузить». Сценарий создает каталог "C: \ Downloads" и размещает загруженные файлы в:

Серийные номера:

BLES01294, BCES00510, BLUS30109

Мой скрипт hta: 

<!DOCTYPE html>
<!-- saved from url=(0014)about:internet -->
<html style="display: inline-block;" id="mainHTML">
<head>
<meta http-equiv="x-ua-compatible" content="ie=9"/>

<title>Download Tool</title>
<!--Styles defined for doc (end)-->
<!--Scripts to control app window size, position, and behavior (start)-->

<script language="VBScript">

    window.resizeTo 500,300
    screenWidth = document.parentwindow.screen.availwidth
    screenHeight = document.parentwindow.screen.availheight
    posLeft = (screenWidth - 800) / 2
    posTop = (screenHeight - 600) / 2     
    window.moveTo posLeft, posTop

</script>
<!--Scripts to control app window size, position, and behavior (end)-->
<!--Features of app window (start)-->
<HTA:APPLICATION ID="download tool"
    APPLICATIONNAME="download tool
    version="ver.2020.4.13"
    CAPTION="yes"
    BORDER="thin"
    BORDERSTYLE="none"
    ICON=""
    CONTEXTMENU="yes"
    MAXIMIZEBUTTON="no"
    MINIMIZEBUTTON="yes"
    NAVIGABLE="no"
    SCROLL="no"
    SCROLLFLAT="no"
    SELECTION="no"
    SHOWINTASKBAR="yes"
    SINGLEINSTANCE="yes"
    SYSMENU="yes"
    WINDOWSTATE="normal">
</head>
<!--Features of app window (end)-->
<body style="display: inline-block;" id="mainBody" >
    <div id="Menu" style="display: inline;"><br>

        <center>
        <span style="display:inline-block;" id="Span_APIText">
            <center>
                <Span style="display: inline-block;">
                    <span  >
                        <textarea style="width:70%;" class="apitextarea" name="txtPS3SerialEntry" rows=6 id="txtPS3SerialEntry"/></textarea>
                    </span>
                    <span id="Span_Buttons2" style="display: inline-block;">
                            <br><br><button id="GetGameDataBtn" title="Browse for download directory" onclick="dataValidation()"><br>Download</button>
                    </span>
                </span>
            </center>
        </span>
        </center>

        </div>
    </div>
</body> 
</html>

<script language="VBScript">

'=================================================
Function dataValidation()

'on error resume next

noBlanks = ""

    EntryTest = trim(ucase(document.getelementbyID("txtPS3SerialEntry").value))

    if EntryTest = "" then
        alert "No valid API numbers found in list"
        exit function

    elseif EntryTest <> "" then
        document.getelementbyID("txtPS3SerialEntry").value = replace(EntryTest,",",vblf)
        chkBlankLines = split(document.getelementbyID("txtPS3SerialEntry").value,vblf)
    else
        chkBlankLines = split(document.getelementbyID("txtPS3SerialEntry").value,vblf)
    end if

    for i = 0 to Ubound(chkBlankLines)
        If Len(trim(chkBlankLines(i))) > 0 then
            noBlanks = noBlanks & chkBlankLines(i) & vbcrlf
        End If
    Next 

    if noBlanks = "" then
        alert "No valid API numbers found in list"
        exit function
    Else
        document.getelementbyID("txtPS3SerialEntry").value = trim(noBlanks)
    End If

    chkNumeric = split(document.getelementbyID("txtPS3SerialEntry").value,vblf)

    call getFiles()

end function

'========================================================

Sub ccSleep(seconds)
    set oShell = CreateObject("Wscript.Shell")
    cmd = "%COMSPEC% /c ping -n " & 1 + seconds & " 127.0.0.1>nul"
    oShell.Run cmd,0,1
End Sub

'============================================================

Function ConvertSize(byteSize) 
    dim Size
    Size = byteSize

    Do While InStr(Size,",") 'Remove commas from size 
        CommaLocate = InStr(Size,",") 
        Size = Mid(Size,1,CommaLocate - 1) & _ 
        Mid(Size,CommaLocate + 1,Len(Size) - CommaLocate) 
    Loop

    Suffix = " Bytes" 
    If Size >= 1024 Then suffix = " KB" 
    If Size >= 1048576 Then suffix = " MB" 
    If Size >= 1073741824 Then suffix = " GB" 
    If Size >= 1099511627776 Then suffix = " TB" 

    Select Case Suffix 
        Case " KB" Size = Round(Size / 1024, 1) 
        Case " MB" Size = Round(Size / 1048576, 1) 
        Case " GB" Size = Round(Size / 1073741824, 1) 
        Case " TB" Size = Round(Size / 1099511627776, 1) 
    End Select

    ConvertSize = Size & Suffix 
End Function

'========================================================================
'Main Function Start
'========================================================================

function GetFiles()

'on error resume next

Set fso = CreateObject("Scripting.FileSystemObject")
path = "c:\Downloads" 'fso.BuildPath("c:\Downloads","")

If NOT fso.FolderExists(path & "\") then
    fso.CreateFolder(path & "\")
end if

arrStr = split(ucase(document.getelementbyID("txtPS3SerialEntry").value),vbLf)

APICount = Ubound(arrStr)

for i = 0 to Ubound(arrStr)

    API = trim(arrStr(i))

    if API <> "" then

        Set IE = CreateObject("internetexplorer.application")
        IE.Visible = false
        IE.Navigate replace("https://a0.ww.np.dl.playstation.net/tpl/np/{game_id}/{game_id}-ver.xml","{game_id}",API)

        Do While IE.Busy or IE.ReadyState <> 4: ccSleep(1): Loop
        Do Until IE.Document.ReadyState = "complete": ccSleep(1): Loop

        on error resume next
            ie.document.getelementbyid("overridelink").click
        on error goto 0

        Do While IE.Busy or IE.ReadyState <> 4: ccSleep(1): Loop
        Do Until IE.Document.ReadyState = "complete": ccSleep(1): Loop

        '============================================================
        id = API

        '============================================================
        'Grab xml elements from site
            for each a in ie.document.getelementsbytagname("package")
                ps3ver = a.getattribute("ps3_system_ver")
                url = a.getattribute("url")
                strFileSize = convertsize(a.getattribute("size"))
                ver = a.getattribute("version")
                strFileName = mid(url,instrrev(url,"/")+1)

                '============================================================

                filename = "c:\Downloads\" & strFileName

                msgbox "Getting file: " & strFileName & " (" & strFileSize & ")"

                Set xHttp = createobject("Microsoft.XMLHTTP")
                Set bStrm = createobject("Adodb.Stream")

                xHttp.Open "GET", url, false
                xHttp.Send

'on error resume next

                with bStrm
                    .type = 1 '//binary
                    .open
                    .write xHttp.responseBody
                    .savetofile filename, 2 '//overwrite
                    .close
                end with

'on error goto 0

'----------------------------------------------------------------

            Next
    end if

Next 'APICount

ie.quit

end function

'========================================================================
</script>
...