×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

macro to print host file to text file

macro to print host file to text file

macro to print host file to text file

(OP)
Hi,

Does anyone have a macro to print file from extra to text file?
I would really appreciate it a lot!

Thanks

RE: macro to print host file to text file

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  MACRO NAME: PRTSCR32.EBM (update of 16-bit PRINTSCR.EBM - using OLE Automation)
'  WRITTEN BY: Attachmate Automation Support
'DATE WRITTEN: 2/29/96
' DESCRIPTION: This macro prints the host screen for the Active Session Object.
'
'              Notes: You must set the FileName$ variable equal to the name of
'                     your Windows printer prior to running this macro.
'
'                     This macro will only run with EXTRA! 6.0 or greater.
'
'              © Copyright 1989-1996.  Attachmate Corporation.  All Rights Reserved
'
'              This macro is provided as an example only and may need
'              to be modified to work in your environment.  It is
'              provided as is, without warranty or support from
'              Attachmate Corporation.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Sub Main

' Dimension macro variables and objects
    Dim rc%, row%, MaxColumns%, MaxRows%, filenum%
    Dim Screenbuf$, linebuf$, FileName$
    Dim System As Object
    Dim Session as Object
    
' Get the main system object
    Set System = CreateObject("EXTRA.System")
    If (System is Nothing) Then
        Msgbox "Could not create the EXTRA System object.  Aborting macro playback."
    Stop
    End If

' Get the necessary Session Object
    Set Session = System.ActiveSession
    If (Session is Nothing) Then
    Msgbox "Could not create the Session object.  Aborting macro playback."
    Stop
    End If

' Determine the size of the Presentation Space
    MaxRows% = Session.Screen.Rows()
    MaxColumns% = Session.Screen.Cols()
 
' Initialize variables to hold screen information
    Screenbuf$ = ""
    linebuf$ = Space$ (MaxColumns%)

' Copy the Presentation space
    For row% = 1 to MaxRows%
        ' Get a row of data from the host screen
        linebuf$ = Session.Screen.Area(row%, 1, row%, MaxColumns%, , xBlock)

        ' Store the line read into screenbuf$
        screenbuf$ = screenbuf$ + linebuf$ + Chr$ (13) + Chr$ (10)
    Next
    
' Get the next available file number
   filenum% = FreeFile    

' Open the printer. To print to a file, set FileName$ to a file name.
' In this example, "\\TES\L4S_HP" is a network printer name.
' Change this to your printer name.

'    FileName$ = "\\TES\L4S_HP"
'    Open FileName$ For Output as filenum%


'To print to a file, set FileName$ to a file name.
    FileName$ = "C:\HOSTSCREEN.txt"  'CHOOSE ANY PATH AND FILE NAME
    Open FileName$ For Output as filenum%
    
' Print the screen with a form feed
    Print # filenum%, screenbuf$; Chr$ (12)

'Close printer
    Close filenum%

End Sub
 

RE: macro to print host file to text file

(OP)
Hi link99: AttachMate solutions Linkssbc,

Thanks a lot! This is what I am looking for. However, only the first screen ( and only up to column 72) was captured; which part of the code should I change?

Best Regards,
Jonathan

RE: macro to print host file to text file

play with this!

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  MACRO NAME: CAPTUR32.EBM (update of 16-bit CAPTURE.EBM - using OLE Automation)
'  WRITTEN BY: Attachmate Automation Support
'DATE WRITTEN: 2/29/96
' DESCRIPTION: This macro grabs an entire screen of data from the host.  It
'              will append screens and let you edit them in Notepad as one
'              document.  It also demonstrates the use of Windows API calls,
'              use of Registry API functions for storing macro settings, and
'              how global variables can be shared across macro instances.
'
'              © Copyright 1989-1996.  Attachmate Corporation.  All Rights Reserved
'
'              Notes:  There is a 64k limit to the screen capture buffer.
'                      This macro will only run with EXTRA! 6.0 or greater.
'
'                      Capture32 is easier to use if it is run outside the
'                      Display session.  Try running it from the command
'                      line or an icon by using the following command line
'                      string to start the macro:
'
'                           ebrun.exe captur32.ebm
'
'                      This will allow Capture32 to run without requiring that
'                      you exit the macro in order to go to the next screen in
'                      the Display session.
'
'                      Capture32 will prompt you for a printer name the first
'                      time that it is run.  It stores this name in the Registry
'                      using the following key:
'
'                      HKEY_CURRENT_USER\Software\Attachmate\Sample Macros\Captur32.ebm\Printer
'                     
'                      In order to change the printer name after it has been
'                      set initially, you must change the value of the
'                      PROMPT_NEW_PRINTER constant from 0 to -1 (see the
'                      CONSTANTS section of the macro).  This will cause
'                      Capture32 to prompt you for the printer name each time
'                      the macro is run.  After changing the printer name, you
'                      can set PROMPT_NEW_PRINTER back to 0, to turn off the
'                      prompt.
'
'              This macro is provided as an example only and may need
'              to be modified to work in your environment.  It is
'              provided as is, without warranty or support from
'              Attachmate Corporation.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

'CONSTANTS
' These constants are depedant upon the position of
' the corresponding option in the main menu:
Const MENU_OPTION_EXIT       = -1
Const MENU_OPTION_CAPTURE    =  0
Const MENU_OPTION_CLEAR      =  1
Const MENU_OPTION_SAVEAS     =  2
Const MENU_OPTION_EDIT       =  3
Const MENU_OPTION_COPY       =  4
Const MENU_OPTION_PRINT      =  5
'**Set the following value to -1 if you want to be
'prompted for printer name each time you run the macro,
'or to simply change the current printer name.**
Const PROMPT_NEW_PRINTER     =  0

' These constants are depedant upon the position of
' the corresponding button in the main menu:
Const MENU_BUTTON_OK         =  0
Const MENU_BUTTON_EXIT       =  1

' the following Global Constants are used by the CopyToClipboard() function
Global Const CF_TEXT = 1
Global Const GMEM_MOVEABLE = &H2
Global Const GMEM_ZEROINIT = &H40
Global Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)

' the following Global Constants are used by the Registry APIs in the GetPrinterName subroutine
Global Const REG_SZ As Long = 1
Global Const REG_DWORD As Long = 4
Global Const HKEY_CURRENT_USER = &H80000001
Global Const ERROR_NONE = 0
Global Const ERROR_BADKEY = 2
Global Const KEY_ALL_ACCESS = &H3F
Global Const REG_OPTION_NON_VOLATILE = 0

' Global Variables
' variant data type allows us to store ~64k in the buffer rather than 32k in a string.
Global CapBuffer As Variant
Global CapBuffSize As Long

' Internal Subs/Functions
Declare Sub      CopyToClipboard(Buffer As Variant)
Declare Sub      InsertCRLF (Buffer As String, Columns As Integer, BufferSize As Integer)
Declare Function GetCapFile (Session as Object) as String
Declare Function GetMenuSelection () As Integer
Declare Function GetPrinterName() As String
Declare Function GetPS (Session as Object) as String
Declare Function GetUserFile (Session as Object) as String
Declare Function QueryValueEx(hKey As Long, ValueName As String, vValue As Variant) As Long
Declare Sub      ReadBuffer (Buffer As Variant, File As String)
Declare Sub      WriteBuffer (Buffer As Variant, File As String)
Declare Sub      WaitForWindowToGoAway (WindowTitle As String)
Declare Function StripFileName (FileName As String) As String

' External Functions  - Windows API functions
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal Class As String, ByVal lpTitle As String) As Long

' the following Windows API functions are used by the CopyToClipboard() function
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function GetActiveWindow Lib "user32" () As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long

' the following Registry API functions are used by the GetPrinterName subroutine
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long


' Main Subroutine.  Gets user menu input and peforms actions
' associated with the selection.
Sub Main
    
    Dim rc As Integer
    Dim lRet As Long
    Dim CapFileCreated as Integer
    Dim BaseName As String
    Dim OutPutFile As String
    Dim CapFile As String
    Dim PrintFile As String
    Dim System As Object
    Dim Session as Object
    
    ' Get the main system object
    Set System = CreateObject("EXTRA.System")
    If (System is Nothing) Then
        Msgbox "Could not create the EXTRA System object.  Aborting macro playback.", 48, "Capture32"
    Stop
    End If

    ' Get the necessary Session Object
    Set Session = System.ActiveSession
    If (Session is Nothing) Then
    Msgbox "Could not create the Session object.  Aborting macro playback.", 48, "Capture32"
    Stop
    End If

    rc% = GetMenuSelection()
    While rc% <> MENU_OPTION_EXIT
        Select Case rc%
            Case MENU_OPTION_CAPTURE:
                If CapBuffSize& < 60000 Then
                    CapBuffer = CapBuffer + GetPS (Session)
                Else
                    MsgBox "The Capture Buffer is Full!", 48, "Capture32"
                End If

            Case MENU_OPTION_CLEAR:
                CapBuffer = ""
                CapBuffSize& = 0
                
            Case MENU_OPTION_SAVEAS:
                OutputFile$ = GetUserFile (Session)
                If OutputFile$ <> "" Then WriteBuffer CapBuffer, OutputFile$

            Case MENU_OPTION_EDIT:
                CapFile$ = GetCapFile (Session)
                If CapFile$ <> "" Then
                    WriteBuffer CapBuffer, CapFile$
'                    rc% = Shell ("notepad.exe " + CapFile$)
                    lRet& = Shell ("notepad.exe " + CapFile$)
                    BaseName$ = StripFileName (CapFile$)
                    WaitForWindowToGoAway "Notepad - " + UCase$ (BaseName$)
                    ReadBuffer CapBuffer, CapFile$
                    CapFileCreated% = -1
                Else
                    MsgBox "Could Not Save Buffer", 48, "Capture32"
                End If
            
            Case MENU_OPTION_COPY:
                If CapBuffer <> "" Then
                    CopyToClipboard CapBuffer
                Else
                    MsgBox "The Capture Buffer is Empty!", 48, "Capture32"
                End If
                
            Case MENU_OPTION_PRINT:
                If CapBuffer <> "" Then
                    PrintFile$ = GetPrinterName()
                    If PrintFile$ = "" Then
                        MsgBox "The printer name is blank.  Unable to initialize printer.", 48, "Capture32"
                    Else
                        WriteBuffer CapBuffer, PrintFile$    
                    End If
                Else
                    MsgBox "The Capture Buffer is Empty!", 48, "Capture32"
                End If

            Case Else
                MsgBox "Unknown Selection", 48, "Capture32"

        End Select
        rc% = GetMenuSelection ()
    Wend
   
    ' Cleanup - If capture file exists, delete it
    If CapFileCreated% Then
        Kill CapFile$
    End If
  
End Sub

' The routine copies the capture buffer to the Windows Clipboard
Sub CopyToClipboard (Buffer)

    Dim StrHandle As Long                           
    Dim StrPtr As Long                              
    Dim rc as Long                                  
    Dim AppHandle As Long                 
    Dim CopyBuffer(2) As String
    
    ' Allocate Memory and return a Handle
    StrHandle& = GlobalAlloc(GHND, CapBuffSize& + 1)
     
    ' Get the pointer for the alocated memory
    StrPtr& = GlobalLock(StrHandle&)
                     
    ' Copy the capture buffer from variant to string array, then
    ' copy the contents of CopyBuffer Array to the global memory location.    
    If CapBuffSize& > 32767 Then
        CopyBuffer(1) = Left(Buffer, 32767)
        CopyBuffer(2) = Right(Buffer, CapBuffSize& - 32767)
        rc& = lstrcpy(StrPtr&, CopyBuffer(1))
        rc& = lstrcat(StrPtr&, CopyBuffer(2))
    Else
        CopyBuffer(1) = Buffer
        rc& = lstrcpy(StrPtr&, CopyBuffer(1))
    End If

    ' Get Handle of active window             
    AppHandle& = GetActiveWindow()
    
    ' Open Clipboard and associate active window     
    rc& = OpenClipboard(AppHandle&)
    
    ' Empty the clipboard                  
    rc& = EmptyClipboard()
    
    ' Using the Handle, copy the string to clipboard                          
    rc& = SetClipboarddata(CF_TEXT, StrHandle&)
    
    'Close the Clipboard - allow other apps to use it      
    rc& = CloseClipboard()
                               
End Sub


' This routine draws a dialog box which provides the user
' with several options.  The result is returned to the calling
' Sub or Function.
Function GetMenuSelection () As Integer

    Const DIALOG_WIDTH  = 158
    Const DIALOG_HEIGHT = 127

    Dim rc%

    'Define the main Capture menu here
    Begin Dialog CaptureMenu 26, 4, DIALOG_WIDTH, DIALOG_HEIGHT, "Capture32"
       ButtonGroup .Buttons
       GroupBox  10, 10, 85, 105, "Select an Option"
       OptionGroup .Selection
          OptionButton  20, 24, 70, 12, "Capture Screen"
          OptionButton  20, 39, 70, 12, "Clear Buffer"
          OptionButton  20, 54, 70, 12, "Save Buffer As..."
          OptionButton  20, 69, 70, 12, "Edit Buffer..."
          OptionButton  20, 84, 70, 12, "Copy To Clipboard"
          OptionButton  20, 99, 70, 12, "Print"
       PushButton  105, 16, 44, 14, "OK"
       PushButton  105, 37, 44, 14, "Exit"
    End Dialog
    Dim Menu as CaptureMenu

    Dialog Menu
    If Menu.Buttons = MENU_BUTTON_EXIT Then
        rc% = MENU_OPTION_EXIT
    Else
        rc% = Menu.Selection
    End If
    GetMenuSelection = rc%

End Function


' This function copies the entire host screen and passes the buffer
' back to the calling Sub or Function.
Function GetPS(Session As Object) as String

    Dim BufferSize As Integer
    Dim rc As Integer
    Dim Columns As Integer
    Dim Rows As Integer
    Dim Buffer As String
    
    ' Determine the size of the Presentation Space
    Rows% = Session.Screen.Rows()
    Columns% = Session.Screen.Cols()
    BufferSize% = Rows% * Columns%
    Buffer$ = Space$ (BufferSize%)

    ' Copy the Presentation Space
    Buffer$ = Session.Screen.GetString(1, 1, BufferSize%)

    If Buffer$ <> "" Then
        Call InsertCRLF (Buffer$, Columns%, BufferSize%)
        ' increment globabl buffer size variable, including all CRLFs
        CapBuffSize& = CapBuffSize& + (BufferSize% + (2 * Rows%))
        GetPS = Buffer$
         
    Else
        GetPS = ""
    End If

End Function


' This Sub inserts a carriage-return and linefeed at the end
' of each column in the buffer passed to it.
Sub InsertCRLF (Buffer$, Columns%, BufferSize%)

    Dim CurPos As Integer
    Dim NewBuffer As String
    Dim CRLF As String

    CRLF$ = Chr$(13) + Chr$(10)
    CurPos% = 1
    NewBuffer$ = ""
    While CurPos% < BufferSize%
        NewBuffer$ = NewBuffer$ + Mid$ (Buffer$, CurPos%, Columns%) + CRLF$
        CurPos% = CurPos% + Columns%
    Wend

    Buffer$ = NewBuffer$

End Sub


' This Function returns the fully qualified name of the
' temporary file used to store the CapBuffer during editing.
Function GetCapFile (Session As Object) as String
    
    Dim EDPName As String

    EDPName$ = Space$ (256)

    EDPName$ = Session.FullName
    EDPName$ = Left$(EDPName$, Len(EDPName$) - 3)
    EDPName$ = EDPName$ + "BUF"

    GetCapFile = EDPName$

End Function


' This Sub writes the given buffer to the given file.
Sub WriteBuffer (Buffer, OutFile$)

    Dim OutHandle As Integer
    
    On Error Goto WriteFileError

    OutHandle% = FreeFile
    Open OutFile$ For Output as OutHandle%
    Print #OutHandle%, Buffer

    Close OutHandle%

    Exit Sub

WriteFileError:
    MsgBox "Error " + Error$ + "(" + LTrim$(Str$(Err)) + ")" + " during WriteBuffer"
    If OutHandle% > 0 Then Close OutHandle%
    Resume EndWriteBuffer

EndWriteBuffer:

End Sub


' This Sub reads the contents of the specified file and stores
' those contents in the given buffer.
Sub ReadBuffer (Buffer, InFile$)

    Dim InHandle As Integer
    Dim LineBuffer As String
    Dim CRLF As String

    CRLF$ = Chr$(13) + Chr$(10)
    Buffer = ""

    On Error Goto ReadFileError
    InHandle% = FreeFile
    Open InFile$ For Input as InHandle%

    While Not EOF (InHandle%)
        Line Input #InHandle%, LineBuffer$
        Buffer = Buffer + LineBuffer$ + CRLF$
    Wend

    Close InHandle%
    Exit Sub

ReadFileError:
    MsgBox "Error " + Error$ + "(" + LTrim$(Str$(Err)) + ")" + " during ReadBuffer"
    If InHandle% > 0 Then Close InHandle%
    Resume EndReadBuffer

EndReadBuffer:

End Sub


' This Function obtains a file name from the user via
' a dialog box.  It returns the specified name to the user.
Function GetUserFile (Session as Object) as String

    Dim ExtraDir As String
    Dim EDPName As String

    Begin Dialog UserFileBox 265, 65
    Caption "Save File As..."

    Text 8, 26, 50, 10, "Capture File:"
    TextBox 54, 24, 150, 12, .FileName
    
    OKButton 210, 17, 35, 14
    CancelButton 210, 34, 35, 14
    End Dialog
    
    Dim UFB as UserFileBox

    EDPName$ = Space$ (256)
    
    EDPName$ = Session.FullName
    EDPName$ = Left$(EDPName$, Len(EDPName$) - 3)
    UFB.FileName = ExtraDir$ + EDPName$ + "TXT"
    On Error Goto Cancel
    Dialog UFB
    GetUserFile = UFB.FileName
    Exit Function

Cancel:
    GetUserFile = ""
    Resume EndFunc

EndFunc:

End Function


' This Sub loops until the given window title cannot be found.
Sub WaitForWindowToGoAway (WindowTitle$)

    Dim hWnd As Long

    WindowTitle$ = WindowTitle$ + Chr$(0)
    hWnd = FindWindow ("", WindowTitle$)
    Do
        hWnd = FindWindow ("", WindowTitle$)       
    Loop While hWnd <> 0

End Sub


' This function Takes a fully qualified file name and
' returns just the name portion of it.  Example:
' If FileName$ = "C:\TEST.TXT" upon calling this
' function the return value would be "TEST.TXT".
Function StripFileName (FileName$) As String

    Dim i As Integer
    Dim j As Integer
    Dim NewFileName As String

    NewFileName$ = FileName$
    j = 0
    i = InStr (NewFileName$, ":")
    If i = 0 Then i = InStr (NewFileName$, "\")
    While i <> 0
        j = i
        i = InStr (j + 1, NewFileName$, "\")
    Wend
    If j <> 0 Then NewFileName$ = Mid$ (NewFileName$, j + 1, Len (NewFileName$) - j)

    StripFileName = NewFileName$
End Function


' This subroutine checks to see if the printer port name is
' already set in the Registry.  If not, it prompts the user
' for a name, and then sets it in the Registry for next time.
Function GetPrinterName () As String
    Dim RetVal As Long
    Dim hKey As Long
    Dim PrntName As String
    Dim vValue As Variant
    
    RetVal& = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Attachmate\Sample Macros\Captur32.ebm\Printer", 0&, KEY_ALL_ACCESS, hKey&)
    If PROMPT_NEW_PRINTER Then
        RetVal& = ERROR_BADKEY
    End If
    Select Case RetVal&
        ' Printer port previously set, no need to prompt user
        Case ERROR_NONE
            RetVal& = QueryValueEx(hKey&, "Port", PrntName$)
        ' The printer port is not set, prompt user for printer name and set it in the Registry for next time
        Case ERROR_BADKEY
            PrntName$ = InputBox$("Enter the name of the local or network printer you wish to print to.  For example:  ""LPT1"" or ""\\SERVER1\PRINTER2"".", "PRTSCR32", "")
            If PrntName$ = "" Then
                RegCloseKey(hKey&)
                Exit Function
            End If
            RetVal& = RegCreateKeyEx(HKEY_CURRENT_USER, "Software\Attachmate\Sample Macros\Captur32.ebm\Printer", 0&, "", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hKey&, RetVal&)   
            RetVal& = RegSetValueExString(hKey&, "Port", 0&, REG_SZ, PrntName$, Len(PrntName$))
        ' Unknown error reading Registry; abort
        Case Else
            MsgBox "Unknown Error.  Unable to initialize printer.", 48, "Capture32"
            RegCloseKey(hKey&)
            Exit Function
    End Select
    RegCloseKey(hKey&)
    
    GetPrinterName = PrntName$
End Function


' This function uses Registry API calls to query the name of
' the currently configured printer for Capture32.
Function QueryValueEx(hKey As Long, ValueName As String, vValue As Variant) As Long
    Dim rc As Long
    Dim lType As Long
    Dim lValue As Long
    Dim sValue As String
    Dim ValSize As Long
 
    ' Determine the size and lType of data to be read
    rc& = RegQueryValueExNULL(hKey&, ValueName$, 0&, lType&, 0&, Valsize&)
    If rc& <> ERROR_NONE Then
        MsgBox "Unable to initialize printer.", 48, "Capture32"
        Stop
    End If
 
    Select Case lType&
        ' For strings
        Case REG_SZ:
            sValue = String(ValSize&, 0)
            rc& = RegQueryValueExString(hKey&, ValueName$, 0&, lType&, sValue$, ValSize&)
            If rc& = ERROR_NONE Then
                vValue = Left$(sValue$, ValSize&)
            Else
                vValue = ""
            End If
        ' For DWORDS
        Case REG_DWORD:
            rc& = RegQueryValueExLong(hKey&, ValueName$, 0&, lType&, lValue&, ValSize&)
            If rc& = ERROR_NONE Then
                vValue = lValue&
            End If
        Case Else
            'all other data Types not supported
            rc& = -1
    End Select
 
    QueryValueEx = rc&
End Function
 

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close