Вывод текущей даты и времени

Получение информации об используемом принтере

Листинг 3.86. Информация о принтере

' Объявление API-функции

Declare Function GetProfileStringA Lib "kernel32" _

(ByVal lpAppName As String, ByVal lpKeyName As String, _

ByVal lpDefault As String, ByVal lpReturnedString As _

String, ByVal nSize As Long) As Long

Sub Принтер()

Dim strFullInfo As String * 255 ' Буфер для API-функции

Dim strInfo As String ' Строка с полной информацией

Dim strPrinter As String ' Название принтера

Dim strDriver As String ' Драйвер принтера

Dim strPort As String ' Порт принтера

Dim strMessage As String

Dim intPrinterEndPos As Integer

Dim intDriverEndPos As Integer

' Заполнение буфера пробелами

strFullInfo = Space(255)

' Получение полной информации о принтере

Call GetProfileStringA("Windows", "Device", "", strFullInfo, 254)

' Удаление лишних символов из конца возвращенной строки

' Строка strInfo имеет формат <имя_принтера>,<драйвер>,<порт>:

strInfo = Trim(strFullInfo)

' Поиск запятых в строке (окончаний названий принтера и драйвера)

intPrinterEndPos = Application.Find(",", strInfo, 1)

intDriverEndPos = Application.Find(",", strInfo, intPrinterEndPos + 1)

' Определение названия принтера

strPrinter = Left(strInfo, intPrinterEndPos - 1)

' Определение драйвера

strDriver = Mid(strInfo, intPrinterEndPos + 1, intDriverEndPos _

- intPrinterEndPos - 1)

' Определение порта (его название заканчивается символом ":")

strPort = Mid(strInfo, intDriverEndPos + 1, InStr(1, strInfo, ":") _

- intDriverEndPos - 1)

' Формирование информационного сообщения

strMessage = "Принтер:" & Chr(9) & strPrinter & Chr(13)

strMessage = strMessage & "Драйвер:" & strDriver & Chr(13)

strMessage = strMessage & "strPort:" & Chr(9) & strPort

' Вывод информационного сообщения

MsgBox strMessage, vbInformation, "Сведения о принтере по умолчанию"

End Sub

Листинг 3.87. Сообщение о дате и времени

Sub TimeAndDate()

Dim strDate As String, strTime As String

Dim strGreeting As String

Dim strUserName As String

Dim intSpacePos As Integer

strDate = Format(Date, "Long Date")

strTime = Format(Time, "Medium Time")

' Приветствие - в зависимости от времени суток

If Time < TimeValue("12:00") Then

strGreeting = "Доброе утро, "

ElseIf Time < TimeValue("17:00") Then

strGreeting = "Добрый день, "

Else

strGreeting = "Добрый вечер, "

End If

' В приветствие добавляется имя текущего пользователя

strUserName = Application.UserName

intSpacePos = InStr(1, strUserName, " ", 1)

' Управление ситуацией, когда в имени нет пробела

If intSpacePos = 0 Then intSpacePos = Len(strUserName)

strGreeting = strGreeting & Left(strUserName, intSpacePos)

' Вывод на экран информационного сообщения о дате и времени

MsgBox strDate & vbCrLf & strTime, vbOKOnly, strGreeting

End Sub

Дата добавления: 2015-06-25