macro to print host file to text file 1

[jonats]

Hi,

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

Thanks

 

[link99sbc]

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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

 

[jonats]

Hi link99sbc,

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

 

[link99sbc]

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