欢迎光临:
  
  非常感谢您光临枕善居。本站是一个免费的基于VB,VB.NET源代码交流的平台,为大家提供优质的专业的源代码,如果您有需要,本站可以帮助在业余时间里给您寻找代码。当然,如果您有好的代码也可以在本站发布,共享给大家。
专业VB和.NET源码、编程开发教程、图标资源、USB电脑遥控器、智能家电控制开关....更多东东请进入我的淘宝小店--->
VB及.NET新源码2011(3DVD,控件+资源) 智能多路控制(串口编程开关) 带源码!


07-11
23

一个API方式存取日志文件的模块


'**************************************

' 模块名称: AppendToLog
' 功能描述:一个很不错的日志文件写入模块,不同于
'     open/print/close写文件方法,这个模块使用API
'     存取文件,这样保证文件能正确的存取,及时被
'     存取的文件正被其他用户打开。这个模块是最安全
'     有效的文件写入方法,用于日志文件的创建,当然
'     也可以用于其他文件存取。
'   : 枕善居收藏整理
'**************************************
'API 声明
Const GENERIC_WRITE = &H40000000
Const FILE_SHARE_READ = &H1
Const Create_NEW = 1
Const OPEN_EXISTING = 3
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_BEGIN = 0
Const INVALID_HANDLE_VALUE = -1

Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long

Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long

Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long

Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long

Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

'**************************************
' 模块名称: AppendToLog
' 功能描述:一个很不错的日志文件写入模块,不同于
'     open/print/close写文件方法,这个模块使用API
'     存取文件,这样保证文件能正确的存取,及时被
'     存取的文件正被其他用户打开。这个模块是最安全
'     有效的文件写入方法,用于日志文件的创建,当然
'     也可以用于其他文件存取。
'   : 枕善居收藏整理
'
' 输入参数:lpFileName As String - 要写入的日志文件名称
' 返 回 值:True 成功, False 失败
'**************************************
Private Function AppendToLog(ByVal lpFileName As String, ByVal sMessage As String) As Boolean
    'appends a string to a text file. it's u
    '     p to the coder to add a CR/LF at the end
    '    
    'of the string if (s)he so desires.
    'assume failure
    AppendToLog = False
    
    'exit if the string cannot be written to
    '     disk
    If Len(sMessage) < 1 Then Exit Function
    
    'get the size of the file (if it exists)
    '    
    Dim fLen As Long
    fLen = 0
    


    If (Len(Dir(lpFileName))) Then
        fLen = FileLen(lpFileName)
    End If
    
    'open the log file, create as necessary
    Dim hLogFile As Long
    hLogFile = CreateFile(lpFileName, GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, _
    IIf(Len(Dir(lpFileName)), OPEN_EXISTING, Create_NEW), _
    FILE_ATTRIBUTE_NORMAL, 0&)
    
    'ensure the log file was opened properly
    '    
    If (hLogFile = INVALID_HANDLE_VALUE) Then Exit Function
    
    'move file pointer to end of file if fil
    '     e was not created


    If (fLen <> 0) Then


        If (SetFilePointer(hLogFile, fLen, ByVal 0&, FILE_BEGIN) = &HFFFFFFFF) Then
            'exit sub if the pointer did not set cor
            '     rectly
            CloseHandle (hLogFile)
            Exit Function
        End If
    End If
    
    'convert the source string to a byte arr
    '     ay for use with WriteFile
    Dim lTemp As Long
    ReDim TempArray(0 To Len(sMessage) - 1) As Byte
    


    For lTemp = 1 To Len(sMessage)
        TempArray(lTemp - 1) = Asc(Mid$(sMessage, lTemp, 1))
    Next
    
    'write the string to the log file


    If (WriteFile(hLogFile, TempArray(0), Len(sMessage), lTemp, ByVal 0&) <> 0) Then
        'the data was written correctly
        AppendToLog = True
    End If
    
    'flush buffers and close the file
    FlushFileBuffers (hLogFile)
    CloseHandle (hLogFile)
    
End Function



回复回复txyyanis [2007-11-24 09:37:38 |  | del]
下了,用了,不错!
一个小小问题:不支持双字节字符串
'convert the source string to a byte arr
    '     ay for use with WriteFile
    Dim lTemp As Long
    ReDim TempArray(0 To Len(sMessage) - 1) As Byte
    


    For lTemp = 1 To Len(sMessage)
        TempArray(lTemp - 1) = Asc(Mid$(sMessage, lTemp, 1))
    Next
    
    'write the string to the log file


    If (WriteFile(hLogFile, TempArray(0), Len(sMessage), lTemp, ByVal 0&) <> 0) Then

改为:
'convert the source string to a byte arr
    '     ay for use with WriteFile
    Dim lTemp As Long
    TempArray= StrConv(sMessage, vbFromUnicode)
    lTemp = UBound(TempArray) + 1
    
    'write the string to the log file


    If (WriteFile(hLogFile, TempArray(0), lTemp, lTemp, ByVal 0&) <> 0) Then
估计就行了。
回复回复dabingrain [2007-12-16 14:49:29 |  | del]
Dim lTemp As Long
    Dim TempArray() As Byte
    TempArray = StrConv(sMessage, vbFromUnicode)
    lTemp = UBound(TempArray) + 1
    
    'write the string to the log file


    If (WriteFile(hLogFile, TempArray(0), lTemp, lTemp, ByVal 0&) <> 0) Then
        'the data was written correctly
        AppendToLog = True
    End If

就可以了
发表评论
您没有权限发表评论!