Question

我正在使用Mark Bertenshaw的帖子中的代码：VB6 -- using POST & GET from URL and displaying in VB6 Form

在32位开发机上，Mark的代码工作正常。但是在我的64位计算机上，它在代码中给出了内存不足错误：

m_sOutput = StrConv(AsyncProp.Value, vbUnicode)

从http请求返回的数据非常简单{{response“：2}，或{” response“：6}等。

在32位计算机上，它是从system32文件夹中加载scrrun.dll，但在64位计算机上，它是从sysWOW64文件夹（在参考文献中）中加载。

是因为我认为“内存”错误消息是一条红色鲱鱼而导致了该问题？

用户控制（HTTPService）

Option Explicit

Private Const m_ksProperty_Default              As String = ""

Private m_sHost                                 As String
Private m_nPort                                 As Long
Private m_sPath                                 As String
Private m_dctQueryStringParameters              As Scripting.Dictionary

Private m_sOutput                               As String

' Ensure that all parts of the query string are deleted.
Public Sub ClearQueryString()

    Set m_dctQueryStringParameters = New Scripting.Dictionary

End Sub

' Executes "GET" method for URL.
Public Function Get_() As String

    ' Read in data from URL. UserControl_AsyncReadComplete will fire when finished.
    UserControl.AsyncRead "http://" & m_sHost & ":" & CStr(m_nPort) & "" & m_sPath & "?" & GetQueryString(), vbAsyncTypeByteArray, m_ksProperty_Default, vbAsyncReadSynchronousDownload

    ' Return the contents of the buffer.
    Get_ = m_sOutput

    ' Clear down state.
    m_sOutput = vbNullString

End Function

' Returns query string based on dictionary.
Private Function GetQueryString() As String

    Dim vName                                   As Variant
    Dim sQueryString                            As String

    For Each vName In m_dctQueryStringParameters
        sQueryString = sQueryString & CStr(vName) & "=" & m_dctQueryStringParameters.Item(vName) & "&"
    Next vName

    GetQueryString = Left$(sQueryString, Len(sQueryString) - 1)

End Function

' Sets the remote host.
Public Property Let Host(ByVal the_sValue As String)

    m_sHost = the_sValue

End Property

' Sets the directory and filename part of the URL.
Public Property Let Path(ByVal the_sValue As String)

    m_sPath = the_sValue

End Property

' Sets the port number for this request.
Public Property Let Port(ByVal the_nValue As Long)

    m_nPort = the_nValue

End Property

' Sets a name/value pair in the query string. Supports duplicate names.
Public Property Let QueryStringParameter(ByVal the_sName As String, ByVal the_sValue As String)

    m_dctQueryStringParameters.Item(the_sName) = the_sValue

End Property

' Fired when the download is complete.
Private Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)

    ' Gets the data from the internet transfer.
    m_sOutput = StrConv(AsyncProp.Value, vbUnicode)
End Sub

Private Sub UserControl_Initialize()

    ' Initialises the scripting dictionary.
    Set m_dctQueryStringParameters = New Scripting.Dictionary

End Sub

通过以下方式调用：

按钮代码

Private Sub cmdCheckNow_Click()
On Error GoTo err_trap
Call hideCheckNow
QProGIF1.Visible = True
Call DeleteUrlCacheEntry("http://mysite.co.uk/mobicleanud/chkupdates.php")

DoEvents
HttpService.Host = "mysite.co.uk"
HttpService.Port = 80
HttpService.Path = "/thefolder/chkupdates.php"
HttpService.QueryStringParameter("license") = licensekey
HttpService.QueryStringParameter("vers") = "SOFTWARE2"
HttpService.QueryStringParameter("appmajor") = App.Major
HttpService.QueryStringParameter("appminor") = App.Minor
HttpService.QueryStringParameter("apprevis") = App.Revision

txtOutput.Text = HttpService.Get_

If txtOutput.Text = "" Or IsNull(txtOutput.Text) Or txtOutput.Text = "({" & Chr(34) & "response" & Chr(34) & ":" & "9" & "})" Then
        frmError.lblErrorMessage.Caption = "Licensing Server cannot validate the License Number! Error (9) - Please try again."
        frmError.Show vbModal
        Call showCheckNow
        QProGIF1.Visible = False

        DoEvents
        Exit Sub
End If
If txtOutput.Text = "" Or IsNull(txtOutput.Text) Or txtOutput.Text = "({" & Chr(34) & "response" & Chr(34) & ":" & "8" & "})" Then
        frmError.lblErrorMessage.Caption = "Licensing Server cannot validate the License Number! Error (8) - Please try again."
        frmError.Show vbModal
        Call showCheckNow
        QProGIF1.Visible = False

        DoEvents
        Exit Sub
End If
If txtOutput.Text = "" Or IsNull(txtOutput.Text) Or txtOutput.Text = "({" & Chr(34) & "response" & Chr(34) & ":" & "7" & "})" Then
        frmError.lblErrorMessage.Caption = "Licensing Server cannot validate the License Number! Error (7) - Please try again."
        frmError.Show vbModal
        Call showCheckNow
        QProGIF1.Visible = False

        DoEvents
        Exit Sub
End If
If txtOutput.Text = "" Or IsNull(txtOutput.Text) Or txtOutput.Text = "({" & Chr(34) & "response" & Chr(34) & ":" & "6" & "})" Then
        frmError.lblErrorMessage.Caption = "Licensing Server cannot validate the License Number! Error (6) - Please try again."
        frmError.Show vbModal
        Call showCheckNow
        QProGIF1.Visible = False

        DoEvents
        Exit Sub
End If
QProGIF1.Visible = False
If txtOutput.Text = "({" & Chr(34) & "response" & Chr(34) & ":" & "2" & "})" Then
        lblchecked.Caption = "Your License was validated and there is a new version of Mobiclean Pro available to Download and Install."
        lblchecked.Visible = True
        QProGIF1.Visible = False

        DoEvents
        cmdGet.Visible = True
        Exit Sub
End If
If txtOutput.Text = "({" & Chr(34) & "response" & Chr(34) & ":" & "3" & "})" Then
        lblchecked.Caption = "Your License was validated. You have the latest version of Mobiclean Pro - No Update available."
        lblchecked.Visible = True
        QProGIF1.Visible = False

        DoEvents
        Exit Sub
End If
exit_sub:

  Exit Sub

err_trap:
        frmError.lblErrorMessage.Caption = "An error has occurred - Code: " & Err.Number & " Description: " & Err.description
        frmError.Show vbModal
    Resume exit_sub
End Sub

找不到导致问题的原因。

错误消息是

内存不足

如果基于64位Win 10构建

如果基于32Bit win 10构建并读取文件并继续没有问题，则没有错误消息

Win10 64位而非32位出现“内存不足”错误？ [解决]

0 个答案: