Code:
Option Explicit'Funktionen aus mehreren einzelnen anweisungen zusammengebastelt und mit hilfe von
'api und foren zum laufen gebracht
Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" _
(ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Private Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" _
(ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lparam As Any) As Long
Private Function fstrDField(mytext As String, delim As String, GroupNum As Integer) As String
Dim StartPos As Integer
Dim EndPos As Integer
Dim GroupPtr As Integer
Dim ChPtr As Integer
ChPtr = 1
For GroupPtr = 1 To GroupNum - 1
ChPtr = InStr(1, mytext, delim)
If ChPtr = 0 Then
fstrDField = ""
Exit Function
Else
ChPtr = ChPtr + 1
End If
Next GroupPtr
StartPos = ChPtr
EndPos = InStr(StartPos + 1, mytext, delim)
If EndPos = 0 Then
EndPos = Len(mytext) + 1
End If
fstrDField = Mid(mytext, StartPos, EndPos - StartPos)
End Function
Function SetDefaultPrinter(strPrinterName As String) As Boolean
Dim strDeviceLine As String
Dim strBuffer As String
Dim lngbuf As Long
strBuffer = Space(1024)
lngbuf = GetProfileString("PrinterPorts", strPrinterName, "", strBuffer, Len(strBuffer))
If lngbuf > 0 Then
strDeviceLine = strPrinterName & "," & fstrDField(strBuffer, Chr(0), 1) & "," & _
fstrDField(strBuffer, Chr(0), 2)
Call WriteProfileString("windows", "Device", strDeviceLine)
SetDefaultPrinter = True
Call SendMessage(&HFFFF&, &H1A, 0, ByVal "windows")
Else
SetDefaultPrinter = False
End If
End Function
Function GetDefaultPrinter() As String
Dim strDefault As String
Dim lngbuf As Long
strDefault = String(255, Chr(0))
lngbuf = GetProfileString("Windows", "Device", "", strDefault, Len(strDefault))
If lngbuf > 0 Then
GetDefaultPrinter = fstrDField(strDefault, ",", 1)
Else
GetDefaultPrinter = ""
End If
End Function
Function GetPrinters() As String
Dim strBuffer As String
Dim strOnePtr As String
Dim intPos As Integer
Dim lngChars As Long
strBuffer = Space(2048)
lngChars = GetProfileString("PrinterPorts", vbNullString, "", strBuffer, Len(strBuffer))
If lngChars > 0 Then
intPos = InStr(strBuffer, Chr(0))
Do While intPos > 1
strOnePtr = Left(strBuffer, intPos - 1)
strBuffer = Mid(strBuffer, intPos + 1)
'!!!Achtung KomboBox!!!
frm_Control.cbo_Printer.AddItem strOnePtr
GetPrinters = GetPrinters & strOnePtr
intPos = InStr(strBuffer, Chr(0))
Loop
Else
GetPrinters = ""
End If
End Function
Foren auf CAD.de
| 
