数据的定期备份.frm

Windows API函数,希望大伙有用哦

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form 数据备份 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "数据备份"
   ClientHeight    =   1305
   ClientLeft      =   5055
   ClientTop       =   3975
   ClientWidth     =   3555
   FillStyle       =   0  'Solid
   Icon            =   "数据的定期备份.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Moveable        =   0   'False
   ScaleHeight     =   1305
   ScaleWidth      =   3555
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   1380
      Top             =   330
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
End
Attribute VB_Name = "数据备份"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const REG_SZ = 1
Const HKEY_CURRENT_USER = &H80000001
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Sub Form_Load()
Dim strString As String, SaveD As String, M As Date
On Error GoTo A1
   M = GetString(HKEY_CURRENT_USER, "RegData\Date", "")
   SaveD = GetString(HKEY_CURRENT_USER, "RegData\FileDate", "")
   If Val(Date - M) > Val(SaveD) Then
'    Call FileSave
    Else
    Unload Me
   End If
   Exit Sub
A1:
    strString = Date
    SaveString HKEY_CURRENT_USER, "RegData", "Date", strString
    strString = "5"
    SaveString HKEY_CURRENT_USER, "RegData", "FileDate", strString
    Unload Me
End Sub
Private Sub FileSave()
Dim FileName1 As String, FileName2 As String
On Error GoTo X1
    CommonDialog1.Filter = "数据库文件 (*.mdb)|*.mdb|文本文件 (*.txt)|*.txt"
    CommonDialog1.ShowOpen
    FileName1 = CommonDialog1.FileName
    CommonDialog1.ShowSave
    FileName2 = CommonDialog1.FileName
    FileCopy FileName1, FileName2
    SaveString HKEY_CURRENT_USER, "RegData", "Date", Date
    Unload Me
 Exit Sub
X1:
  Unload Me
End Sub
Function GetString(hKey As Long, strPath As String, strValue As String)
    Dim Ret As Long
    RegOpenKey hKey, strPath, Ret
    GetString = RegQueryStringValue(Ret, strValue)
    RegCloseKey Ret
End Function
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
    Dim strString As String
    Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
    RegQueryValueEx hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize
    strBuf = String(lDataBufSize, Chr$(0))
    RegQueryValueEx hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize
    RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
End Function
Sub SaveString(hKey As Long, strPath As String, strValue As String, strData As String)
    Dim Ret As Long
    RegCreateKey hKey, strPath, Ret
    RegSetValue Ret, strValue, REG_SZ, strData, Len(strData)
    RegCloseKey Ret
End Sub