首页 > 代码库 > VB6-AppendToLog 通过API写入日志
VB6-AppendToLog 通过API写入日志
工作中免不了需要为自己的程序添加日志,我也从网上扒拉了一个老外写的模块,修改修改了下,凑合用吧。
1 Option Explicit 2 ‘************************************** 3 ‘ 模块名称: AppendToLog 通过API写入日志 4 ‘************************************** 5 ‘API 声明 6 Private Const GENERIC_WRITE = &H40000000 7 Private Const FILE_SHARE_READ = &H1 8 Private Const Create_NEW = 1 9 Private Const OPEN_EXISTING = 310 Private Const FILE_ATTRIBUTE_NORMAL = &H8011 Private Const FILE_BEGIN = 012 Private Const INVALID_HANDLE_VALUE = http://www.mamicode.com/-113 Private 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 Long14 Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long15 Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long16 Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long17 Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long18 19 ‘调用:Call AppendToLog("测试模块名","测试日志内容")20 ‘**************************************21 ‘ 方法名称: AppendToLog22 ‘ 输入参数:sMdl 模块名称 sMessage 日志内容23 ‘**************************************24 Public Sub AppendToLog(sMdl As String, sMessage As String)25 26 On Error GoTo Err:27 28 ‘获取计算机名、用户名、本机ip29 Dim LocalInfo As String30 Dim strLocalIP As String31 Dim winIP As Object32 LocalInfo = LocalInfo & " Computer:" & Environ("computername")33 LocalInfo = LocalInfo & " User:" & Environ("username")34 Set winIP = CreateObject("MSWinsock.Winsock")35 strLocalIP = winIP.LocalIP36 LocalInfo = LocalInfo & " IP:" & strLocalIP37 38 Dim lpFileName As String39 lpFileName = App.Path + "\Log"40 If Dir(lpFileName, vbDirectory) = "" Then41 MkDir (lpFileName)42 End If43 44 lpFileName = lpFileName + "\" + Format(Now, "yyyymmdd") + ".log"45 46 sMessage = "--" + Format(Now, "yyyy-mm-dd hh:mm:ss") + " 模块:" + sMdl + LocalInfo + vbNewLine + sMessage + vbNewLine47 ‘appends a string to a text file.48 ‘it‘s up to the coder to add a CR/LF at the end49 ‘of the string if (s)he so desires.50 ‘assume failure51 ‘AppendToLog = False52 ‘exit if the string cannot be written to disk53 If Len(sMessage) < 1 Then Exit Sub54 ‘get the size of the file (if it exists)55 Dim fLen As Long: fLen = 056 If (Len(Dir(lpFileName))) Then: fLen = FileLen(lpFileName)57 ‘open the log file, create as necessary58 Dim hLogFile As Long59 hLogFile = CreateFile(lpFileName, GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, _60 IIf(Len(Dir(lpFileName)), OPEN_EXISTING, Create_NEW), _61 FILE_ATTRIBUTE_NORMAL, 0&)62 ‘ensure the log file was opened properly63 If (hLogFile = INVALID_HANDLE_VALUE) Then Exit Sub64 ‘move file pointer to end of file if file was not created65 If (fLen <> 0) Then66 If (SetFilePointer(hLogFile, fLen, ByVal 0&, FILE_BEGIN) = &HFFFFFFFF) Then67 ‘exit sub if the pointer did not set correctly68 CloseHandle (hLogFile)69 Exit Sub70 End If71 End If72 ‘convert the source string to a byte array for use with WriteFile73 Dim lTemp As Long74 ReDim TempArray(0 To Len(sMessage) - 1) As Byte75 TempArray = StrConv(sMessage, vbFromUnicode)76 lTemp = UBound(TempArray) + 177 ‘write the string to the log file78 If (WriteFile(hLogFile, TempArray(0), lTemp, lTemp, ByVal 0&) <> 0) Then79 ‘the data was written correctly80 ‘AppendToLog = True81 End If82 ‘flush buffers and close the file83 FlushFileBuffers (hLogFile)84 CloseHandle (hLogFile)85 Exit Sub86 Err:87 MsgBox "日志写入出错,原因是" + Err.Description, vbExclamation, "提示信息"88 89 End Sub
声明:以上内容来自用户投稿及互联网公开渠道收集整理发布,本网站不拥有所有权,未作人工编辑处理,也不承担相关法律责任,若内容有误或涉及侵权可进行投诉: 投诉/举报 工作人员会在5个工作日内联系你,一经查实,本站将立刻删除涉嫌侵权内容。