遍历目录解压所有zip文件到系统临时目录代码,ASP代码库,德仔网

代码语言
代码分类
【ASP】遍历目录解压所有zip文件到系统临时目录
作者:DDT / 发布于2012/10/22/ 1040
<div>Option Explicit</div>
<div></div>
<div>Private Const BIF_STATUSTEXT = &H4&</div>
<div>Private Const BIF_RETURNONLYFSDIRS = 1</div>
<div>Private Const BIF_DONTGOBELOWDOMAIN = 2</div>
<div>Private Const MAX_PATH = 260</div>
<div></div>
<div>Private Const WM_USER = &H400</div>
<div>Private Const BFFM_INITIALIZED = 1</div>
<div>Private Const BFFM_SELCHANGED = 2</div>
<div>Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)</div>
<div>Private Const BFFM_SETSELECTION = (WM_USER + 102)</div>
<div></div>
<div>Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long</div>
<div>Private Declare Function SHBrowseForFolder Lib "Shell32" (lpbi As BrowseInfo) As Long</div>
<div>Private Declare Function SHGetPathFromIDList Lib "Shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long</div>
<div>Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long</div>
<div>Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long</div>
<div>Private Type BrowseInfo</div>
<div> hWndOwner   As Long</div>
<div> pIDLRoot    As Long</div>
<div> pszDisplayName As Long</div>
<div> lpszTitle   As Long</div>
<div> ulFlags    As Long</div>
<div> lpfnCallback  As Long</div>
<div> lParam     As Long</div>
<div> iImage     As Long</div>
<div>End Type</div>
<div></div>
<div>Private m_CurrentDirectory As String  'The current directory</div>
<div>Dim fso As New Scripting.FileSystemObject</div>
<div>Dim objShell As New Shell</div>
<div>Dim objFolderItem As FolderItems</div>
<div>Dim temppath As String ' receives name of temporary file path</div>
<div></div>
<div>Private Function BrowseForFolder(owner As Form, Title As String, StartDir As String) As String</div>
<div> 'Opens a Treeview control that displays the directories in a computer</div>
<div></div>
<div> Dim lpIDList As Long</div>
<div> Dim szTitle As String</div>
<div> Dim sBuffer As String</div>
<div> Dim tBrowseInfo As BrowseInfo</div>
<div> m_CurrentDirectory = StartDir & vbNullChar</div>
<div></div>
<div> szTitle = Title</div>
<div> With tBrowseInfo</div>
<div>  .hWndOwner = owner.hWnd</div>
<div>  .lpszTitle = lstrcat(szTitle, "")</div>
<div>  .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_STATUSTEXT</div>
<div>  .lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc) 'get address of function.</div>
<div> End With</div>
<div></div>
<div> lpIDList = SHBrowseForFolder(tBrowseInfo)</div>
<div> If (lpIDList) Then</div>
<div>  sBuffer = Space(MAX_PATH)</div>
<div>  SHGetPathFromIDList lpIDList, sBuffer</div>
<div>  sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)</div>
<div>  BrowseForFolder = sBuffer</div>
<div> Else</div>
<div>  BrowseForFolder = ""</div>
<div> End If</div>
<div></div>
<div>End Function</div>
<div></div>
<div>Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long</div>
<div></div>
<div> Dim lpIDList As Long</div>
<div> Dim ret As Long</div>
<div> Dim sBuffer As String</div>
<div></div>
<div> On Error Resume Next 'Sugested by MS to prevent an error from</div>
<div>            'propagating back into the calling process.</div>
<div>  </div>
<div> Select Case uMsg</div>
<div></div>
<div>  Case BFFM_INITIALIZED</div>
<div>   Call SendMessage(hWnd, BFFM_SETSELECTION, 1, m_CurrentDirectory)</div>
<div>  </div>
<div>  Case BFFM_SELCHANGED</div>
<div>   sBuffer = Space(MAX_PATH)</div>
<div>  </div>
<div>   ret = SHGetPathFromIDList(lp, sBuffer)</div>
<div>   If ret = 1 Then</div>
<div>    Call SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, sBuffer)</div>
<div>   End If</div>
<div>  </div>
<div> End Select</div>
<div></div>
<div> BrowseCallbackProc = 0</div>
<div></div>
<div>End Function</div>
<div></div>
<div>' This function allows you to assign a function pointer to a vaiable.</div>
<div>Private Function GetAddressofFunction(add As Long) As Long</div>
<div> GetAddressofFunction = add</div>
<div>End Function</div>
<div></div>
<div>Private Sub UnZip(ByVal myZipFile, ByVal myTargetDir)</div>
<div>  Set objFolderItem = objShell.NameSpace(myZipFile).Items()</div>
<div>  objShell.NameSpace(myTargetDir).CopyHere objFolderItem, 256</div>
<div>End Sub</div>
<div></div>
<div>Private Sub TreeUnzip(ByVal sPath As String, ByVal sFileSpec As String)</div>
<div>Dim sDir     As String</div>
<div>Dim sSubDirs()   As String</div>
<div>Dim Index As Integer</div>
<div></div>
<div>   If Right(sPath, 1) <> "\" Then</div>
<div>     sPath = sPath & "\"</div>
<div>   End If</div>
<div>   sDir = Dir(sPath & sFileSpec)</div>
<div>  </div>
<div>   Do While Len(sDir)</div>
<div>      sDir = Dir</div>
<div>      UnZip sDir, temppath</div>
<div>   Loop</div>
<div>  </div>
<div>   Index = 0</div>
<div>   sDir = Dir(sPath & "*.*", 16)</div>
<div>   Do While Len(sDir)</div>
<div>      If Left(sDir, 1) <> "." Then</div>
<div>         If GetAttr(sPath & sDir) And vbDirectory Then</div>
<div>            Index = Index + 1</div>
<div>            ReDim Preserve sSubDirs(1 To Index)</div>
<div>            sSubDirs(Index) = sPath & sDir & "\"</div>
<div>         End If</div>
<div>      End If</div>
<div>   sDir = Dir</div>
<div>   Loop</div>
<div></div>
<div>   For Index = 1 To Index</div>
<div>      TreeSearch sSubDirs(Index), sFileSpec</div>
<div>   Next Index</div>
<div></div>
<div>End Sub</div>
<div>'Microsoft Scripting Runtime</div>
<div>'Microsoft Shell Controls And Automation</div>
<div>Sub test()</div>
<div>Dim getdir As String</div>
<div>getdir = BrowseForFolder(Me, "Select A Directory", Text1.Text)</div>
<div>If Len(getdir) = 0 Then</div>
<div>  Exit Sub 'user selected cancel</div>
<div>End If</div>
<div>Dim slength As Long ' receives length of string returned for the path</div>
<div>Dim lastfour As Long ' receives hex value of the randomly assigned ????</div>
<div></div>
<div>' Get Windows's temporary file path</div>
<div>temppath = Space(255) ' initialize the buffer to receive the path</div>
<div>slength = GetTempPath(255, temppath) ' read the path name</div>
<div>temppath = Left(temppath, slength) ' extract data from the variable</div>
<div>temppath = temppath & "\choise"</div>
<div>If Not fso.FolderExists(temppath) Then</div>
<div>fso.CreateFolder (temppath)</div>
<div>End If</div>
<div>TreeUnzip getdir, "*.zip"</div>
<div>End Sub</div>
<div></div>
试试其它关键字
　遍历目录　
同语言下
可能有用的
DDT贡献的其它代码(160)