form1.frm

一个GPS监控系统中

    Dim strPath As String
    Dim pos As Integer
    Dim strFolderPath As String
    '句柄
    bi.hOwner = Me.hWnd
    '展开根目录
    'bi.pidlRoot = 0&
    '列表框标题
    bi.lpszTitle = "请选择文件夹路径："
    '规定只能选择文件夹，其他无效
    bi.ulFlags = BIF_RETURNONLYFSDIRS
    '调用API函数显示列表框
    pidl = SHBrowseForFolder(bi)
    '利用API函数获取返回的路径
    strPath = Space$(512)
    R = SHGetPathFromIDList(ByVal pidl&, ByVal strPath)
    If R Then
        pos = InStr(strPath, Chr$(0))
        strFolderPath = Left(strPath, pos - 1)
        Call SaveSetting(App.Path, "common", "strFolderPath", strFolderPath)
        TxtOpen = strFolderPath
        m_strSourceFolder = strFolderPath
    Else
        strFolderPath = ""
    End If
    
End Sub

Private Sub CmdSave_Click()
    Dim bi As BROWSEINFO
    Dim R As Long
    Dim pidl As Long
    Dim strPath As String
    Dim pos As Integer
    Dim strFolderPath As String
    '句柄
    bi.hOwner = Me.hWnd
    '展开根目录
    'bi.pidlRoot = 0&
    '列表框标题
    bi.lpszTitle = "请选择文件夹路径："
    '规定只能选择文件夹，其他无效
    bi.ulFlags = BIF_RETURNONLYFSDIRS
    '调用API函数显示列表框
    pidl = SHBrowseForFolder(bi)
    '利用API函数获取返回的路径
    strPath = Space$(512)
    R = SHGetPathFromIDList(ByVal pidl&, ByVal strPath)
    If R Then
        pos = InStr(strPath, Chr$(0))
        strFolderPath = Left(strPath, pos - 1)
        Call SaveSetting(App.Path, "common", "strFolderPath", strFolderPath)
        TxtSave = strFolderPath
        m_strDestFolder = strFolderPath
    Else
        strFolderPath = ""
    End If
End Sub

Private Sub Command1_Click()
    m_strSourceFolder = TxtOpen
    m_strDestFolder = TxtSave
    If m_strSourceFolder = "" Then
        Call MsgBox("请输入加密地图路径！", vbOKOnly, "提示")
        Exit Sub
    End If
    If m_strDestFolder = "" Then
        Call MsgBox("请输入加密完地图输出路径！", vbOKOnly, "提示")
        Exit Sub
    End If
    Timer.Enabled = True
    Timer.Interval = 10
    ProgressBar.Visible = True
    Timer_Timer
    DoEvents
    Call EncryptFunction(m_strSourceFolder, m_strDestFolder, "12345678")
    Timer.Enabled = False
    ProgressBar.Visible = False
    Label3.Visible = True
    'DecryptFun "c:\tempmap", "", "12345678"
    'Map.Geoset = m_strDestFile
End Sub

Private Sub subEncryptFun(v_strSourceFolder As String, v_strDestFolder As String, v_strKey As String)
    Dim fso As New FileSystemObject
    Dim F, fFile, fFolder
    Dim strfileName As String
    Dim strSourceFileName As String
    Dim strDestFileName As String
    Dim strKey As String
    Dim i As Integer
    Dim strTemp As String
    
    If fso.FolderExists(v_strSourceFolder) = True Then
        Set F = fso.GetFolder(v_strSourceFolder)
        Set fFile = F.Files
        For Each f1 In fFile
            strfileName = f1.Name
            i = InStrRev(strfileName, ".", Len(strfileName), vbTextCompare)
            strTemp = Right(strfileName, Len(strfileName) - i)
            
            strDestFileName = v_strDestFolder + "\" + strfileName
            strSourceFileName = v_strSourceFolder + "\" + strfileName
            
            If UCase(strTemp) = "TAB" Or UCase(strTemp) = "GST" Then
                Set EncryptObject = encryptdes
                strKey = v_strKey
                Call EncryptObject.EncryptFile(strSourceFileName, strDestFileName, strKey)
            Else
                If (UCase(strTemp) = "DAT") Then
                    Set EncryptObject = New clsSimpleXOR
                    strKey = v_strKey
                    Call EncryptObject.EncryptFile(strSourceFileName, strDestFileName, strKey)
                Else
                    fso.CopyFile strSourceFileName, strDestFileName, True
                End If
            End If
            DoEvents
        Next
    End If
End Sub
Private Function EncryptFunction(v_strSourceFolder As String, v_strDestFolder As String, v_strKey As String) As Integer
    Dim fso As New FileSystemObject
    Dim F, fFile, fFolder
    Dim strfileName As String
    Dim strSourceFolderName As String
    Dim strDestFolderName As String
    Dim strKey As String
    Dim i As Integer
    Dim strTemp As String
    Call subEncryptFun(v_strSourceFolder, v_strDestFolder, v_strKey)
    Set F = fso.GetFolder(v_strSourceFolder)
    Set fFolder = F.SubFolders
    For Each f1 In fFolder
        '先创建文件夹
        If fso.FolderExists(v_strDestFolder + "\" + f1.Name) Then
            Call fso.DeleteFolder(v_strDestFolder + "\" + f1.Name)
        End If
        strDestFolderName = fso.CreateFolder(v_strDestFolder + "\" + f1.Name)
        Set F = fso.GetFolder(f1)
        strSourceFolderName = F
        
        Call subEncryptFun(strSourceFolderName, strDestFolderName, v_strKey)
    Next
        
    

    Set fso = Nothing
End Function

'Private Sub Command2_Click()
'    DecryptFun "c:\tempmap", "", "12345678"
'End Sub
Private Sub subDecryptFun(v_strSourceFolder As String, v_strDestFolder As String, v_strKey As String)
    Dim fso As New FileSystemObject
    Dim F, fc
    Dim strfileName As String
    Dim strSourceFileName As String
    Dim strDestFileName As String
    Dim strKey As String
    Dim i As Integer
'    Dim strTemp As String
'    Dim strEnviron As String
'    Dim strDestFolder As String
'
'    strEnviron = Environ("temp")
'    strDestFolder = strEnviron + "\temp"
'
'    If fso.FolderExists(strDestFolder) Then
'        Call fso.DeleteFolder(strDestFolder)
'    End If
'    fso.CreateFolder (strDestFolder)
'    SetFileAttributes strDestFolder, vbHidden
    If fso.FolderExists(v_strSourceFolder) = True Then
        Set F = fso.GetFolder(v_strSourceFolder)
        Set fc = F.Files
        For Each f1 In fc
            strfileName = f1.Name
            i = InStrRev(strfileName, ".", Len(strfileName), vbTextCompare)
            strTemp = Right(strfileName, Len(strfileName) - i)
            
            strDestFileName = v_strDestFolder + "\" + strfileName
            strSourceFileName = v_strSourceFolder + "\" + strfileName
            If UCase(strTemp) = "TAB" Or UCase(strTemp) = "GST" Then
                If UCase(strTemp) = "GST" Then
                    m_strDestFile = strDestFileName
                End If
                Set EncryptObject = encryptdes
                strKey = v_strKey
                Call EncryptObject.DecryptFile(strSourceFileName, strDestFileName, strKey)
            Else
                If (UCase(strTemp) = "DAT") Then
                    Set EncryptObject = New clsSimpleXOR
                    strKey = v_strKey
                    Call EncryptObject.DecryptFile(strSourceFileName, strDestFileName, strKey)
                Else
                    fso.CopyFile strSourceFileName, strDestFileName, True
                End If
            End If
        Next
    
    End If
    Set fso = Nothing

End Sub

Private Function DecryptFun(v_strSourceFolder As String, v_strDestFolder As String, v_strKey As String) As Integer
    Dim fso As New FileSystemObject
    Dim F, fFile, fFolder
    Dim strfileName As String
    Dim strSourceFolderName As String
    Dim strDestFolderName As String
    Dim strKey As String
    Dim i As Integer
    Dim strTemp As String
    Dim strEnviron As String
    Dim strDestFolder As String
    
    strEnviron = Environ("temp")
    strDestFolder = strEnviron + "\temp"
    If fso.FolderExists(strDestFolder) Then
        Call fso.DeleteFolder(strDestFolder)
    End If
    fso.CreateFolder (strDestFolder)
    SetFileAttributes strDestFolder, vbHidden
    
    Call subDecryptFun(v_strSourceFolder, strDestFolder, v_strKey)
    Set F = fso.GetFolder(v_strSourceFolder)
    Set fFolder = F.SubFolders
    For Each f1 In fFolder
        '先创建文件夹
        strDestFolderName = fso.CreateFolder(strDestFolder + "\" + f1.Name)
        Set F = fso.GetFolder(f1)
        strSourceFolderName = F
        
        Call subDecryptFun(strSourceFolderName, strDestFolderName, v_strKey)
    Next
End Function

Private Sub Command10_Click()

End Sub

Private Sub Command2_Click()
Set EncryptObject = encryptdes
'    Call EncryptObject.GetSomeEncryptFile("c:\Eph-http.log", "", 10, "12345678")
    Call EncryptObject.PutSomeDecryptFile("c:\Eph-http.log", "", 64, "12345678")
    
End Sub

Private Sub Command3_Click()
    Map.CurrentTool = miZoomInTool
End Sub

Private Sub Command4_Click()
    Map.CurrentTool = miZoomOutTool
End Sub

Private Sub Command5_Click()
    m_CenterX = Map.CenterX
    m_CenterY = Map.CenterY
    m_MapZoom = Map.Zoom
End Sub

Private Sub Command6_Click()

Map.Geoset = ""
Call EncryptFunction("c:\maps", "c:\tempMap", "12345678")
DecryptFun "c:\tempmap", "", "12345678"
Map.Geoset = m_strDestFile

Map.CenterX = m_CenterX
Map.CenterY = m_CenterY
Map.Zoom = m_MapZoom

End Sub

Private Sub Command7_Click()
Set EncryptObject = encryptdes
    Call EncryptObject.GetSomeEncryptFile("c:\Eph-http.log", "", 64, "12345678")
End Sub

Private Sub Command8_Click()
    Map.CurrentTool = miPanTool
End Sub

Private Sub Command9_Click()
    Dim fso As New FileSystemObject
    Dim strDestFolder As String
    
    strEnviron = Environ("temp")
    strDestFolder = strEnviron + "\temp"
    
    If fso.FolderExists(strDestFolder) Then
        Call fso.DeleteFolder(strDestFolder)
    End If
    Set fso = Nothing
    Unload Me
    
End Sub

'Private Sub Command4_Click()
'    Map.Geoset = m_strDestFile
'End Sub

Private Sub Form_Load()
 Set encryptdes = New clsDES
 Label3.Visible = False
 ProgressBar.Max = 10
 ProgressBar.Min = 1
' Set clsSimpleXOR = New clsSimpleXOR
End Sub

Private Sub Timer_Timer()
    If ProgressBar.Value >= ProgressBar.Max Then
        ProgressBar.Value = 1
    End If
    ProgressBar.Value = ProgressBar.Value + 1
End Sub