九色国产,午夜在线视频,新黄色网址,九九色综合,天天做夜夜做久久做狠狠,天天躁夜夜躁狠狠躁2021a,久久不卡一区二区三区

2018-04-15 16:20:27 

作者：AntoniotheFuture

關(guān)鍵詞：VBA，Access，網(wǎng)頁(yè)爬蟲，網(wǎng)抓

開發(fā)平臺(tái)：Access

平臺(tái)版本上限：2010

平臺(tái)版本下限：尚未出現(xiàn)

開發(fā)語言：VBA

簡(jiǎn)介：目前在一家保險(xiǎn)公司上班，統(tǒng)計(jì)數(shù)據(jù)需要經(jīng)常從一個(gè)公司的網(wǎng)頁(yè)系統(tǒng)中下載報(bào)表，操作比較簡(jiǎn)單，但是要操作的東西太多，比較煩人，對(duì)于日常數(shù)據(jù)的提取，我就想著如果可以定制任務(wù)就好了，正好我之前也有過一點(diǎn)點(diǎn)網(wǎng)頁(yè)爬蟲的經(jīng)驗(yàn)，于是著手開始寫，對(duì)于這個(gè)網(wǎng)頁(yè)呢，有很多“不太友好”的地方，比如說：登陸進(jìn)去之后會(huì)啟動(dòng)新窗口（可能是公司為了信息安全），點(diǎn)擊的控件花樣百出，不易定位，格式不盡相同，有些日期是MM-DD-YYYY，有些是YYYY-MM-DD HH:MM，而且網(wǎng)頁(yè)內(nèi)存在iframe，用傳統(tǒng)的網(wǎng)頁(yè)爬蟲無法實(shí)現(xiàn)，在參閱了無數(shù)資料之后，今天終于開發(fā)出來了，現(xiàn)在分享給大家，共同進(jìn)步。

功能描述：

可以預(yù)先按步驟設(shè)定任務(wù)，完全模擬網(wǎng)頁(yè)中的手工操作，對(duì)各種控件進(jìn)行操作，只需輕輕點(diǎn)擊開始，網(wǎng)頁(yè)即可自動(dòng)填表，提交，等待報(bào)表在網(wǎng)頁(yè)中產(chǎn)生即可。

可以重新獲取IE的控制權(quán)，防止新窗口出現(xiàn)后丟失窗口。

可以根據(jù)預(yù)設(shè)參數(shù)獲取時(shí)間和日期，如：下一個(gè)工作日的前一天的23:59:59。

加入“工作日表”，可在里面提前設(shè)定“補(bǔ)假”，“加班”等特殊工作日，準(zhǔn)確判斷下一工作日。

表設(shè)計(jì)：

    首先是報(bào)表列表，用于定位網(wǎng)頁(yè)中報(bào)表頁(yè)面

因?yàn)榫W(wǎng)頁(yè)中有多處重復(fù)的HTMLname，而且無法用其他方法定位控件，特加入“開始搜索位置”用于控件的查找

然后是控件表，用于定位表單頁(yè)面中的控件，還可以根據(jù)預(yù)先設(shè)定的控件類型做不同的動(dòng)作。

任務(wù)表，用于記錄任務(wù)基本信息，比較簡(jiǎn)單

任務(wù)流程表，在窗體中定制的流程將會(huì)記錄到這個(gè)表中：

下面是窗體部分：

    控件詳情和報(bào)表詳情窗口，沒什么特殊，可用于快速添加網(wǎng)頁(yè)控件信息。

任務(wù)詳情窗體，整合了任務(wù)創(chuàng)建，流程設(shè)置，登陸信息輸入和執(zhí)行功能

新建任務(wù)后，在增加流程按鈕的左邊輸入要操作的控件和要輸入的值類型和值的本身，完成整個(gè)任務(wù)定制后，保存即可執(zhí)行，系統(tǒng)將會(huì)打開IE窗口并執(zhí)行相應(yīng)操作，省去不少時(shí)間，還能避免手動(dòng)輸入出錯(cuò)。

 工作日表，用于記錄工作日和更改工作日

下面是部分SQL查詢：

報(bào)表列表查詢 

SELECT 報(bào)表列表.ID, 報(bào)表列表.報(bào)表名稱

FROM 報(bào)表列表;

更改工作日類型子窗體

用于查找下一個(gè)工作日

SELECT 工作日表.*

FROM 工作日表

WHERE (((工作日表.工作日)>=DateAdd("d",-7,Date())))

ORDER BY 工作日表.工作日;

任務(wù)流程查詢

用于在任務(wù)詳情界面顯示流程

SELECT 任務(wù)流程表.任務(wù)ID, 任務(wù)流程表.流程數(shù), 任務(wù)流程表.打開報(bào)表, 任務(wù)流程表.表ID, [報(bào)表列表]![報(bào)表名稱] AS表名, 任務(wù)流程表.控件ID, [element]![名稱] AS 控件名, 任務(wù)流程表.控件值類型, 任務(wù)流程表.控件值

FROM (任務(wù)流程表 LEFTJOIN 報(bào)表列表 ON 任務(wù)流程表.表ID = 報(bào)表列表.ID) LEFT JOIN element ON 任務(wù)流程表.控件ID = element.ID

WHERE (((任務(wù)流程表.任務(wù)ID)=[Forms]![任務(wù)詳情]![ID]));

任務(wù)流程轉(zhuǎn)VBA

與VBA對(duì)接，包含了執(zhí)行任務(wù)過程中所需的所有控件數(shù)據(jù)。

SELECT 任務(wù)流程表.ID, 任務(wù)流程表.任務(wù)ID, 任務(wù)流程表.流程數(shù), 任務(wù)流程表.打開報(bào)表, 報(bào)表列表.報(bào)表名稱, 報(bào)表列表.層級(jí), 報(bào)表列表.一級(jí), 報(bào)表列表.開始搜索位置, 報(bào)表列表.二級(jí), 報(bào)表列表.是否使用二級(jí)網(wǎng)頁(yè)位置, 報(bào)表列表.二級(jí)網(wǎng)頁(yè)位置, 報(bào)表列表.三級(jí), 報(bào)表列表.四級(jí), element.名稱, element.控件類型, element.值, element.數(shù)據(jù)類型, element.HTMLname,element.HTMLID, element.時(shí)間類型, 任務(wù)流程表.控件值類型, 任務(wù)流程表.控件值

FROM (任務(wù)流程表 LEFTJOIN 報(bào)表列表 ON 任務(wù)流程表.表ID = 報(bào)表列表.ID) LEFT JOIN element ON 任務(wù)流程表.控件ID = element.ID;

下面是VBA代碼部分

更改工作日類型

'批量修改工作日

Private Sub Command20_Click()

Dim STemp2 As String 

Dim i

If IsNull(Me.Text0) Then

   MsgBox ("請(qǐng)輸入開始日期！")

   Exit Sub

ElseIf IsNull(Me.Text4) Then

   MsgBox ("請(qǐng)輸入結(jié)束日期！")

   Exit Sub

ElseIf IsNull(Me.List40) Then

   MsgBox ("請(qǐng)選擇更改類型！")

Else  

Dim Rs2 As ADODB.Recordset

Set Rs2 = New ADODB.Recordset 

STemp2 = "select * From 工作日表 where 工作日 between #" & Me![Text0]& "# and #" & Me![Text4] & "#"

Rs2.Open STemp2, CurrentProject.Connection,adOpenKeyset, adLockOptimistic 

For i = 1 To Rs2.RecordCount

   Rs2("類型") = Me![List40]

   Rs2.Update

   Rs2.MoveNext

Next

Me.Refresh

MsgBox ("成功將"& i - 1 & "天更改為" & Me![List40])

Exit Sub

End If

Exit Sub

Rs2.Close

Set Rs2 = Nothing 

End Sub

自動(dòng)登錄并獲取網(wǎng)頁(yè)

用于對(duì)付窗口彈出問題

Private Sub Command268_Click()

'On Error Resume Next

'定義變量

Dim IE As Object

Dim webs, webs2, webs3, webs4, webs5, dmt,dmt1, dmt2, usrno, elements, element1, xxx

Dim vtag   '網(wǎng)頁(yè)對(duì)象

Dim loop1, loop2, loop3   '循環(huán)計(jì)數(shù)器

Dim objIE As Object, myHWND

Dim dWinFolder As New ShellWindows, t

Dim Czpmxurl As String, Czpmxname As String

Dim Czpmxhwnd As Long, aa        '窗口句柄

Dim cifno$, cifcname$, ResultLink$ 

'text9 = 用戶名 text11= 密碼

'IE清除緩存&打開登錄界面 

Call DeleteCacheURLList

Set IE =CreateObject("InternetExplorer.Application")

IE.Navigate"example.com"

IE.Visible = True     '若=0 False不顯示 ,=1 True 顯示

IE.Silent = True

Do While IE.Busy Or IE.ReadyState <>4

   DoEvents

Loop

delay Me.Combo17  

Set dmt = IE.Document

IE.Document.getElementById("j_username").Value= Me.Text9

IE.Document.getElementById("j_password").Value= Me.Text11

delay 2

IE.Document.getElementById("j_password").focus

SendKeys "{enter}"

Do While IE.Busy Or IE.ReadyState <>4

   DoEvents

Loop

delay Me.Combo17 + 3

   Czpmxhwnd = FindWindow(vbNullString, "來自網(wǎng)頁(yè)的消息")      '根據(jù)窗口標(biāo)題查找，找到后返回句柄

   If Czpmxhwnd <> 0 Then

       aa = SetForegroundWindow(Czpmxhwnd)   '將網(wǎng)頁(yè)調(diào)到前臺(tái)

       delay 1

       SendKeys "{ENTER}", True

   End If  

delay 1

Call Command271_Click

End Sub

任務(wù)執(zhí)行

根據(jù)設(shè)定的任務(wù)，按流程對(duì)網(wǎng)頁(yè)中控件進(jìn)行操作

Private Sub Command271_Click()

'定義變量

Dim IE As Object

Dim webs, webs2, webs3, webs4, webs5, dmt,dmt1, dmt2, dmt3, dmt4, usrno, elements, element1, xxx, departmentNoHTML

Dim vtag, worktype  '網(wǎng)頁(yè)對(duì)象

Dim loop1, loop2, loop3, loop4  '循環(huán)計(jì)數(shù)器  1=網(wǎng)頁(yè)對(duì)象查找，2= ，3=工作日確定，4=流程進(jìn)行

Dim objIE As Object, myHWND

Dim dWinFolder As New ShellWindows, t

Dim Czpmxurl As String, Czpmxname As String

Dim Czpmxhwnd As Long, aa        '窗口句柄

Dim cifno$, cifcname$, ResultLink$

Dim today0 '今天零點(diǎn)

Dim monthday10000  '當(dāng)月零點(diǎn)

Dim nworkday '下一工作日

Dim nworkdaypday2359 '下一工作日前一天23點(diǎn)59分

Dim nworkday7  '下一工作日7點(diǎn)

Dim STemp3, STemp4 As String

Dim Rs3 As ADODB.Recordset

Dim Rs4 As ADODB.Recordset

Set Rs3 = New ADODB.Recordset

Set Rs4 = New ADODB.Recordset

workdaytype = "正常"

today0 = Format(Date & "00:00:00", "YYYY/MM/DD HH:MM:SS")

monthday10000 = Format(DateSerial(Year(Date),Month(Date), 1) & " 00:00:00", "YYYY/MM/DD HH:MM:SS")

STemp3 = "select * From 工作日表 where 類型 = " & "'" &workdaytype & "'" & "order by 工作日"

Rs3.Open STemp3, CurrentProject.Connection,adOpenKeyset, adLockOptimistic

For loop3 = 0 To Rs3.RecordCount

   If DateDiff("d", Date, Rs3("工作日"))> 0 Then

       nworkday = Rs3("工作日")

       Exit For

   ElseIf loop3 = Rs3.RecordCount Then

       MsgBox ("請(qǐng)更新工作日表！")

       Exit Sub

       Exit For

   Else

       Rs3.MoveNext

   End If

Next

nworkdaypday2359 =Format(DateAdd("d", -1, nworkday) & " 23:59:59","YYYY/MM/DD HH:MM:SS")

nworkday7 = Format(nworkday & "07:00:00", "YYYY/MM/DD HH:MM:SS")

Do

   For Each objIE In dWinFolder

           If InStr(1, objIE.LocationURL, "elis-lcs.paic") > 0 Then

                Czpmxname =objIE.LocationName            '標(biāo)題

                Czpmxurl =objIE.LocationURL              '鏈接

                Exit Do   '通過鏈接objIE.LocationURL包含的關(guān)鍵字查詢，或用objIE.LocationName即窗口標(biāo)題包含的關(guān)鍵字來查詢

           End If

   Next

       DoEvents

Loop

   Set IE = objIE  '轉(zhuǎn)換ie窗口控制權(quán)

   Do Until IE.ReadyState = 4 And IE.Busy = False

       DoEvents

   Loop

   Set dmt = IE.Document

STemp4 = "select * From 任務(wù)流程轉(zhuǎn)VBA where 任務(wù)ID = " & Me![任務(wù)ID] & " order by 流程數(shù)"

Rs4.Open STemp4, CurrentProject.Connection,adOpenKeyset, adLockOptimistic

For loop4 = 0 To Rs4.RecordCount - 1

   If Rs4("打開報(bào)表") = True Then

繼續(xù):

       Set elements = dmt.all.tags("a")

       Debug.Print IE.ReadyState

       For loop1 = 0 To elements.length - 1

           If elements.Item(loop1).innerText = Rs4("一級(jí)")Then

                elements.Item(loop1).Click

                Exit For

           End If

       Next

'特殊重名控件

           For loop1 = Rs4("開始搜索位置") Toelements.length - 1

                Ifelements.Item(loop1).innerText = Rs4("二級(jí)")Then

                   elements.Item(loop1).FireEvent ("onmouseover")

                    Exit For

                End If

           Next

       delay 0.5

       If Rs4("層級(jí)") = 3 Then

           Set elements = dmt.all.tags("a")

           Debug.Print IE.ReadyState

           For loop1 = 0 To elements.length - 1

           If elements.Item(loop1).innerText = Rs4("三級(jí)")Then

                elements.Item(loop1).Click

                Exit For

           End If

           Next

       ElseIf Rs4("層級(jí)") = 4 Then

           Set elements = dmt.all.tags("a")

           Debug.Print IE.ReadyState

           For loop1 = 0 To elements.length - 1

                Ifelements.Item(loop1).innerText = Rs4("三級(jí)")Then

                   elements.Item(loop1).FireEvent ("onmouseover")

                    Exit For

                End If

           Next

           For loop1 = 0 To elements.length - 1

            If elements.Item(loop1).innerText =Rs4("四級(jí)") Then

                elements.Item(loop1).Click

                Exit For

           End If

           Next

           delay 1

       Else

           MsgBox ("請(qǐng)?jiān)趫?bào)表列表中添加報(bào)表層級(jí)?。?！")

           Exit Sub

       End If

       delay 5

       GoTo 報(bào)表操作

   Else                                                                                   '打開報(bào)表——結(jié)束

網(wǎng)頁(yè)表單填寫操作:

       Set dmt1 = IE.Document.frames(1).Document  'getElementsByTagName("INPUT")(0)

       Set elements = dmt1.all.tags("INPUT")       'Or "SELECT"

       If Rs4("控件類型") = "文本框" Then

           For loop1 = 0 To elements.length - 1

           If IsNull(Rs4("HTMLname")) = False Then

                If elements.Item(loop1).Name =Rs4("HTMLname") Then

ID匹配:

                    Select Case Rs4("控件值類型")

                    Case "預(yù)先制定值"

                       elements.Item(loop1).Value = Rs4("控件值")

                    Case "當(dāng)時(shí)"

                       elements.Item(loop1).Value = Format(Date & " " & Time(),Rs4("時(shí)間類型"))

                    Case "手動(dòng)輸入"

                       elements.Item(loop1).Value = InputBox("請(qǐng)輸入"& Rs4("報(bào)表名稱") & "中" & Rs4("名稱") &"的值：(" & Rs4("時(shí)間類型") & ")", "請(qǐng)輸入")

                    Case "當(dāng)月0點(diǎn)"

                        elements.Item(loop1).Value= Format(monthday10000, Rs4("時(shí)間類型"))

                    Case "今天0點(diǎn)"

                       elements.Item(loop1).Value = Format(today0, Rs4("時(shí)間類型"))

                    Case "下一工作日前一天23點(diǎn)59分"

                        elements.Item(loop1).Value= Format(nworkdaypday2359, Rs4("時(shí)間類型"))

                    Case "下一工作日7點(diǎn)"

                       elements.Item(loop1).Value = Format(nworkday7, Rs4("時(shí)間類型"))

                    Case "本月份"

                       elements.Item(loop1).Value = Format(Date, Rs4("時(shí)間類型"))

                    End Select

                    Exit For

                End If

           Else

                If elements.Item(loop1).ID =Rs4("HTMLID") Then

                    GoTo ID匹配

                End If

           End If

            Next

       ElseIf Rs4("控件類型") = "復(fù)選框" Then

           For loop1 = 0 To elements.length - 1

                If elements.Item(loop1).Value =Rs4("值") Then

                    elements.Item(loop1).Click

                    Exit For

                End If

           Next

       ElseIf Rs4("控件類型") = "單選框" Then

           For loop1 = 0 To elements.length - 1

                If elements.Item(loop1).Name =Rs4("HTMLname") Then

                    elements.Item(loop1).Click

                   Exit For

                End If

           Next

       ElseIf Rs4("控件類型") = "按鈕" Then

           For loop1 = 0 To elements.length - 1

                If elements.Item(loop1).Value =Rs4("值") Then

                   elements.Item(loop1).FireEvent ("onclick")

                    delay 2

                    Exit For

                End If

           Next

       ElseIf Rs4("控件類型") = "下拉框" Then

           Set elements = dmt1.all.tags("select")

           For loop1 = 0 To elements.length - 1

                If IsNull(Rs4("HTMLname"))= False Then

                    Ifelements.Item(loop1).Name = Rs4("HTMLname") Then

ID匹配2:

                       elements.Item(loop1).Value = Rs4("控件值")

                        Exit For

                    End If

                Else

                    If elements.Item(loop1).ID= Rs4("HTMLID") Then

                    GoTo ID匹配2

                    End If

                End If

           Next

       End If

       Rs4.MoveNext

   End If

下一步:

Next

Me.Refresh

Exit Sub

Rs3.Close

Rs4.Close

Set Rs3 = Nothing

Set Rs4 = Nothing

End Sub

任務(wù)控件添加

用于在任務(wù)詳情界面中添加需要操作的控件。

Private Sub Command45_Click()

Dim STemp As String

Dim Rs As ADODB.Recordset

Set Rs = New ADODB.Recordset

STemp = "select * From 任務(wù)流程表 where 任務(wù)ID = " & Me![任務(wù)ID]

Rs.Open STemp, CurrentProject.Connection,adOpenKeyset, adLockOptimistic

Rs.AddNew

Rs("任務(wù)ID")= Me![任務(wù)ID]

Rs("流程數(shù)")= Rs.RecordCount + 1

Rs("表ID")= Me.Combo60

Rs("表名")= Me.Combo60.Column(1)

Rs("控件ID")= Me.Combo66

Rs("控件名")= Me.Combo66.Column(1)

Rs("控件值類型")= Me.Combo100

Rs("控件值")= Text76

Rs("打開報(bào)表")= Me.Check319

Rs.Update

Me.Refresh

Exit Sub

Rs.Close

Set Rs = Nothing

End Sub

尋找已打開IE

Declare Function FindWindow Lib"user32" Alias "FindWindowA" (ByVal lpClassName As String,ByVal lpWindowName As String) As Long

Declare Function SetForegroundWindow Lib"user32" (ByVal HWnd As Long) As Long

窗口尋找

Private Const ERROR_CACHE_FIND_FAIL As Long= 0

Private Const ERROR_CACHE_FIND_SUCCESS AsLong = 1

Private Const ERROR_FILE_NOT_FOUND As Long= 2

Private Const ERROR_ACCESS_DENIED As Long =5

Private Const ERROR_INSUFFICIENT_BUFFER AsLong = 122

Private Const MAX_PATH As Long = 260

Private Const MAX_CACHE_ENTRY_INFO_SIZE AsLong = 4096

Private Const LMEM_FIXED As Long = &H0

Private Const LMEM_ZEROINIT As Long =&H40

Private Const LPTR As Long = (LMEM_FIXED OrLMEM_ZEROINIT)

Private Const NORMAL_CACHE_ENTRY As Long =&H1

Private Const EDITED_CACHE_ENTRY As Long =&H8

Private Const TRACK_OFFLINE_CACHE_ENTRY AsLong = &H10

Private Const TRACK_ONLINE_CACHE_ENTRY AsLong = &H20

Private Const STICKY_CACHE_ENTRY As Long =&H40

Private Const SPARSE_CACHE_ENTRY As Long =&H10000

Private Const COOKIE_CACHE_ENTRY As Long =&H100000

Private Const URLHISTORY_CACHE_ENTRY AsLong = &H200000

Private Const URLCACHE_FIND_DEFAULT_FILTER AsLong = NORMAL_CACHE_ENTRY Or _

                                                   COOKIE_CACHE_ENTRY Or _

                                                   URLHISTORY_CACHE_ENTRY Or _

                                                   TRACK_OFFLINE_CACHE_ENTRY Or _

                                                   TRACK_ONLINE_CACHE_ENTRY Or _

                                                   STICKY_CACHE_ENTRY

Private Type FILETIME

  dwLowDateTime As Long

  dwHighDateTime As Long

End Type

Private Type INTERNET_CACHE_ENTRY_INFO

  dwStructSize As Long

  lpszSourceUrlName As Long

  lpszLocalFileName As Long

  CacheEntryType  As Long

  dwUseCount As Long

  dwHitRate As Long

  dwSizeLow As Long

  dwSizeHigh As Long

  LastModifiedTime As FILETIME

  ExpireTime As FILETIME

  LastAccessTime As FILETIME

  LastSyncTime As FILETIME

  lpHeaderInfo As Long

  dwHeaderInfoSize As Long

  lpszFileExtension As Long

  dwExemptDelta  As Long

End Type

Private Declare FunctionFindFirstUrlCacheEntry Lib "wininet" Alias"FindFirstUrlCacheEntryA" (ByVal lpszUrlSearchPattern As String,lpFirstCacheEntryInfo As Any, lpdwFirstCacheEntryInfoBufferSize As Long) AsLong

Private Declare FunctionFindNextUrlCacheEntry Lib "wininet" Alias "FindNextUrlCacheEntryA"(ByVal hEnumHandle As Long, lpNextCacheEntryInfo As Any,lpdwNextCacheEntryInfoBufferSize As Long) As Long

Private Declare Function FindCloseUrlCacheLib "wininet" (ByVal hEnumHandle As Long) As Long

Private Declare FunctionDeleteUrlCacheEntry Lib "wininet" Alias"DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long

Private Declare Sub CopyMemory Lib"kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource AsAny, ByVal dwLength As Long)

Private Declare Function lstrcpyA Lib"kernel32" (ByVal RetVal As String, ByVal Ptr As Long) As Long

Private Declare Function lstrlenA Lib"kernel32" (ByVal Ptr As Any) As Long

Private Declare Function LocalAlloc Lib"kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long

Private Declare Function LocalFree Lib"kernel32" (ByVal hMem As Long) As Long

Public Sub DeleteCacheURLList()

  Dim icei As INTERNET_CACHE_ENTRY_INFO

  Dim hFile As Long

  Dim cachefile As String

  Dim posUrl As Long

  Dim posEnd As Long

  Dim dwBuffer As Long

  Dim pntrICE As Long

  hFile = FindFirstUrlCacheEntry(0&, ByVal 0, dwBuffer)

   If(hFile = ERROR_CACHE_FIND_FAIL) And _

     (Err.LastDllError = ERROR_INSUFFICIENT_BUFFER) Then

     pntrICE = LocalAlloc(LMEM_FIXED, dwBuffer)

     If pntrICE <> 0 Then

        CopyMemory ByVal pntrICE, dwBuffer, 4

        hFile = FindFirstUrlCacheEntry(vbNullString, _

                                        ByValpntrICE, _

                                       dwBuffer)

        If hFile <> ERROR_CACHE_FIND_FAIL Then

           Do

               CopyMemory icei, ByVal pntrICE,Len(icei)

               If (icei.CacheEntryType And _

                   NORMAL_CACHE_ENTRY) =NORMAL_CACHE_ENTRY Then

                  cachefile =GetStrFromPtrA(icei.lpszSourceUrlName)

                  Call DeleteUrlCacheEntry(cachefile)

               End If

               Call LocalFree(pntrICE)

              dwBuffer = 0

               CallFindNextUrlCacheEntry(hFile, ByVal 0, dwBuffer)

              'allocate and assign the memoryto the pointer

              pntrICE =LocalAlloc(LMEM_FIXED, dwBuffer)

               CopyMemory ByVal pntrICE,dwBuffer, 4

                             DoEvents

           Loop While FindNextUrlCacheEntry(hFile, ByVal pntrICE, dwBuffer)

        End If 'hFile

     End If 'pntrICE

  End If 'hFile

  Call LocalFree(pntrICE)

  Call FindCloseUrlCache(hFile)

End Sub

Private Function GetStrFromPtrA(ByVal lpszAAs Long) As String

  GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)

 Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)

End Function

————————————————

版權(quán)聲明：本文為CSDN博主「Antonio·Future」的原創(chuàng)文章，遵循CC 4.0 BY-SA版權(quán)協(xié)議，轉(zhuǎn)載請(qǐng)附上原文出處鏈接及本聲明。

原文鏈接：https://blog.csdn.net/qq_15041159/article/details/79949997