使用 WinINet 中的函数实现枚举和清除 IE 缓存文件, Cookie, 浏览历史。
PUBLIC oForm oForm = NEWOBJECT( 'MyForm' ) oForm.Show #define CSIDL_INTERNET_CACHE 0x0020 #define CSIDL_COOKIES 0x0021 #define CSIDL_HISTORY 0x0022 #define CACHEGROUP_SEARCH_ALL 0x00000000 #define CACHEGROUP_FLAG_FLUSHURL_ONDELETE 0x00000002 #define NORMAL_CACHE_ENTRY 0x00000001 #define COOKIE_CACHE_ENTRY 0x00100000 #define URLHISTORY_CACHE_ENTRY 0x00200000 #define ERROR_NO_MORE_FILES 18 #define ERROR_INSUFFICIENT_BUFFER 122 #define ERROR_NO_MORE_ITEMS 259 DEFINE CLASS MyForm AS form DataSession = 2 Height = 500 Width = 700 Desktop = .T. DoCreate = .T. AutoCenter = .T. Caption = 'Form1' AllowOutput = .F. folder_cached = '' folder_cookie = '' folder_linked = '' Name = 'Form1' ADD OBJECT pgf AS pageframe WITH ; ErasePage = .T., ; PageCount = 3, ; Top = 0, ; Left = 0, ; Width = 702, ; Height = 458, ; Anchor = 15, ; Name = 'pgf', ; Page1.Caption = '缓冲文件', ; Page1.Name = 'pagCached', ; Page2.Caption = 'Cookie', ; Page2.Name = 'pagCookie', ; Page3.Caption = '浏览历史', ; Page3.Name = 'pagLinked' ADD OBJECT cmdRefresh AS commandbutton WITH ; Top = 465, ; Left = 20, ; Height = 27, ; Width = 112, ; Anchor = 6, ; Caption = '刷新 IE 缓冲', ; Name = 'cmdRefresh' ADD OBJECT cmdClrCache AS commandbutton WITH ; Top = 465, ; Left = 300, ; Height = 27, ; Width = 116, ; Anchor = 12, ; Caption = '清除 IE 缓冲文件', ; Name = 'cmdClrCache' ADD OBJECT cmdClrCookie AS commandbutton WITH ; Top = 465, ; Left = 432, ; Height = 27, ; Width = 116, ; Anchor = 12, ; Caption = '清除 Cookie', ; Name = 'cmdClrCookie' ADD OBJECT cmdClrLinked AS commandbutton WITH ; Top = 465, ; Left = 564, ; Height = 27, ; Width = 116, ; Anchor = 12, ; Caption = '清除浏览历史', ; Name = 'cmdClrLinked' PROCEDURE decl_api DECLARE Long FindFirstUrlCacheGroup IN wininet ; Long dwFlags, Long dwFilter, String lpSearchCondition, ; Long dwSearchCondition, Long @ lpGroupId, String lpReserved DECLARE Long FindNextUrlCacheGroup IN wininet ; Long hFind, Long @ lpGroupId, String lpReserved DECLARE Long DeleteUrlCacheGroup IN wininet ; Long GroupId, Long dwFlags, String lpReserved DECLARE Long FindFirstUrlCacheEntry IN wininet ; String lpszUrlSearchPattern, String @ lpFirstCacheEntryInfo, ; Long @ lpcbCacheEntryInfo DECLARE Long FindNextUrlCacheEntry IN wininet ; Long hEnumHandle, String @ lpNextCacheEntryInfo, ; Long @ lpcbCacheEntryInfo DECLARE Long DeleteUrlCacheEntry IN wininet ; String lpszUrlName DECLARE Long FindCloseUrlCache IN wininet ; Long hEnumHandle DECLARE Long SHGetSpecialFolderLocation IN shell32 ; Long hwndOwner, Long nFolder, Long @ ppidl DECLARE Long SHGetPathFromIDList IN shell32 ; Long pidl, String @ pszPath DECLARE Long GetLastError IN WIN32API DECLARE Long FormatMessage IN WIN32API AS _api_formatmsg ; Long dwFlags, Long lpSource, Long dwMessageId, Long dwLanguageId, ; String @ lpBuffer, Long nSize, Long Arguments ENDPROC FUNCTION GetSpecialFolder( tiCSIDL ) LOCAL idl, cFolder m.idl = 0 SHGetSpecialFolderLocation( 0, m.tiCSIDL, @ m.idl ) m.cFolder = REPLICATE( CHR(0), 260 ) SHGetPathFromIDList( m.idl, @ m.cFolder ) RETURN RTRIM( m.cFolder, CHR(0)) ENDFUNC PROCEDURE GetCache WAIT WINDOW NOWAIT '正在提取缓存资料 ......' NOCLEAR LOCAL hFile, iSize, cICEI, iType, iHead, iPos, iResult, cUrl, cLoc m.iSize = 1 m.cICEI = BINTOC( m.iSize, 'rs' ) + REPLICATE( CHR(0), m.iSize ) m.hFile = FindFirstUrlCacheEntry( NULL, @ m.cICEI, @ m.iSize ) m.cICEI = BINTOC( m.iSize, 'rs' ) + REPLICATE( CHR(0), m.iSize ) m.hFile = FindFirstUrlCacheEntry( NULL, @ m.cICEI, @ m.iSize ) IF ( 0 == m.hFile ) MESSAGEBOX( This.Win32Msg( GetLastError()), 16, '错误' ) ELSE DO WHILE .T. m.iHead = CTOBIN( LEFT( m.cICEI, 4 ), 'rs' ) m.iType = CTOBIN( SUBSTR( m.cICEI, 13, 4 ), 'rs' ) m.iType = ICASE( ; 0 != BITAND( m.iType, COOKIE_CACHE_ENTRY ), 1, ; 0 != BITAND( m.iType, URLHISTORY_CACHE_ENTRY ), 2, 0 ) m.iSize = This.GetSize( CTOBIN( SUBSTR( m.cICEI, 25, 4 ), 'rs' )) m.cICEI = SUBSTR( m.cICEI, m.iHead + 1 ) m.iPos = AT( CHR(0), m.cICEI ) m.cUrl = LEFT( m.cICEI, m.iPos - 1 ) DO CASE CASE ( 1 == m.iType ) m.cUrl = SUBSTR( m.cUrl, 8 ) CASE ( 2 == m.iType ) m.cUrl = SUBSTR( m.cUrl, 9 ) OTHERWISE ENDCASE IF ( 2 != m.iType ) DO WHILE ( CHR(0) == SUBSTR( m.cICEI, m.iPos, 1 )) m.iPos = m.iPos + 1 ENDDO m.cICEI = SUBSTR( m.cICEI, m.iPos ) m.iPos = AT( CHR(0), m.cICEI ) m.cLoc = LEFT( m.cICEI, m.iPos - 1 ) ENDIF DO CASE CASE ( 0 == m.iType ) INSERT INTO ie_cached( url, loc, size ) ; VALUES ( m.cUrl, m.cLoc, m.iSize ) CASE ( 1 == m.iType ) INSERT INTO ie_cookie( url, loc, size ) ; VALUES ( m.cUrl, m.cLoc, m.iSize ) OTHERWISE INSERT INTO ie_linked( url ) VALUES ( m.cUrl ) ENDCASE m.iSize = 1 m.cICEI = BINTOC( m.iSize, 'rs' ) + REPLICATE( CHR(0), m.iSize ) m.iResult = FindNextUrlCacheEntry( m.hFile, @ m.cICEI, @ m.iSize ) IF ( 0 == m.iResult ) ; AND ( ERROR_INSUFFICIENT_BUFFER == GetLastError()) m.cICEI = BINTOC( m.iSize, 'rs' ) + REPLICATE( CHR(0), m.iSize ) m.iResult = FindNextUrlCacheEntry( m.hFile, @ m.cICEI, @ m.iSize ) ELSE EXIT ENDIF ENDDO FindCloseUrlCache( m.hFile ) ENDIF SELECT ie_cached REPLACE ALL loc WITH STRTRAN( loc, This.folder_cached, '.' ) SELECT ie_cookie REPLACE ALL loc WITH STRTRAN( loc, This.folder_cookie, '.' ) GOTO TOP IN ie_cached GOTO TOP IN ie_cookie GOTO TOP IN ie_linked WAIT CLEAR This.pgf.Pages( This.pgf.ActivePage ).Grid1.SetFocus() ENDPROC PROCEDURE ClearCache LPARAMETERS tiType WAIT WINDOW NOWAIT '正在清除 ......' NOCLEAR LOCAL sGroupID, hGroup, hFile, iSize, cICEI, iType, iResult *!* m.sGroupID = 0 *!* m.hGroup = FindFirstUrlCacheGroup( ; *!* 0, CACHEGROUP_SEARCH_ALL, NULL, 0, @ m.sGroupID, NULL ) *!* IF ( 0 != m.hGroup ) *!* DO WHILE ( 0 != m.sGroupID ) *!* DeleteUrlCacheGroup( m.sGroupID, CACHEGROUP_FLAG_FLUSHURL_ONDELETE, NULL ) *!* m.sGroupID = 0 *!* FindNextUrlCacheGroup( m.hGroup, @ m.sGroupID, NULL ) *!* ENDDO *!* ENDIF m.iSize = 1 m.cICEI = BINTOC( m.iSize, 'rs' ) + REPLICATE( CHR(0), m.iSize ) m.hFile = FindFirstUrlCacheEntry( NULL, @ m.cICEI, @ m.iSize ) m.cICEI = BINTOC( m.iSize, 'rs' ) + REPLICATE( CHR(0), m.iSize ) m.hFile = FindFirstUrlCacheEntry( NULL, @ m.cICEI, @ m.iSize ) IF ( 0 == m.hFile ) MESSAGEBOX( This.Win32Msg( GetLastError()), 16, '错误' ) ELSE DO WHILE .T. m.iType = CTOBIN( SUBSTR( m.cICEI, 13, 4 ), 'rs' ) m.iType = ICASE( ; 0 != BITAND( m.iType, COOKIE_CACHE_ENTRY ), 1, ; 0 != BITAND( m.iType, URLHISTORY_CACHE_ENTRY ), 2, 0 ) IF ( m.iType == m.tiType ) m.iHead = CTOBIN( LEFT( m.cICEI, 4 ), 'rs' ) m.cICEI = SUBSTR( m.cICEI, m.iHead + 1 ) DeleteUrlCacheEntry( LEFT( m.cICEI, AT( CHR(0), m.cICEI )-1 )) ENDIF m.iSize = 1 m.cICEI = BINTOC( m.iSize, 'rs' ) + REPLICATE( CHR(0), m.iSize ) m.iResult = FindNextUrlCacheEntry( m.hFile, @ m.cICEI, @ m.iSize ) IF ( 0 == m.iResult ) ; AND ( ERROR_INSUFFICIENT_BUFFER == GetLastError()) m.cICEI = BINTOC( m.iSize, 'rs' ) + REPLICATE( CHR(0), m.iSize ) m.iResult = FindNextUrlCacheEntry( m.hFile, @ m.cICEI, @ m.iSize ) ELSE EXIT ENDIF ENDDO FindCloseUrlCache( m.hFile ) ENDIF WAIT CLEAR This.cmdRefresh.Click() ENDPROC FUNCTION win32msg( tiErrNo ) #define FORMAT_MESSAGE_FROM_SYSTEM 0x1000 #define FORMAT_MESSAGE_IGNORE_INSERTS 0x0200 #define FORMAT_MESSAGE_MAX_WIDTH_MASK 0x000000FF #define LANG_USER_DEFAULT 0x0804 LOCAL cBuffer, iLen m.cBuffer = REPLICATE( CHR(0), 256+1 ) m.iLen = FormatMessage( ; FORMAT_MESSAGE_FROM_SYSTEM ; + FORMAT_MESSAGE_MAX_WIDTH_MASK ; + FORMAT_MESSAGE_IGNORE_INSERTS, ; 0, m.tiErrNo, ; LANG_USER_DEFAULT, ; @ m.cBuffer, 256, 0 ) RETURN LEFT( m.cBuffer , m.iLen ) ENDFUNC FUNCTION GetSize( tiSize ) IF ( m.tiSize < 1024 ) RETURN TRANSFORM( m.tiSize ) ENDIF m.tiSize = ROUND( m.tiSize / 1024, 0 ) IF ( m.tiSize < 1024 ) RETURN TRANSFORM( m.tiSize ) + ' KB' ENDIF m.tiSize = ROUND( m.tiSize / 1024, 0 ) IF ( m.tiSize < 1024 ) RETURN TRANSFORM( m.tiSize ) + ' MB' ENDIF m.tiSize = ROUND( m.tiSize / 1024, 0 ) IF ( m.tiSize < 1024 ) RETURN TRANSFORM( m.tiSize ) + ' GB' ENDIF m.tiSize = ROUND( m.tiSize / 1024, 0 ) RETURN TRANSFORM( m.tiSize ) + ' TB' ENDFUNC PROCEDURE Init This.folder_cached = This.GetSpecialFolder( CSIDL_INTERNET_CACHE ) This.folder_cookie = This.GetSpecialFolder( CSIDL_COOKIES ) This.folder_linked = This.GetSpecialFolder( CSIDL_HISTORY ) This.pgf.pagCached.NewObject( 'Grid1', 'Grid' ) This.pgf.pagCookie.NewObject( 'Grid1', 'Grid' ) This.pgf.pagLinked.NewObject( 'Grid1', 'Grid' ) This.AddGridCols( 0 ) This.AddGridCols( 1 ) This.AddGridCols( 2 ) This.AddAbridgeLabel( This.pgf.pagCached, This.folder_cached ) This.AddAbridgeLabel( This.pgf.pagCookie, This.folder_cookie ) This.AddAbridgeLabel( This.pgf.pagLinked, This.folder_linked ) This.cmdRefresh.Click() ENDPROC PROCEDURE AddAbridgeLabel LPARAMETERS toPage, tcText m.toPage.NewObject( 'lblAbridge0', 'Label' ) m.toPage.NewObject( 'lblAbridge1', 'Label' ) WITH m.toPage.lblAbridge0 .BackStyle = 0 .Caption = '缓存文件夹: ' .Move( 25, 8, 70, 17 ) .Visible = .T. ENDWITH WITH m.toPage.lblAbridge1 .BackStyle = 0 .Caption = m.tcText .ForeColor = RGB(0,0,255) .Move( 100, 8, 580, 17 ) .Anchor = 10 .Visible = .T. ENDWITH ENDPROC PROCEDURE AddGridCols LPARAMETERS tiType LOCAL oGrid, cBindCur, iCols DO CASE CASE ( 0 == m.tiType ) m.oGrid = This.pgf.pagCached.Grid1 m.cBindCur = 'ie_cached' m.iCols = 3 CASE ( 1 == m.tiType ) m.oGrid = This.pgf.pagCookie.Grid1 m.cBindCur = 'ie_cookie' m.iCols = 3 OTHERWISE m.oGrid = This.pgf.pagLinked.Grid1 m.cBindCur = 'ie_linked' m.iCols = 1 ENDCASE WITH m.oGrid .AllowCellSelection = .F. .DeleteMark = .F. .GridLineColor = RGB( 192,192,192 ) .HeaderHeight = 20 .RecordSource = m.cBindCur .ColumnCount = m.iCols WITH .Columns(1) AS Column WITH .Header1 AS Header .Caption = 'URL' .Alignment = 2 ENDWITH .ControlSource = m.cBindCur + '.url' .Width = IIF( m.iCols > 1, 300, 2000 ) ENDWITH IF ( m.iCols > 1 ) WITH .Columns(2) AS Column WITH .Header1 AS Header .Caption = '本地缓存文件' .Alignment = 2 ENDWITH .ControlSource = m.cBindCur + '.loc' .Width = 300 ENDWITH ENDIF IF ( m.iCols > 2 ) WITH .Columns(3) AS Column WITH .Header1 AS Header .Caption = '文件大小' .Alignment = 2 ENDWITH .Alignment = 1 .ControlSource = m.cBindCur + '.size' .Width = 75 ENDWITH ENDIF .SetAll( 'FontName', 'Tahoma' ) .SetAll( 'FontSize', 8, 'Column' ) .SetAll( 'DynamicBackColor', 'iif(0=recno()%2,rgb(255,255,255),rgb(255,250,240))' ) .Move( 0, 30, This.pgf.PageWidth, This.pgf.PageHeight - 30 ) .Anchor = 15 .Visible = .T. ENDWITH ENDPROC PROCEDURE Load SET SAFETY OFF SET TALK OFF CREATE CURSOR ie_cached( url V(250), loc V(250), size V(10) ) CREATE CURSOR ie_cookie( url V(250), loc V(250), size V(10) ) CREATE CURSOR ie_linked( url V(250) ) This.decl_api() ENDPROC PROCEDURE cmdRefresh.Click ZAP IN ie_cached ZAP IN ie_cookie ZAP IN ie_linked Thisform.GetCache() Thisform.pgf.pagCached.Grid1.RecordSource = 'ie_cached' Thisform.pgf.pagCookie.Grid1.RecordSource = 'ie_cookie' Thisform.pgf.pagLinked.Grid1.RecordSource = 'ie_linked' ENDPROC PROCEDURE cmdClrCache.Click Thisform.ClearCache(0) ENDPROC PROCEDURE cmdClrCookie.Click LOCAL cMsg TEXT TO m.cMsg NOSHOW 真的要清除 Cookie 吗 ? 清除后,登录某些网站时将需要重新输入你的 id 和口令! ENDTEXT IF ( 6 == MESSAGEBOX( m.cMsg, 4+32+256, '请确认' )) Thisform.ClearCache(1) ENDIF ENDPROC PROCEDURE cmdClrLinked.Click Thisform.ClearCache(2) ENDPROC ENDDEFINE |