frmmain.frm

定时备份Oracle数据库和文件的程序 支持RAR压缩功能

End Sub

Private Sub CmdSave_Click()
    If Len(TxtDmpPath) > 0 Then
        If IsDirName(TxtDmpPath) = False Then
           MsgBox "ORACLE备份目录［" & TxtDmpPath & "］不存在,请检查输入是否正确！"
           Exit Sub
        End If

     
        If InStr(1, TxtDmpPath, " ") > 0 Then
           MsgBox "ORACLE备份目录［" & TxtDmpPath & "］存在空格,备份将不能正常进行，请检查输入是否正确！"
           Exit Sub
        End If
   End If

   If Len(TxtSoure) > 0 And Len(TxtTag) > 0 Then
         If IsDirName(TxtSoure) = False Then
           MsgBox "源文件目录［" & TxtSoure & "］不存在,请检查输入是否正确！"
           Exit Sub
        End If
        
          If IsDirName(TxtTag) = False Then
           MsgBox "文件备份目录［" & TxtTag & "］不存在,请检查输入是否正确！"
           Exit Sub
        End If
         
         If TxtSoure = TxtTag Then
           MsgBox "源文件目录和文件备份目录不允许为同一个目录，请修改！"
           Exit Sub
         End If
   End If
   
   If Len(TxtDmpPath) = 0 And Len(TxtTag) = 0 Then
      MsgBox "请至少设置一个备份目录！否则运行此程序将没有意义！"
      Exit Sub
   End If
    
  SaveReg
  ItemUnEanble
  Timer1.Enabled = True
End Sub



'*************************************************************************
'**函 数 名：Form_Load
'**输    入：无
'**输    出：无
'**功能描述：
'**全局变量：
'**调用模块：
'**作    者：杨军
'**日    期：2008年07月24日
'**修 改 人：
'**日    期：
'**版    本：版本1.0
'*************************************************************************





Private Sub Form_Load()
  '打开错误处理陷阱
  On Error GoTo ErrGoto
  '----------------------------------------------------
  '代码正文
  Dim intX As Integer, intY As Integer, i As Integer, intW As Integer, intH As Integer

  '保证当前进程的唯一性
  If App.PrevInstance = True Then
   ' Unload Me
    End
  End If

  '--------------------------------
  '托盘处理
  AddToTray Me, frmMenu.RightMenu     '增加图标到托盘
  RemoveFromTray                      '清除托盘内的图标

  '把窗体移动到上次关闭时的位置
  intX = Val(GetSetting(App.Title, "Settings", "X", Str((Screen.Width - Me.Width) / 2)))
  intY = Val(GetSetting(App.Title, "Settings", "Y", Str((Screen.Height - Me.Height) / 2)))
  intW = Val(GetSetting(App.Title, "Settings", "W", Str(Me.Width)))
  intH = Val(GetSetting(App.Title, "Settings", "H", Str(Me.Height)))
  Me.Move intX, intY, intW, intH

  '--------------------------------
  '窗体圆角处理
  Call CornerEdit

 GetReg
  
 txtexp = Exppath & "\exp.exe"

 ItemUnEanble
  '----------------------------------------------------

   Exit Sub

  '-----------------------------
ErrGoto:

End Sub

'*************************************************************************
'**函 数 名：Form_Resize
'**输    入：无
'**输    出：无
'**功能描述：
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2003年04月24日
'**修 改 人：
'**日    期：
'**版    本：版本1.0
'*************************************************************************
Private Sub Form_Resize()
  '打开错误处理陷阱
  On Error GoTo ErrGoto

  '----------------------------------------------
  '窗体界面调整
  If WindowState <> vbMinimized Then

    If Me.Width < 7155 Then
      Me.Width = 7155
    End If
    If Me.Height < 5445 Then      '5445
      Me.Height = 5445
    End If

    imgCorner(1).Left = Me.Width - 105
    imgCorner(2).Top = Me.Height - 105
    imgCorner(3).Left = Me.Width - 105
    imgCorner(3).Top = Me.Height - 105

    imgBorder(1).Left = Me.Width - 45
    imgBorder(2).Top = Me.Height - 45

    imgTitleButton(0).Left = Me.Width - 930
    imgTitleButton(1).Left = Me.Width - 630
    imgTitleButton(2).Left = Me.Width - 330

    lblTitle.Width = Me.Width - 345
    '----------------------------------------------
  End If
  '-----------------------------
  If WindowState <> vbMinimized Then
    LastState = WindowState
    Call CornerEdit                          '窗体圆角处理
  End If
  '-----------------------------------------------
  '托盘处理
  Select Case WindowState
   Case vbMinimized                        '最小化
    AddToTray Me, frmMenu.RightMenu     '增加图标到托盘
    SetTrayTip "自动备份系统"              '设置新的提示信息
    Me.Visible = False
   Case vbMaximized                        '最大化
    RemoveFromTray                      '清除托盘内的图标
   Case vbNormal                           '正常状态
    RemoveFromTray                      '清除托盘内的图标
  End Select
  '----------------------------------------------------
   Exit Sub
  '-----------------------------
ErrGoto:
  Resume Next

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'   保存信息到注册表
    Dim l_MsgBox As Integer
On Error Resume Next
    Call SaveReg
    '保存窗口状态
    If Me.WindowState <> 2 Then
      SaveSetting App.Title, "Settings", "X", Str(Me.Left)
      SaveSetting App.Title, "Settings", "Y", Str(Me.Top)
      SaveSetting App.Title, "Settings", "W", Str(Me.Width)
      SaveSetting App.Title, "Settings", "H", Str(Me.Height)
    End If
    l_MsgBox = MsgBox("如你现在退出本自动备份程序，在备份程序被再次启动前，将不能进行自动备份！是否仍要退出？", vbOKCancel, "提示!")
    '如按了OK键
    If l_MsgBox = vbOK Then
        
        RemoveFromTray
        End
    Else
        Cancel = 1
    End If

End Sub


'*************************************************************************
'**函 数 名：imgTitleButton_Click
'**输    入：Index(Integer) - 0 min； 1 Max； 2 Close
'**输    出：无
'**功能描述：
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2003年04月24日
'**修 改 人：
'**日    期：
'**版    本：版本1.0
'*************************************************************************
Private Sub imgTitleButton_Click(Index As Integer)
  '打开错误处理陷阱
  On Error GoTo ErrGoto
  '----------------------------------------------------
  '代码正文
  Dim i As Integer
  Select Case Index
   Case 0                          '最小化
    Me.WindowState = 1
   Case 1                          '最大化
    If Me.WindowState = 0 Then
      Me.WindowState = 2
      imgTitleButton(Index).Picture = imgTitleButtonPic(1).Picture
    Else
      Me.WindowState = 0
      imgTitleButton(Index).Picture = imgTitleButtonPic(0).Picture
    End If
   Case 2                         '关闭
'    If Me.WindowState <> 2 Then
'      SaveSetting App.Title, "Settings", "X", Str(Me.Left)
'      SaveSetting App.Title, "Settings", "Y", Str(Me.Top)
'      SaveSetting App.Title, "Settings", "W", Str(Me.Width)
'      SaveSetting App.Title, "Settings", "H", Str(Me.Height)
'    End If
    Unload Me
  End Select
  '----------------------------------------------------
   Exit Sub
  '-----------------------------
ErrGoto:

End Sub

'*************************************************************************
'**函 数 名：lblTitle_DblClick
'**输    入：无
'**输    出：无
'**功能描述：
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2003年04月29日
'**修 改 人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
Private Sub lblTitle_DblClick()
  Call imgTitleButton_Click(1)
End Sub

'*************************************************************************
'**函 数 名：lblTitle_MouseDown
'**输    入：Button(Integer) -
'**        ：Shift(Integer)  -
'**        ：X(Single)       -
'**        ：Y(Single)       -
'**输    出：无
'**功能描述：移动窗体
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2003年04月24日
'**修 改 人：
'**日    期：
'**版    本：版本1.0
'*************************************************************************
Private Sub lblTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = 1 And Me.WindowState = 0 Then
    Dim ReturnVal As Long
    X = ReleaseCapture()
    ReturnVal = SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
  End If
End Sub

'*************************************************************************
'**函 数 名：CornerEdit
'**输    入：无
'**输    出：无
'**功能描述：圆角处理
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2003年04月24日
'**修 改 人：
'**日    期：
'**版    本：版本1.0
'*************************************************************************
Private Sub CornerEdit()
  Dim XY(6) As POINTAPI
  Dim hRgn As Long
  With Me
    XY(0).X = 0
    XY(0).Y = .Height / 15
    XY(1).X = 0
    XY(1).Y = 60 / 15
    XY(2).X = 45 / 15
    XY(2).Y = 0
    XY(3).X = (.Width - 45) / 15
    XY(3).Y = 0
    XY(4).X = .Width / 15
    XY(4).Y = 60 / 15
    XY(5).X = .Width / 15
    XY(5).Y = .Height / 15
    XY(6).X = 0
    XY(6).Y = .Height / 15
  End With

  hRgn = CreatePolygonRgn(XY(0), 7, 2)
  Call SetWindowRgn(Me.hwnd, hRgn, True)
End Sub

'*************************************************************************
'**函 数 名：imgBorder_MouseDown
'**输    入：Index(Integer)  -
'**        ：Button(Integer) -
'**        ：Shift(Integer)  -
'**        ：X(Single)       -
'**        ：Y(Single)       -
'**输    出：无
'**功能描述：
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2003年04月29日
'**修 改 人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
Private Sub imgBorder_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  Call imgCorner_MouseDown(Index + 10, Button, Shift, X, Y)
End Sub

'*************************************************************************
'**函 数 名：imgBorder_MouseMove
'**输    入：Index(Integer)  -
'**        ：Button(Integer) -
'**        ：Shift(Integer)  -
'**        ：X(Single)       -
'**        ：Y(Single)       -
'**输    出：无
'**功能描述：
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2003年04月29日
'**修 改 人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
Private Sub imgBorder_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  Call imgCorner_MouseMove(Index + 10, Button, Shift, X, Y)
End Sub

'*************************************************************************
'**函 数 名：imgCorner_MouseDown
'**输    入：Index(Integer)  -
'**        ：Button(Integer) -
'**        ：Shift(Integer)  -
'**        ：X(Single)       -
'**        ：Y(Single)       -
'**输    出：无
'**功能描述：
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2003年04月29日
'**修 改 人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
Private Sub imgCorner_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Me.WindowState <> 0 Then Exit Sub
  Dim intFlag As Long
  If Button = 1 And Me.WindowState = 0 Then
    Dim ReturnVal As Long
    X = ReleaseCapture()
    Select Case Index
     Case 0