|
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
|