frmdeletetempfile.frm

管理文档的原代码,可以把扫描的文档归类,便于查询

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form FrmDeleteTempFile 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "删除临时目录"
   ClientHeight    =   2700
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4680
   Icon            =   "FrmDeleteTempFile.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2700
   ScaleWidth      =   4680
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Command2 
      Caption         =   "返回(&R)"
      Height          =   495
      Left            =   2880
      TabIndex        =   5
      Top             =   2040
      Width           =   1095
   End
   Begin VB.CommandButton CmdOK 
      Caption         =   "开始(&S)"
      Height          =   495
      Left            =   720
      TabIndex        =   4
      Top             =   2040
      Width           =   1095
   End
   Begin VB.PictureBox Picture1 
      BorderStyle     =   0  'None
      Height          =   495
      Left            =   0
      Picture         =   "FrmDeleteTempFile.frx":030A
      ScaleHeight     =   495
      ScaleWidth      =   4935
      TabIndex        =   3
      Top             =   0
      Width           =   4935
   End
   Begin VB.Timer Timer1 
      Interval        =   50
      Left            =   480
      Top             =   0
   End
   Begin VB.PictureBox Picture2 
      BorderStyle     =   0  'None
      Height          =   135
      Left            =   0
      Picture         =   "FrmDeleteTempFile.frx":A6AC
      ScaleHeight     =   135
      ScaleWidth      =   5055
      TabIndex        =   1
      Top             =   480
      Width           =   5055
      Begin VB.PictureBox Picture3 
         BorderStyle     =   0  'None
         Height          =   135
         Left            =   0
         Picture         =   "FrmDeleteTempFile.frx":BF12
         ScaleHeight     =   135
         ScaleWidth      =   5055
         TabIndex        =   2
         Top             =   0
         Width           =   5055
      End
   End
   Begin VB.Timer Timer2 
      Interval        =   200
      Left            =   0
      Top             =   0
   End
   Begin MSComctlLib.ProgressBar PgsBar 
      Height          =   495
      Left            =   480
      TabIndex        =   0
      Top             =   1320
      Width           =   3735
      _ExtentX        =   6588
      _ExtentY        =   873
      _Version        =   393216
      Appearance      =   1
      Scrolling       =   1
   End
   Begin VB.Label Label1 
      Caption         =   "系统正准备删除临时文件..."
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   480
      TabIndex        =   6
      Top             =   840
      Width           =   3975
   End
End
Attribute VB_Name = "FrmDeleteTempFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public Sub CmdOK_Click()
On Error Resume Next
Dim tPath As String
Dim tFileID As Integer
Dim i As Integer
Dim fs As FileSystemObject
Dim fds As Folder
Dim fd As Folder
Dim tCount As Integer

Set fs = CreateObject("Scripting.FileSystemObject")

Label1.Caption = "系统正在删除临时文件..."
Set GblRdoRes = GblRdoCon.OpenResultset("select distinct(temp_path) from efile_table where sysdate-1>upload_date and file_status=0", rdOpenDynamic, rdConcurRowVer)
i = 1
While Not GblRdoRes.EOF
    PgsBar.Value = i / GblRdoRes.RowCount
    Me.Refresh
    DoEvents
    DelDir RemoveString(GblRdoRes.rdoColumns("temp_path"), "\", 2)
    'RemoveFile RemoveString(GblRdoRes.rdoColumns("temp_path"), "\", 2) + "\*.*"
    'RemoveDirectory RemoveString(GblRdoRes.rdoColumns("temp_path"), "\", 2)
    GblRdoRes.MoveNext
    i = i + 1
Wend
PgsBar.Value = 1
GblRdoCon.Execute "delete from efile_table where sysdate-1>upload_date and file_status=0"

Label1.Caption = "系统正在删除其他临时文件..."
Set GblRdoRes = GblRdoCon.OpenResultset("select * from root_table where root_type=0 and root_status=0", rdOpenDynamic, rdConcurRowVer)
If GblRdoRes.EOF Then Exit Sub
Set fds = fs.GetFolder(GblRdoRes.rdoColumns("root_path"))
i = 1
PgsBar.Value = 0
tCount = fds.SubFolders.Count
For Each fd In fds.SubFolders
    PgsBar.Value = i / tCount
    If Mid(fd.Name, 1, 2) <> Format(Date, "dd") Then
       fd.Delete True
    End If
    i = i + 1
Next
PgsBar.Value = 1
MsgBox "临时文件已经全部删除", vbExclamation, XTTS
Label1.Caption = "系统正准备删除临时文件..."
PgsBar.Value = 0
Call SaveEventLog("6099", 0, "", "", "删除临时文件")

Exit Sub
Err:
   MsgBox "删除临时文件时出错，系统终止", vbExclamation, XTTS
   PgsBar.Value = 0
   Label1.Caption = "系统正准备删除临时文件..."
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Form_Load()
PgsBar.Min = 0
PgsBar.Max = 1
PgsBar.Value = 0
End Sub

Private Sub Timer1_Timer()
Picture3.Left = Picture3.Left + 50
If Picture3.Left > Picture2.Left + Picture2.Width Then
   Picture3.Left = Picture2.Left - Picture3.Width
End If
End Sub