Windows Develop

Development Platform:
Visual Basic

FileControl.bas：Code Content
							Attribute VB_Name = "FileControl"
'Download by http://www.codefans.net
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
Public Declare Function GetLogicalDrives Lib "kernel32" () As Long
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
'Find Files
Declare Function SearchTreeForFile Lib "IMAGEHLP.DLL" (ByVal lpRootPath As String, ByVal lpInputName As String, ByVal lpOutputName As String) As Long
'Browse for DIR
'API's for selecting a windows directory
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Type BROWSEINFO
   hOwner           As Long
   pidlRoot         As Long
   pszDisplayName   As String
   lpszTitle        As String
   ulFlags          As Long
   lpfn             As Long
   lParam           As Long
   iImage           As Long
End Type
'Constants
Public OurFiles As String 'Returns list of files found in DIR
Function IfFileExists(ByVal sFilename As String) As Boolean
    Dim I As Long
    On Error Resume Next
    I = Len(Dir$(sFilename))
    If Err Or I = 0 Then
        IfFileExists = False
    Else
        IfFileExists = True
    End If
End Function
Sub SaveTextAppend(Path As String, StringName As String)
    On Error Resume Next
    Open Path$ For Append As #1
    Print #1, StringName
    Close #1
End Sub
Sub SaveTextOutput(Path As String, StringName As String)
    On Error Resume Next
    Open Path$ For Output As #1
    Print #1, StringName
    Close #1
End Sub
Public Function FolderExist(ByVal pName As String) As Boolean
    Rem ---------------------------------
    Rem Check folder
    Rem ---------------------------------
    Dim lFso As Scripting.FileSystemObject
    On Error GoTo Cerr
    Set lFso = New Scripting.FileSystemObject
    FolderExist = lFso.FolderExists(pName)
    Exit Function
Cerr:
    FolderExist = False
End Function
Public Function FileExists2(sFilename As String) As Boolean
    If Len(sFilename$) = 0 Then
        FileExists2 = False
        Exit Function
    End If
    If Len(Dir$(sFilename$)) Then
        FileExists2 = True
    Else
        FileExists2 = False
    End If
End Function
Public Function FileExists(ByVal pFilename As String) As Boolean
    Rem ---------------------------------
    Rem Check for file existence
    Rem ---------------------------------
    On Error GoTo FileExists_Err
    If FileLen(pFilename) > 0 Then
        FileExists = True
    Else
        FileExists = False
    End If
    GoTo FileExists_Out
FileExists_Err:
    FileExists = False
FileExists_Out:
End Function
Public Function DirExists(strDir As String) As Boolean
    'change C:MyDir
    strDir = Dir(strDir, vbDirectory)
    If (strDir = "") Then
        DirExists = False
    Else
        DirExists = True
    End If
End Function
Public Sub SaveListBox(Directory As String, TheList As ListBox)
    Dim savelist As Long
    On Error Resume Next
    fe = FreeFile
    Open Directory$ For Output As #fe
    For savelist = 0 To TheList.ListCount - 1
    bufff = TheList.List(savelist)
    bufff = Replace(bufff, Chr(13), "

						