---

Hallo zusammen,

ich habe das Problem dass folgende Zeilen unter XP64 nicht mehr funktionieren unter XP 32 jedoch schon. Zu meiner Schande muss ich gestehen das ich dies alles anhand diverser Seiten zusammengestellt habe und nicht wirklich Ahnung davon habe.

Zur Funktion:
Ich habe für SolidWorks ein Druckmanagment-Tool gemacht um auf einfache Weise die verschiedenen Blattgrößen auf die entspechenden Drucker zuzuweisen. Was nachfolgend kommt ist der komplette Sourcecode für die Einstellung der entsprechenden Drucker. Die Probleme gehen los bei dem Aufruf von "Private Sub AusgabeA4vErmitteln(prn As printer)"

'Private Declare Function GetPrivateProfileString Lib _
'  "kernel32" Alias "GetPrivateProfileStringA" (ByVal _
'  lpApplicationName As String, ByVal lpKeyName As Any, _
'  ByVal lpDefault As String, ByVal lpReturnedString As _
'  String, ByVal nSize As Long, ByVal lpFileName As String) _
'  As Long
'
'Private Declare Function WritePrivateProfileString Lib _
'  "kernel32" Alias "WritePrivateProfileStringA" (ByVal _
'  lpApplicationName As String, ByVal lpKeyName As Any, _
'  ByVal lpString As Any, ByVal lpFileName As String) As Long

'Special-Variante
Private Declare Function ReadIni Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WriteIni Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

'Der Inhalt, welcher aus der INI-Datei ausgelesen wird,
'landet in RetStr

Private RetStr As String

Private Declare Function DeviceCapabilities Lib "winspool.drv" Alias "DeviceCapabilitiesA" (ByVal lpDeviceName As String, ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, ByVal dev As Long) As Long
       
Option Explicit
Const DC_PAPERS = 2
Const DC_BINS = 6
Const DC_BINNAMES = 12
Const DC_PAPERNAMES = 16

Dim l As Long, lngResult As Long, lngError As Long
Dim strUser As String, strUserName As String, strBuffer As String

Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) 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 Const LB_SETTABSTOPS = &H192

Dim x As Integer

Private Sub Form_Load()

Druckereinstellungen.Caption = LoadResString(201)
Label1.Caption = LoadResString(202)
Label2.Caption = LoadResString(203)
Label10.Caption = LoadResString(204)
cmdSave.Caption = LoadResString(205)
cmdCancel.Caption = LoadResString(206)

Benutzername
  Dim x%
  Dim prn As printer
  Dim ActiveDrucker As Variant
 
    For x = 0 To Printers.Count - 1
   
    cmbA4vDrucker.AddItem Printers(x).DeviceName
    cmbA3Drucker.AddItem Printers(x).DeviceName
    cmbA2Drucker.AddItem Printers(x).DeviceName
    cmbA1Drucker.AddItem Printers(x).DeviceName
    cmbA0Drucker.AddItem Printers(x).DeviceName
   
    Next x
   
    cmbA4vDrucker.ListIndex = 0
    cmbA3Drucker.ListIndex = 0
    cmbA2Drucker.ListIndex = 0
    cmbA1Drucker.ListIndex = 0
    cmbA0Drucker.ListIndex = 0
   
    Get_DruckerConfig Me, App.Path & "\Config" + "_" + Trim$(strUserName) + ".ini"
   
    ActiveDrucker = cmbA4vDrucker
      For Each prn In Printers
        If prn.DeviceName = ActiveDrucker Then
          Call GetPapersA4v(prn)
          'Call AusgabeA4vErmitteln(prn)
          Exit For
        End If
      Next
   
    ActiveDrucker = cmbA3Drucker
      For Each prn In Printers
        If prn.DeviceName = ActiveDrucker Then
          Call GetPapersA3(prn)
          'Call AusgabeA3Ermitteln(prn)
          Exit For
        End If
      Next
     
    ActiveDrucker = cmbA2Drucker
      For Each prn In Printers
        If prn.DeviceName = ActiveDrucker Then
          Call GetPapersA2(prn)
          'Call AusgabeA2Ermitteln(prn)
          Exit For
        End If
      Next
   
    ActiveDrucker = cmbA1Drucker
      For Each prn In Printers
        If prn.DeviceName = ActiveDrucker Then
          Call GetPapersA1(prn)
          'Call AusgabeA1Ermitteln(prn)
          Exit For
        End If
      Next
   
    ActiveDrucker = cmbA0Drucker
      For Each prn In Printers
        If prn.DeviceName = ActiveDrucker Then
          Call GetPapersA0(prn)
          'Call AusgabeA0Ermitteln(prn)
          Exit For
        End If
      Next
   
    Get_FormatConfig Me, App.Path & "\Config" + "_" + Trim$(strUserName) + ".ini"
    Get_AusgabeConfig Me, App.Path & "\Config" + "_" + Trim$(strUserName) + ".ini"
       
End Sub

Private Sub cmbA4vDrucker_Click()
  Dim prn As printer
   
    If cmbA4vDrucker.ListIndex > -1 Then
      For Each prn In Printers
        If prn.DeviceName = cmbA4vDrucker.List(cmbA4vDrucker.ListIndex) Then
          Call GetPapersA4v(prn)
          Call AusgabeA4vErmitteln(prn)
          Exit For
        End If
      Next
    End If
End Sub

Private Sub cmbA3Drucker_Click()
  Dim prn As printer
   
    If cmbA3Drucker.ListIndex > -1 Then
      For Each prn In Printers
        If prn.DeviceName = cmbA3Drucker.List(cmbA3Drucker.ListIndex) Then
          Call GetPapersA3(prn)
          Call AusgabeA3Ermitteln(prn)
          Exit For
        End If
      Next
    End If
End Sub

Private Sub cmbA2Drucker_Click()
  Dim prn As printer
   
    If cmbA2Drucker.ListIndex > -1 Then
      For Each prn In Printers
        If prn.DeviceName = cmbA2Drucker.List(cmbA2Drucker.ListIndex) Then
          Call GetPapersA2(prn)
          Call AusgabeA2Ermitteln(prn)
          Exit For
        End If
      Next
    End If
End Sub

Private Sub cmbA1Drucker_Click()
  Dim prn As printer
   
    If cmbA1Drucker.ListIndex > -1 Then
      For Each prn In Printers
        If prn.DeviceName = cmbA1Drucker.List(cmbA1Drucker.ListIndex) Then
          Call GetPapersA1(prn)
          Call AusgabeA1Ermitteln(prn)
          Exit For
        End If
      Next
    End If
End Sub

Private Sub cmbA0Drucker_Click()
  Dim prn As printer
   
    If cmbA0Drucker.ListIndex > -1 Then
      For Each prn In Printers
        If prn.DeviceName = cmbA0Drucker.List(cmbA0Drucker.ListIndex) Then
          Call GetPapersA0(prn)
          Call AusgabeA0Ermitteln(prn)
          Exit For
        End If
      Next
    End If
End Sub

Private Sub cmbA4vDruckformat_Click()
   
    Dim Format As String
   
    If cmbA4vDruckformat.ListIndex > -1 Then
      cmbKonstA4v = cmbKonstA4v.List(cmbA4vDruckformat.ListIndex)
    End If
End Sub

Private Sub cmbA3Druckformat_Click()
   
    Dim Format As String
   
    If cmbA3Druckformat.ListIndex > -1 Then
      cmbKonstA3 = cmbKonstA3.List(cmbA3Druckformat.ListIndex)
    End If
End Sub

Private Sub cmbA2Druckformat_Click()
   
    Dim Format As String
   
    If cmbA2Druckformat.ListIndex > -1 Then
      cmbKonstA2 = cmbKonstA2.List(cmbA2Druckformat.ListIndex)
    End If
End Sub

Private Sub cmbA1Druckformat_Click()
   
    Dim Format As String
   
    If cmbA1Druckformat.ListIndex > -1 Then
      cmbKonstA1 = cmbKonstA1.List(cmbA1Druckformat.ListIndex)
    End If
End Sub

Private Sub cmbA0Druckformat_Click()
   
    Dim Format As String
   
    If cmbA0Druckformat.ListIndex > -1 Then
      cmbKonstA0 = cmbKonstA0.List(cmbA0Druckformat.ListIndex)
    End If
End Sub

Private Sub GetPapersA4v(prn As printer)
  Dim x%, p%, AA$, bb$, Papers%, PaperList$
  Dim PSize$, dX&, dY&
  Dim PaperNums%()
  Papers = DeviceCapabilities(prn.DeviceName, prn.Port, DC_PAPERS, ByVal vbNullString, 0)
    If Papers Then
      ReDim PaperNums(1 To Papers)
      Papers = DeviceCapabilities(prn.DeviceName, prn.Port, DC_PAPERS, PaperNums(1), 0)
     
      PaperList = String$(64 * Papers, 0)
      Papers = DeviceCapabilities(prn.DeviceName, prn.Port, DC_PAPERNAMES, ByVal PaperList, 0)
 
      cmbA4vDruckformat.Clear
      cmbKonstA4v.Clear
      For x = 1 To Papers
        AA = Mid(PaperList, 64 * (x - 1) + 1, 64)
        p = InStr(AA, vbNullChar)
        If p Then AA = Left$(AA, p - 1)
        cmbA4vDruckformat.AddItem AA
        cmbKonstA4v.AddItem PaperNums(x)
      Next x
    End If
End Sub

Private Sub GetPapersA3(prn As printer)
  Dim x%, p%, AA$, bb$, Papers%, PaperList$
  Dim PSize$, dX&, dY&
  Dim PaperNums%()
  Papers = DeviceCapabilities(prn.DeviceName, prn.Port, DC_PAPERS, ByVal vbNullString, 0)
    If Papers Then
      ReDim PaperNums(1 To Papers)
      Papers = DeviceCapabilities(prn.DeviceName, prn.Port, DC_PAPERS, PaperNums(1), 0)
     
      PaperList = String$(64 * Papers, 0)
      Papers = DeviceCapabilities(prn.DeviceName, prn.Port, DC_PAPERNAMES, ByVal PaperList, 0)
 
      cmbA3Druckformat.Clear
      cmbKonstA3.Clear
      For x = 1 To Papers
        AA = Mid(PaperList, 64 * (x - 1) + 1, 64)
        p = InStr(AA, vbNullChar)
        If p Then AA = Left$(AA, p - 1)
        cmbA3Druckformat.AddItem AA
        cmbKonstA3.AddItem PaperNums(x)
      Next x
    End If
End Sub

Private Sub GetPapersA2(prn As printer)
  Dim x%, p%, AA$, bb$, Papers%, PaperList$
  Dim PSize$, dX&, dY&
  Dim PaperNums%()
  Papers = DeviceCapabilities(prn.DeviceName, prn.Port, DC_PAPERS, ByVal vbNullString, 0)
    If Papers Then
      ReDim PaperNums(1 To Papers)
      Papers = DeviceCapabilities(prn.DeviceName, prn.Port, DC_PAPERS, PaperNums(1), 0)
     
      PaperList = String$(64 * Papers, 0)
      Papers = DeviceCapabilities(prn.DeviceName, prn.Port, DC_PAPERNAMES, ByVal PaperList, 0)
 
      cmbA2Druckformat.Clear
      cmbKonstA2.Clear
      For x = 1 To Papers
        AA = Mid(PaperList, 64 * (x - 1) + 1, 64)
        p = InStr(AA, vbNullChar)
        If p Then AA = Left$(AA, p - 1)
        cmbA2Druckformat.AddItem AA
        cmbKonstA2.AddItem PaperNums(x)
      Next x
    End If
End Sub

Private Sub GetPapersA1(prn As printer)
  Dim x%, p%, AA$, bb$, Papers%, PaperList$
  Dim PSize$, dX&, dY&
  Dim PaperNums%()
  Papers = DeviceCapabilities(prn.DeviceName, prn.Port, DC_PAPERS, ByVal vbNullString, 0)
    If Papers Then
      ReDim PaperNums(1 To Papers)
      Papers = DeviceCapabilities(prn.DeviceName, prn.Port, DC_PAPERS, PaperNums(1), 0)
     
      PaperList = String$(64 * Papers, 0)
      Papers = DeviceCapabilities(prn.DeviceName, prn.Port, DC_PAPERNAMES, ByVal PaperList, 0)
 
      cmbA1Druckformat.Clear
      cmbKonstA1.Clear
      For x = 1 To Papers
        AA = Mid(PaperList, 64 * (x - 1) + 1, 64)
        p = InStr(AA, vbNullChar)
        If p Then AA = Left$(AA, p - 1)
        cmbA1Druckformat.AddItem AA
        cmbKonstA1.AddItem PaperNums(x)
      Next x
    End If
End Sub

Private Sub GetPapersA0(prn As printer)
  Dim x%, p%, AA$, bb$, Papers%, PaperList$
  Dim PSize$, dX&, dY&
  Dim PaperNums%()
  Papers = DeviceCapabilities(prn.DeviceName, prn.Port, DC_PAPERS, ByVal vbNullString, 0)
    If Papers Then
      ReDim PaperNums(1 To Papers)
      Papers = DeviceCapabilities(prn.DeviceName, prn.Port, DC_PAPERS, PaperNums(1), 0)
     
      PaperList = String$(64 * Papers, 0)
      Papers = DeviceCapabilities(prn.DeviceName, prn.Port, DC_PAPERNAMES, ByVal PaperList, 0)
 
      cmbA0Druckformat.Clear
      cmbKonstA0.Clear
      For x = 1 To Papers
        AA = Mid(PaperList, 64 * (x - 1) + 1, 64)
        p = InStr(AA, vbNullChar)
        If p Then AA = Left$(AA, p - 1)
        cmbA0Druckformat.AddItem AA
        cmbKonstA0.AddItem PaperNums(x)
      Next x
    End If
End Sub

Private Sub AusgabeA4vErmitteln(prn As printer)
    Dim bins As Long
    Dim binList As String
    Dim binNum() As Integer
    Dim binString As String
    'Dim konstString As String
    ReDim a&(1)

    cmbAusgabeA4v.Clear
    cmbAusgabeKonstA4v.Clear

  SendMessage cmbAusgabeA4v.hwnd, LB_SETTABSTOPS, 1, a(0)
 
  bins = DeviceCapabilities(prn.DeviceName, prn.Port, DC_BINS, ByVal vbNullString, 0)
  ReDim binNum(1 To bins)
 
  binList = String(24 * bins, 0)
  bins = DeviceCapabilities(prn.DeviceName, prn.Port, DC_BINS, binNum(1), 0)
  bins = DeviceCapabilities(prn.DeviceName, prn.Port, DC_BINNAMES, ByVal binList, 0)

  For x = 1 To bins
    binString = Mid(binList, 24 * (x - 1) + 1, 24)
    binString = Left(binString, InStr(1, binString, Chr(0)) - 1)
   
    'konstString = String(6 - Len(CStr(binNum(x))), " ") & binNum(x)
    'List1.AddItem binString & Chr$(9) & konstString
    cmbAusgabeA4v.AddItem binString
    cmbAusgabeKonstA4v.AddItem binNum(x)
  Next x
End Sub

Private Sub AusgabeA3Ermitteln(prn As printer)
    Dim bins As Long
    Dim binList As String
    Dim binNum() As Integer
    Dim binString As String
    'Dim konstString As String
    ReDim a&(1)

    cmbAusgabeA3.Clear
    cmbAusgabeKonstA3.Clear

  SendMessage cmbAusgabeA3.hwnd, LB_SETTABSTOPS, 1, a(0)
 
  bins = DeviceCapabilities(prn.DeviceName, prn.Port, DC_BINS, ByVal vbNullString, 0)
  ReDim binNum(1 To bins)
 
  binList = String(24 * bins, 0)
  bins = DeviceCapabilities(prn.DeviceName, prn.Port, DC_BINS, binNum(1), 0)
  bins = DeviceCapabilities(prn.DeviceName, prn.Port, DC_BINNAMES, ByVal binList, 0)

  For x = 1 To bins
    binString = Mid(binList, 24 * (x - 1) + 1, 24)
    binString = Left(binString, InStr(1, binString, Chr(0)) - 1)
   
    'konstString = String(6 - Len(CStr(binNum(x))), " ") & binNum(x)
    'List1.AddItem binString & Chr$(9) & konstString
    cmbAusgabeA3.AddItem binString
    cmbAusgabeKonstA3.AddItem binNum(x)
  Next x
End Sub

Private Sub AusgabeA2Ermitteln(prn As printer)
    Dim bins As Long
    Dim binList As String
    Dim binNum() As Integer
    Dim binString As String
    'Dim konstString As String
    ReDim a&(1)

    cmbAusgabeA2.Clear
    cmbAusgabeKonstA2.Clear

  SendMessage cmbAusgabeA2.hwnd, LB_SETTABSTOPS, 1, a(0)
 
  bins = DeviceCapabilities(prn.DeviceName, prn.Port, DC_BINS, ByVal vbNullString, 0)
 
  If bins <= 0 Then
    Exit Sub
  End If
 
  ReDim binNum(1 To bins)
 
  binList = String(24 * bins, 0)
  bins = DeviceCapabilities(prn.DeviceName, prn.Port, DC_BINS, binNum(1), 0)
  bins = DeviceCapabilities(prn.DeviceName, prn.Port, DC_BINNAMES, ByVal binList, 0)

  For x = 1 To bins
    binString = Mid(binList, 24 * (x - 1) + 1, 24)
    binString = Left(binString, InStr(1, binString, Chr(0)) - 1)
   
    'konstString = String(6 - Len(CStr(binNum(x))), " ") & binNum(x)
    'List1.AddItem binString & Chr$(9) & konstString
    cmbAusgabeA2.AddItem binString
    cmbAusgabeKonstA2.AddItem binNum(x)
  Next x
End Sub

Private Sub AusgabeA1Ermitteln(prn As printer)
    Dim bins As Long
    Dim binList As String
    Dim binNum() As Integer
    Dim binString As String
    'Dim konstString As String
    ReDim a&(1)

    cmbAusgabeA1.Clear
    cmbAusgabeKonstA1.Clear

  SendMessage cmbAusgabeA1.hwnd, LB_SETTABSTOPS, 1, a(0)
 
  bins = DeviceCapabilities(prn.DeviceName, prn.Port, DC_BINS, ByVal vbNullString, 0)
 
  If bins <= 0 Then
    Exit Sub
  End If
 
  ReDim binNum(1 To bins)
 
  binList = String(24 * bins, 0)
  bins = DeviceCapabilities(prn.DeviceName, prn.Port, DC_BINS, binNum(1), 0)
  bins = DeviceCapabilities(prn.DeviceName, prn.Port, DC_BINNAMES, ByVal binList, 0)

  For x = 1 To bins
    binString = Mid(binList, 24 * (x - 1) + 1, 24)
    binString = Left(binString, InStr(1, binString, Chr(0)) - 1)
   
    'konstString = String(6 - Len(CStr(binNum(x))), " ") & binNum(x)
    'List1.AddItem binString & Chr$(9) & konstString
    cmbAusgabeA1.AddItem binString
    cmbAusgabeKonstA1.AddItem binNum(x)
  Next x
End Sub

Private Sub AusgabeA0Ermitteln(prn As printer)
    Dim bins As Long
    Dim binList As String
    Dim binNum() As Integer
    Dim binString As String
    'Dim konstString As String
    ReDim a&(1)

    cmbAusgabeA0.Clear
    cmbAusgabeKonstA0.Clear

  SendMessage cmbAusgabeA0.hwnd, LB_SETTABSTOPS, 1, a(0)
 
  bins = DeviceCapabilities(prn.DeviceName, prn.Port, DC_BINS, ByVal vbNullString, 0)
 
  If bins <= 0 Then
    Exit Sub
  End If
 
  ReDim binNum(1 To bins)
 
  binList = String(24 * bins, 0)
  bins = DeviceCapabilities(prn.DeviceName, prn.Port, DC_BINS, binNum(1), 0)
  bins = DeviceCapabilities(prn.DeviceName, prn.Port, DC_BINNAMES, ByVal binList, 0)

  For x = 1 To bins
    binString = Mid(binList, 24 * (x - 1) + 1, 24)
    binString = Left(binString, InStr(1, binString, Chr(0)) - 1)
   
    'konstString = String(6 - Len(CStr(binNum(x))), " ") & binNum(x)
    'List1.AddItem binString & Chr$(9) & konstString
    cmbAusgabeA0.AddItem binString
    cmbAusgabeKonstA0.AddItem binNum(x)
  Next x
End Sub

Private Sub cmbAusgabeA4v_Click()
   
    Dim Ausgabe As String
   
    If cmbAusgabeA4v.ListIndex > -1 Then
      cmbAusgabeKonstA4v = cmbAusgabeKonstA4v.List(cmbAusgabeA4v.ListIndex)
    End If
End Sub

Private Sub cmbAusgabeA3_Click()
   
    Dim Ausgabe As String
   
    If cmbAusgabeA3.ListIndex > -1 Then
      cmbAusgabeKonstA3 = cmbAusgabeKonstA3.List(cmbAusgabeA3.ListIndex)
    End If
End Sub

Private Sub cmbAusgabeA2_Click()
   
    Dim Ausgabe As String
   
    If cmbAusgabeA2.ListIndex > -1 Then
      cmbAusgabeKonstA2 = cmbAusgabeKonstA2.List(cmbAusgabeA2.ListIndex)
    End If
End Sub

Private Sub cmbAusgabeA1_Click()
   
    Dim Ausgabe As String
   
    If cmbAusgabeA1.ListIndex > -1 Then
      cmbAusgabeKonstA1 = cmbAusgabeKonstA1.List(cmbAusgabeA1.ListIndex)
    End If
End Sub

Private Sub cmbAusgabeA0_Click()
   
    Dim Ausgabe As String
   
    If cmbAusgabeA0.ListIndex > -1 Then
      cmbAusgabeKonstA0 = cmbAusgabeKonstA0.List(cmbAusgabeA0.ListIndex)
    End If
End Sub

Private Sub cmdCancel_Click()
    ' reload printer map
    Seriendruck.Show
    Druckereinstellungen.visible = False
End Sub

Private Sub cmdSave_Click()
    Benutzername
    Set_FormConfig Me, App.Path & "\Config" + "_" + Trim$(strUserName) + ".ini"
    Seriendruck.Show
    Druckereinstellungen.visible = False
End Sub

Public Function Get_DruckerConfig(ByRef F As Form, ByVal IniPath As String)
  'RetStr mit 256 Leerzeichen füllen
  RetStr = Space(256)

  'Anmerkung: Wird anstelle des lpApplicationName
  'ein Nullstring angegeben, erhält man alle Appliction-
  'Namen der gesamten INI-Datei.
  'Das gleiche gilt auch für die lpKeyName Eigenschaft
  'Daten Lesen, wenn die INI-Datei nicht existiert, wird die
  'Standard Left-Eigenschaft der Form zurückgegeben (F.Left)
  ReadIni F.Name, "A4v-Drucker", cmbA4vDrucker, RetStr, Len(RetStr), IniPath
  cmbA4vDrucker = RetStr    'Nullcharzeichen abtrennen, in einen Long-Wert umwandeln und der Form zuweisen
  RetStr = Space(256)
 
  ReadIni F.Name, "A3-Drucker", cmbA3Drucker, RetStr, Len(RetStr), IniPath
  cmbA3Drucker = RetStr
  RetStr = Space(256)
 
  ReadIni F.Name, "A2-Drucker", cmbA2Drucker, RetStr, Len(RetStr), IniPath
  cmbA2Drucker = RetStr
  RetStr = Space(256)
 
  ReadIni F.Name, "A1-Drucker", cmbA1Drucker, RetStr, Len(RetStr), IniPath
  cmbA1Drucker = RetStr
  RetStr = Space(256)
 
  ReadIni F.Name, "A0-Drucker", cmbA0Drucker, RetStr, Len(RetStr), IniPath
  cmbA0Drucker = RetStr
  RetStr = Space(256)
 
End Function

Public Function Get_FormatConfig(ByRef F As Form, ByVal IniPath As String)
  'RetStr mit 256 Leerzeichen füllen
  RetStr = Space(256)

  'Anmerkung: Wird anstelle des lpApplicationName
  'ein Nullstring angegeben, erhält man alle Appliction-
  'Namen der gesamten INI-Datei.
  'Das gleiche gilt auch für die lpKeyName Eigenschaft
  'Daten Lesen, wenn die INI-Datei nicht existiert, wird die
  'Standard Left-Eigenschaft der Form zurückgegeben (F.Left)
  ReadIni F.Name, "A4v-Druckformat", cmbA4vDruckformat, RetStr, Len(RetStr), IniPath
  cmbA4vDruckformat = RetStr
  RetStr = Space(256)
  ReadIni F.Name, "A4v-FormatKonstante", cmbKonstA4v, RetStr, Len(RetStr), IniPath
  cmbKonstA4v = RetStr
  RetStr = Space(256)
 
  ReadIni F.Name, "A3-Druckformat", cmbA3Druckformat, RetStr, Len(RetStr), IniPath
  cmbA3Druckformat = RetStr
  RetStr = Space(256)
  ReadIni F.Name, "A3-FormatKonstante", cmbKonstA3, RetStr, Len(RetStr), IniPath
  cmbKonstA3 = RetStr
  RetStr = Space(256)
 
  ReadIni F.Name, "A2-Druckformat", cmbA2Druckformat, RetStr, Len(RetStr), IniPath
  cmbA2Druckformat = RetStr
  RetStr = Space(256)
  ReadIni F.Name, "A2-FormatKonstante", cmbKonstA2, RetStr, Len(RetStr), IniPath
  cmbKonstA2 = RetStr
  RetStr = Space(256)
 
  ReadIni F.Name, "A1-Druckformat", cmbA1Druckformat, RetStr, Len(RetStr), IniPath
  cmbA1Druckformat = RetStr
  RetStr = Space(256)
  ReadIni F.Name, "A1-FormatKonstante", cmbKonstA1, RetStr, Len(RetStr), IniPath
  cmbKonstA1 = RetStr
  RetStr = Space(256)
 
  ReadIni F.Name, "A0-Druckformat", cmbA0Druckformat, RetStr, Len(RetStr), IniPath
  cmbA0Druckformat = RetStr
  RetStr = Space(256)
  ReadIni F.Name, "A0-FormatKonstante", cmbKonstA0, RetStr, Len(RetStr), IniPath
  cmbKonstA0 = RetStr
 
End Function

Public Function Get_AusgabeConfig(ByRef F As Form, ByVal IniPath As String)
  'RetStr mit 256 Leerzeichen füllen
  RetStr = Space(256)

  'Anmerkung: Wird anstelle des lpApplicationName
  'ein Nullstring angegeben, erhält man alle Appliction-
  'Namen der gesamten INI-Datei.
  'Das gleiche gilt auch für die lpKeyName Eigenschaft
  'Daten Lesen, wenn die INI-Datei nicht existiert, wird die
  'Standard Left-Eigenschaft der Form zurückgegeben (F.Left)
  ReadIni F.Name, "A4v-Ausgabefach", cmbAusgabeA4v, RetStr, Len(RetStr), IniPath
  cmbAusgabeA4v = RetStr
  RetStr = Space(256)
  ReadIni F.Name, "A4v-AusgabeKonstante", cmbAusgabeKonstA4v, RetStr, Len(RetStr), IniPath
  cmbAusgabeKonstA4v = RetStr
  RetStr = Space(256)
 
  ReadIni F.Name, "A3-Ausgabefach", cmbAusgabeA3, RetStr, Len(RetStr), IniPath
  cmbAusgabeA3 = RetStr
  RetStr = Space(256)
  ReadIni F.Name, "A3-AusgabeKonstante", cmbAusgabeKonstA3, RetStr, Len(RetStr), IniPath
  cmbAusgabeKonstA3 = RetStr
  RetStr = Space(256)
 
  ReadIni F.Name, "A2-Ausgabefach", cmbAusgabeA2, RetStr, Len(RetStr), IniPath
  cmbAusgabeA2 = RetStr
  RetStr = Space(256)
  ReadIni F.Name, "A2-AusgabeKonstante", cmbAusgabeKonstA2, RetStr, Len(RetStr), IniPath
  cmbAusgabeKonstA2 = RetStr
  RetStr = Space(256)
 
  ReadIni F.Name, "A1-Ausgabefach", cmbAusgabeA1, RetStr, Len(RetStr), IniPath
  cmbAusgabeA1 = RetStr
  RetStr = Space(256)
  ReadIni F.Name, "A1-AusgabeKonstante", cmbAusgabeKonstA1, RetStr, Len(RetStr), IniPath
  cmbAusgabeKonstA1 = RetStr
  RetStr = Space(256)
 
  ReadIni F.Name, "A0-Ausgabefach", cmbAusgabeA0, RetStr, Len(RetStr), IniPath
  cmbAusgabeA0 = RetStr
  RetStr = Space(256)
  ReadIni F.Name, "A0-AusgabeKonstante", cmbAusgabeKonstA0, RetStr, Len(RetStr), IniPath
  cmbAusgabeKonstA0 = RetStr
  RetStr = Space(256)
 
End Function

'Schreiben der Eigenschaften in die INI-Datei
Public Function Set_FormConfig(ByVal F As Form, ByVal IniPath As String)

  'Beim Schreiben der INI-Dateien gilt:
  'Existiert die INI-Datei noch nicht, so wird sie angelegt
  'Übergibt man einen NullString an den lpApplicationName
  'oder lpKeyName werden alle Applicationen oder Key's
  '(inkl. Werten) gelöscht
  'Übergibt man z.B. anstelle von lpApplicationName und
  'lpKeyName beidemale einen NullString, löscht man die
  'gesamte INI-Datei
  'WriteIni F.Name, lpKeyName, , IniPath
 
  WriteIni F.Name, "A4v-Drucker", CStr(cmbA4vDrucker), IniPath  'Schreibt einen Eintrag in eine INI-Datei (Umwandeln in einen String nicht vergessen)
  WriteIni F.Name, "A4v-Druckformat", CStr(cmbA4vDruckformat), IniPath
  WriteIni F.Name, "A4v-FormatKonstante", CStr(cmbKonstA4v), IniPath
  WriteIni F.Name, "A4v-Ausgabefach", CStr(cmbAusgabeA4v), IniPath
  WriteIni F.Name, "A4v-AusgabeKonstante", CStr(cmbAusgabeKonstA4v), IniPath
 
  WriteIni F.Name, "A3-Drucker", CStr(cmbA3Drucker), IniPath
  WriteIni F.Name, "A3-Druckformat", CStr(cmbA3Druckformat), IniPath
  WriteIni F.Name, "A3-FormatKonstante", CStr(cmbKonstA3), IniPath
  WriteIni F.Name, "A3-Ausgabefach", CStr(cmbAusgabeA3), IniPath
  WriteIni F.Name, "A3-AusgabeKonstante", CStr(cmbAusgabeKonstA3), IniPath
 
  WriteIni F.Name, "A2-Drucker", CStr(cmbA2Drucker), IniPath
  WriteIni F.Name, "A2-Druckformat", CStr(cmbA2Druckformat), IniPath
  WriteIni F.Name, "A2-FormatKonstante", CStr(cmbKonstA2), IniPath
  WriteIni F.Name, "A2-Ausgabefach", CStr(cmbAusgabeA2), IniPath
  WriteIni F.Name, "A2-AusgabeKonstante", CStr(cmbAusgabeKonstA2), IniPath
 
  WriteIni F.Name, "A1-Drucker", CStr(cmbA1Drucker), IniPath
  WriteIni F.Name, "A1-Druckformat", CStr(cmbA1Druckformat), IniPath
  WriteIni F.Name, "A1-FormatKonstante", CStr(cmbKonstA1), IniPath
  WriteIni F.Name, "A1-Ausgabefach", CStr(cmbAusgabeA1), IniPath
  WriteIni F.Name, "A1-AusgabeKonstante", CStr(cmbAusgabeKonstA1), IniPath
 
  WriteIni F.Name, "A0-Drucker", CStr(cmbA0Drucker), IniPath
  WriteIni F.Name, "A0-Druckformat", CStr(cmbA0Druckformat), IniPath
  WriteIni F.Name, "A0-FormatKonstante", CStr(cmbKonstA0), IniPath
  WriteIni F.Name, "A0-Ausgabefach", CStr(cmbAusgabeA0), IniPath
  WriteIni F.Name, "A0-AusgabeKonstante", CStr(cmbAusgabeKonstA0), IniPath
 
  End Function

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  Benutzername

  'Speichern der aktuellen Eigenschaften
  Set_FormConfig Me, App.Path & "\Config" + "_" + Trim$(strUserName) + ".ini"
End Sub

Sub Benutzername()

    strUser = Space(255)
    l = 255
    lngResult = GetUserName(strUser, l)
   
    If lngResult <> 0 Then
        strUserName = Left(strUser, l - 1)
    Else
        lngError = GetLastError()
        strBuffer = Space(255)
        l = 255
        lngResult = FormatMessage(0, 0, lngError, 0, strBuffer, l, 0)
       
        If lngResult <> 0 Then
            strUserName = "Fehler " & lngError & ": " & strBuffer
        Else
            strUserName = "Fehler " & lngError & ": Kein Benutzer"
        End If
    End If
End Sub

Ich hoffe mir kann jemand helfen.

Gruß Ralf

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Ralf,

klar, dass Windows32 Api's nicht mehr unter Windows64 funktionieren. Soweit ich das sehe, kannst du die Druckerinfos aber alle per WMI auslesen (ich habe deinen Code aber nur überflogen).

Hier mal ein paar Beispiele wie das in WIndows32 geht. Unter Windows64 sieht das fast genauso aus, kann ich aber kein Beispiel liefern, da ich kein 64-System habe:

Code:

---

Public Sub Standard_Printer()
    Dim objWMI As Object, objItem As Object
    Set objWMI = GetObject("winmgmts:\\.\root\cimv2"). _
        ExecQuery("Select * from Win32_Printer where Default = 'true'")
    For Each objItem In objWMI
        MsgBox objItem.properties_.Item("Name").Value
    Next
    Set objWMI = Nothing
End Sub

---

Code:

---

Public Sub Duplex()
    Dim objWMI As Object, objItem As Object
    Dim intIndex As Integer
    Set objWMI = GetObject("winmgmts:\\.\root\cimv2"). _
        ExecQuery("Select * from Win32_Printer where Name='Adobe PDF'")
    For Each objItem In objWMI
        For intIndex = LBound(objItem.Capabilities) To LBound(objItem.Capabilities)
            If objItem.Capabilities(intIndex) = 3 Then MsgBox "Duplexfähig"
        Next
    Next
    Set objWMI = Nothing
End Sub

---

Code:

---

Public Sub All_Printers()
    Dim objWMI As Object, objItem As Object
    Set objWMI = GetObject("winmgmts:\\.\root\cimv2"). _
        ExecQuery("Select * from Win32_Printer")
    For Each objItem In objWMI
        Debug.Print objItem.Name
    Next
    Set objWMI = Nothing
End Sub

---

Code:

---

Public Sub PrinterConfiguration_Propertys()
    Dim objWMI As Object, objItem As Object, objProperty As Object
    Set objWMI = GetObject("winmgmts:\\.\root\cimv2"). _
        ExecQuery("Select * from Win32_PrinterConfiguration")
    For Each objItem In objWMI
        For Each objProperty In objItem.properties_
            If IsArray(objProperty.Value) Then
                Debug.Print objProperty.Name, Join(objProperty.Value, " / ")
            Else
                Debug.Print objProperty.Name, objProperty.Value
            End If
        Next
    Next
    Set objWMI = Nothing
End Sub

---

Code:

---

Public Sub Printers_Propertys()
    Dim objWMI As Object, objItem As Object, objProperty As Object
    Set objWMI = GetObject("winmgmts:\\.\root\cimv2"). _
        ExecQuery("Select * from Win32_Printer")
    For Each objItem In objWMI
        For Each objProperty In objItem.properties_
            If IsArray(objProperty.Value) Then
                Debug.Print objProperty.Name, Join(objProperty.Value, " / ")
            Else
                Debug.Print objProperty.Name, objProperty.Value
            End If
        Next
    Next
    Set objWMI = Nothing
End Sub

---

Code:

---

Public Sub Printer_Property()
    Dim objWMI As Object, objItem As Object, objProperty As Object
    Set objWMI = GetObject("winmgmts:\\.\root\cimv2"). _
        ExecQuery("Select * from Win32_Printer where Name='Adobe PDF'")
    For Each objItem In objWMI
        For Each objProperty In objItem.properties_
            If IsArray(objProperty.Value) Then
                Debug.Print objProperty.Name, Join(objProperty.Value, " / ")
            Else
                Debug.Print objProperty.Name, objProperty.Value
            End If
        Next
    Next
    Set objWMI = Nothing
End Sub

---

Was die einzelnen Werte z.B. beim Papier (PaperSizesSupported) bedeuten, kann aus einer Liste entnommen werden: MSDN-Library

------------------
Gruß
Nepumuk  

[Diese Nachricht wurde von Nepumuk am 25. Okt. 2008 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP