Solved

Tape Drive

Posted on 2002-04-04
3
399 Views
Last Modified: 2008-02-01
Greetings,

Does anyone know if it possible to read/write a Tape Drive in VB6 on a Win9x box, please.

Thank you.
0
Comment
Question by:tvtech
  • 2
3 Comments
 
LVL 43

Accepted Solution

by:
TimCottee earned 200 total points
ID: 6918125
This is an example for NT, I don't know if it is supported in 9x

'in a module
Public Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Public Declare Function SetTapeParameters Lib "kernel32" (ByVal hDevice As Long, ByVal dwOperation As Long, lpTapeInformation As Any) As Long
Public Declare Function PrepareTape Lib "kernel32" (ByVal hDevice As Long, ByVal dwOperation As Long, ByVal bimmediate As Long) As Long
Public Declare Function SetTapePosition Lib "kernel32" (ByVal hDevice As Long, ByVal dwPositionMethod As Long, ByVal dwPartition As Long, ByVal dwOffsetLow As Long, ByVal dwOffsetHigh As Long, ByVal bimmediate As Long) As Long
Public Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
Public Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function GetLastError Lib "kernel32" () As Long
Public Declare Function GetTapeParameters Lib "kernel32" (ByVal hDevice As Long, ByVal dwOperation As Long, lpdwSize As Long, lpTapeInformation As Any) As Long
Public Declare Function GetTapePosition Lib "kernel32" (ByVal hDevice As Long, ByVal dwPositionType As Long, lpdwPartition As Long, lpdwOffsetLow As Long, lpdwOffsetHigh As Long) As Long
Public Declare Function GetTapeStatus Lib "kernel32" (ByVal hDevice As Long) As Long
Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Const GET_TAPE_DRIVE_INFORMATION = 1
Public Const GET_TAPE_MEDIA_INFORMATION = 0
Public Const SET_TAPE_DRIVE_INFORMATION = 1
Public Const SET_TAPE_MEDIA_INFORMATION = 0
Public Type TAPE_GET_MEDIA_PARAMETERS
    Capacity As Long
    Remaining As Long
    BlockSize As Long
    PartitionCount As Long
    WriteProtected As Boolean
End Type
Public Type TAPE_GET_DRIVE_PARAMETERS
    ECC As Boolean
    Compression As Boolean
    DataPadding As Boolean
    ReportSetmarks As Boolean
    DefaultBlockSize As Long
    MaximumBlockSize As Long
    MinimumBlockSize As Long
    MaximumPartitionCount As Long
    FeaturesLow As Long
    FeaturesHigh As Long
    EOTWarningZoneSize As Long
End Type
Public Type OVERLAPPED
        Internal As Long
        InternalHigh As Long
        offset As Long
        OffsetHigh As Long
        hEvent As Long
End Type
Public Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type
' following taken from Winnt.h
'
' IOCTL_TAPE_ERASE definitions
'
Public Const TAPE_ERASE_SHORT = 0
Public Const TAPE_ERASE_LONG = 1
Public Type TAPE_ERASE
    Type As Long
    Immediate As Boolean
' TAPE_ERASE, *PTAPE_ERASE;
End Type
'
' IOCTL_TAPE_PREPARE definitions
'
Public Const TAPE_LOAD = 0
Public Const TAPE_UNLOAD = 1
Public Const TAPE_TENSION = 2
Public Const TAPE_LOCK = 3
Public Const TAPE_UNLOCK = 4
Public Const TAPE_FORMAT = 5
Public Type TAPE_PREPARE
    Operation As Long
    Immediate As Boolean
' TAPE_PREPARE, *PTAPE_PREPARE;
End Type
'
' IOCTL_TAPE_WRITE_MARKS definitions
'
Public Const TAPE_SETMARKS = 0
Public Const TAPE_FILEMARKS = 1
Public Const TAPE_SHORT_FILEMARKS = 2
Public Const TAPE_LONG_FILEMARKS = 3
Public Type TAPE_WRITE_MARKS
    Type As Long
    Count As Long
    Immediate As Boolean
' TAPE_WRITE_MARKS, *PTAPE_WRITE_MARKS;
End Type
'
' IOCTL_TAPE_GET_POSITION definitions
'

Public Const TAPE_ABSOLUTE_POSITION = 0
Public Const TAPE_LOGICAL_POSITION = 1
Public Const TAPE_PSEUDO_LOGICAL_POSITION = 2
Public Type TAPE_GET_POSITION
    Type As Long
    Partition As Long
    offset As Long
' TAPE_GET_POSITION, *PTAPE_GET_POSITION;
End Type
'
' IOCTL_TAPE_SET_POSITION definitions
'
Public Const TAPE_REWIND = 0&
Public Const TAPE_ABSOLUTE_BLOCK = 1&
Public Const TAPE_LOGICAL_BLOCK = 2&
Public Const TAPE_PSEUDO_LOGICAL_BLOCK = 3&
Public Const TAPE_SPACE_END_OF_DATA = 4&
Public Const TAPE_SPACE_RELATIVE_BLOCKS = 5&
Public Const TAPE_SPACE_FILEMARKS = 6&
Public Const TAPE_SPACE_SEQUENTIAL_FMKS = 7&
Public Const TAPE_SPACE_SETMARKS = 8&
Public Const TAPE_SPACE_SEQUENTIAL_SMKS = 9&
Public Type TAPE_SET_POSITION
    Method As Long
    Partition As Long
    offset As Long
    Immediate As Boolean
' TAPE_SET_POSITION, *PTAPE_SET_POSITION;
End Type
'
' IOCTL_TAPE_GET_DRIVE_PARAMS definitions
'
'
' Definitions for FeaturesLow parameter
'
Public Const TAPE_DRIVE_FIXED = &H1
Public Const TAPE_DRIVE_SELECT = &H2
Public Const TAPE_DRIVE_INITIATOR = &H4
Public Const TAPE_DRIVE_ERASE_SHORT = &H10
Public Const TAPE_DRIVE_ERASE_LONG = &H20
Public Const TAPE_DRIVE_ERASE_BOP_ONLY = &H40
Public Const TAPE_DRIVE_ERASE_IMMEDIATE = &H80
Public Const TAPE_DRIVE_TAPE_CAPACITY = &H100
Public Const TAPE_DRIVE_TAPE_REMAINING = &H200
Public Const TAPE_DRIVE_FIXED_BLOCK = &H400
Public Const TAPE_DRIVE_VARIABLE_BLOCK = &H800
Public Const TAPE_DRIVE_WRITE_PROTECT = &H1000
Public Const TAPE_DRIVE_EOT_WZ_SIZE = &H2000
Public Const TAPE_DRIVE_ECC = &H10000
Public Const TAPE_DRIVE_COMPRESSION = &H20000
Public Const TAPE_DRIVE_PADDING = &H40000
Public Const TAPE_DRIVE_REPORT_SMKS = &H80000
Public Const TAPE_DRIVE_GET_ABSOLUTE_BLK = &H100000
Public Const TAPE_DRIVE_GET_LOGICAL_BLK = &H200000
Public Const TAPE_DRIVE_SET_EOT_WZ_SIZE = &H400000
Public Const TAPE_DRIVE_EJECT_MEDIA = &H1000000
Public Const TAPE_DRIVE_CLEAN_REQUESTS = &H2000000
Public Const TAPE_DRIVE_SET_CMP_BOP_ONLY = &H4000000
Public Const TAPE_DRIVE_RESERVED_BIT = &H80000000     'don't use this bit!
'                                              'can't be a low features bit!
'                                              'reserved; high features only
'
' Definitions for FeaturesHigh parameter
'
Public Const TAPE_DRIVE_LOAD_UNLOAD = &H80000001
Public Const TAPE_DRIVE_TENSION = &H80000002
Public Const TAPE_DRIVE_LOCK_UNLOCK = &H80000004
Public Const TAPE_DRIVE_REWIND_IMMEDIATE = &H80000008
Public Const TAPE_DRIVE_SET_BLOCK_SIZE = &H80000010
Public Const TAPE_DRIVE_LOAD_UNLD_IMMED = &H80000020
Public Const TAPE_DRIVE_TENSION_IMMED = &H80000040
Public Const TAPE_DRIVE_LOCK_UNLK_IMMED = &H80000080
Public Const TAPE_DRIVE_SET_ECC = &H80000100
Public Const TAPE_DRIVE_SET_COMPRESSION = &H80000200
Public Const TAPE_DRIVE_SET_PADDING = &H80000400
Public Const TAPE_DRIVE_SET_REPORT_SMKS = &H80000800
Public Const TAPE_DRIVE_ABSOLUTE_BLK = &H80001000
Public Const TAPE_DRIVE_ABS_BLK_IMMED = &H80002000
Public Const TAPE_DRIVE_LOGICAL_BLK = &H80004000
Public Const TAPE_DRIVE_LOG_BLK_IMMED = &H80008000
Public Const TAPE_DRIVE_END_OF_DATA = &H80010000
Public Const TAPE_DRIVE_RELATIVE_BLKS = &H80020000
Public Const TAPE_DRIVE_FILEMARKS = &H80040000
Public Const TAPE_DRIVE_SEQUENTIAL_FMKS = &H80080000
Public Const TAPE_DRIVE_SETMARKS = &H80100000
Public Const TAPE_DRIVE_SEQUENTIAL_SMKS = &H80200000
Public Const TAPE_DRIVE_REVERSE_POSITION = &H80400000
Public Const TAPE_DRIVE_SPACE_IMMEDIATE = &H80800000
Public Const TAPE_DRIVE_WRITE_SETMARKS = &H81000000
Public Const TAPE_DRIVE_WRITE_FILEMARKS = &H82000000
Public Const TAPE_DRIVE_WRITE_SHORT_FMKS = &H84000000
Public Const TAPE_DRIVE_WRITE_LONG_FMKS = &H88000000
Public Const TAPE_DRIVE_WRITE_MARK_IMMED = &H90000000
Public Const TAPE_DRIVE_FORMAT = &HA0000000
Public Const TAPE_DRIVE_FORMAT_IMMEDIATE = &HC0000000
Public Const TAPE_DRIVE_HIGH_FEATURES = &H80000000    'mask for high features flag
'
' IOCTL_TAPE_SET_DRIVE_PARAMETERS definitions
'
Public Type TAPE_SET_DRIVE_PARAMETERS
    ECC As Boolean
    Compression As Boolean
    DataPadding As Boolean
    ReportSetmarks As Boolean
    EOTWarningZoneSize As Boolean
' TAPE_SET_DRIVE_PARAMETERS, *PTAPE_SET_DRIVE_PARAMETERS;
End Type
'
' IOCTL_TAPE_SET_MEDIA_PARAMETERS definitions
'
Public Type TAPE_SET_MEDIA_PARAMETERS
    BlockSize As Long
' TAPE_SET_MEDIA_PARAMETERS, *PTAPE_SET_MEDIA_PARAMETERS;
End Type
'
' IOCTL_TAPE_CREATE_PARTITION definitions
'
Public Const TAPE_FIXED_PARTITIONS = 0&
Public Const TAPE_SELECT_PARTITIONS = 1&
Public Const TAPE_INITIATOR_PARTITIONS = 2&
Public Type TAPE_CREATE_PARTITION
    Method As Boolean
    Count As Boolean
    Size As Boolean
' TAPE_CREATE_PARTITION, *PTAPE_CREATE_PARTITION;
End Type
Public Function ReadNextTapeFile(destfile As String) As String
'KPD-Team 2000
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
'-> This sample was created by Ethan Larson
Dim indata(65536) As Byte
Dim num As Long
Dim tapehandle, diskhandle As Long
Dim secatt As SECURITY_ATTRIBUTES
Dim temp As Long
Dim nbr As Long
Dim nbw As Long
Dim param1 As Long, param2 As Long, param3 As Long
Dim tgdp As TAPE_GET_DRIVE_PARAMETERS
Dim tgmp As TAPE_GET_MEDIA_PARAMETERS
Dim lpdwSize As Long
Dim lpFSH As Long
Dim donereading As Boolean
Dim fileobject, filething, filestream
Dim wrotetofile As Boolean

ReadNextTapeFile = ""

secatt.bInheritHandle = 0&
secatt.lpSecurityDescriptor = 0&
secatt.nLength = 0&

tapehandle = CreateFile("\\.\Tape0", GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, secatt, OPEN_EXISTING, 0, 0&)
num = SetTapeParameters(tapehandle, SET_TAPE_MEDIA_INFORMATION, 0) ' variable block length!
num = GetTapeStatus(ByVal tapehandle)

diskhandle = CreateFile(destfile, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, secatt, CREATE_ALWAYS, 0, 0&)

donereading = False
wrotetofile = False
While Not donereading
    Erase indata
    num = ReadFile(tapehandle, indata(1), 65536, nbr, ByVal 0&)
    num = GetLastError
    If num <> 0 Then ' place for breakpoint
        j = j
    End If
    If num = 1104 Then ' no data found error
        StatusQuip ("End of data found.")
        ReadNextTapeFile = "End of data"
        donereading = True
    End If
    If Not donereading Then
        If nbr = 0 Then
            donereading = True
            If wrotetofile Then
                wrotetofile = False
                CloseHandle (diskhandle)
                ReadNextTapeFile = "No Error"
            Else
                StatusQuip ("No data written to file.")
                ReadNextTapeFile = "Error"
            End If
        Else
            wrotetofile = True
            num = WriteFile(diskhandle, indata(1), nbr, nbw, ByVal 0&)
            If num = 0 Then
                num = GetLastError
            End If
        End If
    End If
    DoEvents
Wend

CloseHandle (tapehandle)
CloseHandle (diskhandle)

If Not ReadNextTapeFile = "No Error" Then
    Set fileobject = CreateObject("Scripting.FileSystemObject")
    If fileobject.FileExists(destfile) Then
       Set filething = fileobject.GetFile(destfile)
        filething.Delete
    End If
End If

End Function
0
 

Author Comment

by:tvtech
ID: 6918166
Hi TimCottee,

 There seems to be a few bits missing ie:
    StatusQuip
    GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE

 Would you happen to have the complete code. I can't seem to find it on http://www.allapi.net/

Thank you.



0
 
LVL 43

Expert Comment

by:TimCottee
ID: 6918291
I guess that statusquip is a function wrapping the message box, something like:

Private Function StatusQuip(Content As String) As Boolean
  MsgBox Content
End Function

As for the constants:
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now