modfilesystem.bas

主要是对文件的一些操作:加密、解密文件

Attribute VB_Name = "modFileAndFolder"
'*************************************************************************
'**模 块 名：modFileSystem
'**创 建 人：王滋华
'**日    期：2004年03月23日
'**修 改 人：
'**日    期：
'**描    述：该模块主要包含对文件系统操作的函数或方法
'**版    本：V1.0
'*************************************************************************
Option Explicit
    
Private Type BrowseInfo      '声明一个自定义函数,该函数用于向API函数SHBrowseForFolder传递参数
    hWndOwner As Long        '指定该函数所依附的窗口的句柄
    pIDLRoot As Long         '??????
    pszDisplayName As Long   '??????????
    lpszTitle As Long        '
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long

'*************************************************************************
'**函 数 名：GetFolder
'**输    入：无
'**输    出：GetFolder
'**功能描述：显示并返回选择文件夹对话框
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2004年03月23日
'**修 改 人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
Public Function GetFolder() As String

  Dim iNull As Integer, lpIDList As Long, lResult As Long
  Dim sPath As String, udtBI As BrowseInfo

    With udtBI
        'Set the owner window
        .hWndOwner = frmMain.hwnd
        'lstrcat appends the two strings and returns the memory address
        .lpszTitle = lstrcat("请选择文件夹", "")
        'Return only if the user selected a directory
        .ulFlags = BIF_RETURNONLYFSDIRS Or 100 Or 200 Or 400
    End With

    'Show the 'Browse for folder' dialog
    lpIDList = SHBrowseForFolder(udtBI)
    If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        'Get the path from the IDList
        SHGetPathFromIDList lpIDList, sPath
        'free the block of memory
        CoTaskMemFree lpIDList
        iNull = InStr(sPath, vbNullChar)
        If iNull Then
            sPath = Left$(sPath, iNull - 1)
        End If
    End If
    If Len(sPath) > 0 Then
        GetFolder = IIf(Right$(sPath, 1) = "\", sPath, sPath & "\")
      Else
        GetFolder = sPath
    End If

End Function

'*************************************************************************
'**函 数 名：KillFile
'**输    入：FileName(String)
'**输    出：无
'**功能描述：彻底删除文件(无法恢复)
'**全局变量：
'**调用模块：
'**作    者：王滋华
'**日    期：2004年03月24日
'**修 改 人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
Public Sub KillFile(FileName As String)

  Dim fn As Long       '文件号
  Dim FileSize As Long '记录文件大小
  Dim i As Long        '循环计数器
  Dim data As Byte   '写入要删除的文件的信息以覆盖源信息

    If Len(Dir$(FileName)) > 0 Then '判断文件时候存在
        fn = FreeFile                               '获取一个没有使用的文件号               '获取一个没有使用的文件号,用于要删除的文件
        FileSize = FileLen(FileName) '获取要删除的文件的大小
        Open FileName For Binary As #fn '用二进制方式打开要删除的文件
        For i = 1 To FileSize       '开始循环,共循环filesize次(循环体开始)
            data = Int(Rnd * 200)       '获取200以内的一个随机数
            Put #fn, , data             '将data里的数据写入文件,覆盖源数据
        Next i                      '循环体结束
        Close #fn                       '关闭文件
    
        Kill FileName               '删除文件
    End If

End Sub

Public Function GetTmpFileName() As String

  Dim tmpFile As String
  Dim tmpPath As String

    GetTempPath 255, tmpPath
    tmpPath = Left$(tmpPath, InStrRev(tmpPath, "\"))
    tmpFile = String(260, 0)
    GetTempFileName tmpPath, "tg", 0, tmpFile
    GetTmpFileName = Left$(tmpFile, InStr(1, tmpFile, Chr$(0)) - 1)

End Function