Declare Function LoadLibrary Lib "Kernel" (ByVal LibFileName$) As Integer
Declare Sub FreeLibrary Lib "Kernel" (ByVal LibHandle%)

Declare Function Getprofilestring Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyname As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer) As Integer
Declare Function WriteProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyname As Any, ByVal lpString As Any) As Integer
Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyname As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFilename As String) As Integer
Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyname As Any, ByVal lpString As Any, ByVal lplFilename As String) As Integer

'Im Usenet veroeffentlicht durch:
'iluvatar@daimi.aau.dk                  |   Torben Koch 
'                                       |   Rosenhoej 8A, 1.mf.
'I'm not the best, but who could tell?  |   DK-8260 Viby J    
'And if I were, then who could tell?    |   Denmark
'(Except me, and who would care?)       |   +45 86 72 08 24

'zuletzt modifiziert durch Dirk Burkamp

Type TPrinterList
  List(1 To 50)  As String
End Type


Dim alleDrucker As TPrinterList


Function ErsetzeErstesGleichDurchKomma (s As String) As String
    Dim pos As Integer
    pos = InStr(s, "=")
    ErsetzeErstesGleichdurchKomma = Left$(s, pos - 1) & "," & Mid$(s, pos + 1)
End Function


Function GetDefaultPrinter () As String
' Gibt den Default Drucker zurueck

  Dim tmp As String

  KernelGetProfileString "windows", "device", "(none)", tmp
  GetDefaultPrinter = tmp
  
End Function

Function KernelGetPrinterList (AList As TPrinterList)
'
' Gibt eine Drucker-Device-Liste zurueck der Form:
' Zum Beispiel:
' alleDrucker.List(1)="Microsoft Fax=WPSUNI,FAX:"
' alleDrucker.List(2)="Rendering Subsystem=WPSUNI,PUB:"
' alleDrucker.List(3)="HP DeskJet 550C Printer=DESKJETC,LPT1:"
' alleDrucker.List(4)="WINFAX=WINFAX,COM1:"


  Dim i As Integer
  Dim p As Integer
  Dim s1 As String
  Dim s2 As String
  Dim tmp As Integer

  s1 = Space$(1024)
  
  tmp = Getprofilestring("devices", 0&, "", s1, 1024)

  i = 1
  p = InStr(s1, Chr$(0))
  While p > 1
    AList.List(i) = Left$(s1, p - 1)
    s2 = Space$(128)
    tmp = Getprofilestring("devices", AList.List(i), "", s2, 128)
    s2 = Left$(s2, tmp)
    AList.List(i) = AList.List(i) & "=" & s2
    s1 = Mid$(s1, p + 1)
    p = InStr(s1, Chr$(0))
    i = i + 1
  Wend

  KernelGetPrinterList = i - 1
End Function

Sub KernelGetPrivateProfileString (lpApplicationName$, lpKeyname$, lpDefault$, lpReturnedString$, lpFilename$)

  Dim rtString As String
  Dim tmp As Integer

  rtString = Space$(512)
  tmp = GetPrivateProfileString(lpApplicationName, lpKeyname, lpDefault, rtString, 512, lpFilename)
  lpReturnedString = Left$(rtString, tmp)

End Sub

Sub KernelGetProfileString (lpAppName$, lpKeyname$, lpDefault$, lpReturnedString$)

  Dim rtString As String
  Dim tmp As Integer

  rtString = Space$(512)

  tmp = Getprofilestring(lpAppName, lpKeyname, lpDefault, rtString, 512)
  lpReturnedString = Left$(rtString, tmp)

End Sub

Sub KernelWritePrivateProfilestring (lpApplicationName$, lpKeyname$, lpString$, lplFilename$)

  Dim tmp As Integer

  tmp = WritePrivateProfileString(lpApplicationName, lpKeyname, lpString, lplFilename)

End Sub

Sub KernelWriteProfilestring (lpApplicationName$, lpKeyname$, lpString$)

  Dim tmp As Integer
  tmp = WriteProfileString(lpApplicationName$, lpKeyname$, lpString$)

End Sub

Sub SetDefaultPrinter (Printer As String)
' Setzt den Default-Drucker auf ein Element der DruckerListe
' Allerdings muss das "="-Zeichen durch ein ","-Zeichen ersetzt werden

  KernelWriteProfilestring "windows", "device", Printer

End Sub