none
VB.NET StrPtr與Lenb未宣告 RRS feed

  • 問題

  •  

    我有兩個程式代碼

    這是VB轉過來VB2008的

    可是就是出現StrPtr與Lenb未宣告

    第一個程式代碼是清除IE的History

    Option Strict Off
    Option Explicit On
    Friend Class Form1
     Inherits System.Windows.Forms.Form
     Private Const CLSID_CUrlHistory As String = "{3C374A40-BAE4-11CF-BF7D-00AA006946EE}"
     Private Const CLSID_IUrlHistoryStg2 As String = "{AFA0DC11-C313-11D0-831A-00C04FD5AE38}"
     Private Const IUrlHistoryStg2_Release As Integer = 8
     Private Const IUrlHistoryStg2_ClearHistory As Integer = 36
     Private Const CLSCTX_INPROC_SERVER As Integer = 1
     Private Const CC_STDCALL As Integer = 4
     Private Const S_OK As Integer = 0

     Private Structure GUID
      Dim Data1 As Integer
      Dim Data2 As Short
      Dim Data3 As Short
      <VBFixedArray(7)> Dim Data4() As Byte
            Public Sub Initialize()
                ReDim Data4(7)
            End Sub
     End Structure
        Private Declare Function CoCreateInstance Lib "ole32" (ByRef rclsid As Object, ByVal pUnkOuter As Integer, ByVal dwClsContext As Integer, ByRef riid As Object, ByRef pvarResult As Integer) As Integer
        Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvarResult As Integer, ByVal oVft As Integer, ByVal cc As Integer, ByVal vtReturn As VariantType, ByVal nParams As Integer, ByRef pVarTypes As Integer, ByRef pVarArgs As Integer, ByRef pvarResult As Object) As Integer
        Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpszGuid As Integer, ByRef pGuid As Object) As Integer

     

     Private Sub Form1_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
            DeleteHistory()
            System.Windows.Forms.Application.DoEvents()
            Me.Close()
        End Sub

        Private Function DeleteHistory() As Boolean
            Dim objClsid As GUID
            Dim idClsid As GUID
            Dim pvarResult As Integer
            Dim ret As Integer

            Call CLSIDFromString(StrPtr(CLSID_CUrlHistory), objClsid) 'StrPtr未宣告
            Call CLSIDFromString(StrPtr(CLSID_IUrlHistoryStg2), idClsid) 'StrPtr未宣告
            If CoCreateInstance(objClsid, 0, CLSCTX_INPROC_SERVER, idClsid, pvarResult) = S_OK Then
                If DispCallFunc(pvarResult, IUrlHistoryStg2_ClearHistory, CC_STDCALL, VariantType.Integer, 0, 0, 0, ret) = S_OK Then
                    If DispCallFunc(pvarResult, IUrlHistoryStg2_Release, CC_STDCALL, VariantType.Integer, 0, 0, 0, ret) = S_OK Then
                        DeleteHistory = True
                    End If
                End If
            End If
        End Function

    End Class

     

    ------------------------------------------------------------------------------------------------------------------------------------------------------------------------

    第二個代碼是IE清除暫時檔案

    Option Strict Off
    Option Explicit On
    Friend Class Form1
    	Inherits System.Windows.Forms.Form
    	Private Structure FILETIME
    		Dim dwLowDateTime As Integer
    		Dim dwHighDateTime As Integer
    	End Structure
    	Private Structure INTERNET_CACHE_ENTRY_INFO
    		Dim dwStructSize As Integer
    		Dim lpszSourceUrlName As Integer
    		Dim lpszLocalFileName As Integer
    		Dim CacheEntryType As Integer
    		Dim dwUseCount As Integer
    		Dim dwHitRate As Integer
    		Dim dwSizeLow As Integer
    		Dim dwSizeHigh As Integer
    		Dim LastModifiedTime As FILETIME
    		Dim ExpireTime As FILETIME
    		Dim LastAccessTime As FILETIME
    		Dim LastSyncTime As FILETIME
    		Dim lpHeaderInfo As Integer
    		Dim dwHeaderInfoSize As Integer
    		Dim lpszFileExtension As Integer
    		Dim dwReserved As Integer
    		Dim dwExemptDelta As Integer
    	End Structure
    	Private Declare Function FindFirstUrlCacheEntry Lib "wininet.dll"  Alias "FindFirstUrlCacheEntryA"(ByVal lpszUrlSearchPattern As String, ByVal lpFirstCacheEntryInfo As Integer, ByRef lpdwFirstCacheEntryInfoBufferSize As Integer) As Integer
    	Private Declare Function FindNextUrlCacheEntry Lib "wininet.dll"  Alias "FindNextUrlCacheEntryA"(ByVal hEnumHandle As Integer, ByVal lpNextCacheEntryInfo As Integer, ByRef lpdwNextCacheEntryInfoBufferSize As Integer) As Integer
    	Private Declare Sub FindCloseUrlCache Lib "wininet.dll" (ByVal hEnumHandle As Integer)
    	Private Declare Function DeleteUrlCacheEntry Lib "wininet.dll"  Alias "DeleteUrlCacheEntryA"(ByVal lpszUrlName As String) As Integer
    	Private Sub Form1_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
    		Dim ICEI As INTERNET_CACHE_ENTRY_INFO
            Dim Ret As Integer
    
    		Dim hEntry As Integer
    		Dim Msg As MsgBoxResult
    		Dim MemBlock As New MemoryBlock
    		FindFirstUrlCacheEntry(vbNullString, 0, Ret)
    		If Ret > 0 Then
    			MemBlock.Allocate(Ret)
    			hEntry = FindFirstUrlCacheEntry(vbNullString, MemBlock.Handle, Ret)
                MemBlock.ReadFrom(VarPtr(ICEI), LenB(ICEI))
    			If ICEI.lpszSourceUrlName <> 0 Then List1.Items.Add(MemBlock.ExtractString(ICEI.lpszSourceUrlName, Ret))
    		End If
    		Do While hEntry <> 0
    			Ret = 0
    			FindNextUrlCacheEntry(hEntry, 0, Ret)
    			If Ret > 0 Then
    				MemBlock.Allocate(Ret)
    				FindNextUrlCacheEntry(hEntry, MemBlock.Handle, Ret)
                    MemBlock.ReadFrom(VarPtr(ICEI), LenB(ICEI)) '在這裡出現錯誤該如何修正
    				If ICEI.lpszSourceUrlName <> 0 Then List1.Items.Add(MemBlock.ExtractString(ICEI.lpszSourceUrlName, Ret))
    			Else
    				Exit Do
    			End If
    		Loop 
    		FindCloseUrlCache(hEntry)
            MemBlock = Nothing
    		Msg = MsgBox("Do you wish to delete the Internet Explorer cache?", MsgBoxStyle.YesNo + MsgBoxStyle.DefaultButton2 + MsgBoxStyle.Question)
    		If Msg = MsgBoxResult.Yes Then
    			For Ret = 0 To List1.Items.Count - 1
    				DeleteUrlCacheEntry(VB6.GetItemString(List1, Ret))
    			Next Ret
    			MsgBox("Cache deleted...")
    		End If
    	End Sub
    End Class
    
    
    
    在一個類型模組
    Option Strict Off
    Option Explicit On
    Friend Class MemoryBlock
    	Private Const MEM_DECOMMIT As Integer = &H4000
    	Private Const MEM_RELEASE As Integer = &H8000
    	Private Const MEM_COMMIT As Integer = &H1000
    	Private Const MEM_RESERVE As Integer = &H2000
    	Private Const MEM_RESET As Integer = &H80000
    	Private Const MEM_TOP_DOWN As Integer = &H100000
    	Private Const PAGE_READONLY As Integer = &H2
    	Private Const PAGE_READWRITE As Integer = &H4
    	Private Const PAGE_EXECUTE As Integer = &H10
    	Private Const PAGE_EXECUTE_READ As Integer = &H20
    	Private Const PAGE_EXECUTE_READWRITE As Integer = &H40
    	Private Const PAGE_GUARD As Integer = &H100
    	Private Const PAGE_NOACCESS As Integer = &H1
    	Private Const PAGE_NOCACHE As Integer = &H200
    	Private Declare Sub CopyMemory Lib "kernel32"  Alias "RtlMoveMemory"(ByVal pDest As Integer, ByVal pSrc As Integer, ByVal ByteLen As Integer)
    	Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Integer, ByVal dwSize As Integer, ByVal flAllocationType As Integer, ByVal flProtect As Integer) As Integer
    	Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Integer, ByVal dwSize As Integer, ByVal dwFreeType As Integer) As Integer
    	Private Declare Function VirtualLock Lib "kernel32" (ByVal lpAddress As Integer, ByVal dwSize As Integer) As Integer
    	Private Declare Function VirtualUnlock Lib "kernel32" (ByVal lpAddress As Integer, ByVal dwSize As Integer) As Integer
    	Private Declare Function IsBadReadPtr Lib "kernel32" (ByVal lp As Integer, ByVal ucb As Integer) As Integer
    	Private Declare Function IsBadWritePtr Lib "kernel32" (ByVal lp As Integer, ByVal ucb As Integer) As Integer
    	Private Declare Function IsBadStringPtr Lib "kernel32"  Alias "IsBadStringPtrA"(ByVal lpsz As Integer, ByVal ucchMax As Integer) As Integer
    	Private Declare Function lstrcpy Lib "kernel32"  Alias "lstrcpyA"(ByVal lpStringDest As String, ByVal lpStringSrc As Integer) As Integer
    	Private Declare Function lstrlen Lib "kernel32"  Alias "lstrlenA"(ByVal lpString As Integer) As Integer
    	Private m_VirtualMem, lLength As Integer
    	
    	Public ReadOnly Property Handle() As Integer
    		Get
    			Handle = m_VirtualMem
    		End Get
    	End Property
    	
    	Public Sub Allocate(ByRef lCount As Integer)
    		ReleaseMemory()
    		m_VirtualMem = VirtualAlloc(0, lCount, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
    		VirtualLock(m_VirtualMem, lCount)
    	End Sub
    	
    	Public Sub ReadFrom(ByRef hWritePointer As Integer, ByRef lLength As Integer)
    		If IsBadWritePtr(hWritePointer, lLength) = 0 And IsBadReadPtr(Handle, lLength) = 0 Then
    			CopyMemory(hWritePointer, Handle, lLength)
    		End If
    	End Sub
    	
    	Public Sub WriteTo(ByRef hReadPointer As Integer, ByRef lLength As Integer)
    		If IsBadReadPtr(hReadPointer, lLength) = 0 And IsBadWritePtr(Handle, lLength) = 0 Then
    			CopyMemory(Handle, hReadPointer, lLength)
    		End If
    	End Sub
    	
    	Public Function ExtractString(ByRef hStartPointer As Integer, ByRef lMax As Integer) As String
    		Dim Length As Integer
    		If IsBadStringPtr(hStartPointer, lMax) = 0 Then
    			ExtractString = Space(lMax)
    			lstrcpy(ExtractString, hStartPointer)
    			Length = lstrlen(hStartPointer)
    			If Length >= 0 Then ExtractString = Left(ExtractString, Length)
    		End If
    	End Function
    	
    	Public Sub ReleaseMemory()
    		If m_VirtualMem <> 0 Then
    			VirtualUnlock(m_VirtualMem, lLength)
    			VirtualFree(m_VirtualMem, lLength, MEM_DECOMMIT)
    			VirtualFree(m_VirtualMem, 0, MEM_RELEASE)
    			m_VirtualMem = 0
    		End If
    	End Sub
    	
        Private Sub Class_Terminate_Renamed()
            ReleaseMemory()
        End Sub
    	Protected Overrides Sub Finalize()
    		Class_Terminate_Renamed()
    		MyBase.Finalize()
    	End Sub
    End Class
    
    該如何解決呢?
    2008年9月18日 上午 09:30

解答

所有回覆