システムリソース不足によるエラーを解消するには？

なつき 2006-02-23 05:46:32 No: 94349

いつもお世話になっています。

随分前に掲載されていたEject可能なデバイスをEjectするという話を参考にCDROMドライブ等に対し、SCSIコマンドでアクセスできるようなプログラムを作成中のところ、問題が発生し、どうやって解決したらよいのか、困っています。

下記のような構造体を作成し、Readコマンド等を送るプログラムを作ってみたのですが、PCの差によって、「システムリソースが不足しているため・・・完了できません」というエラーが出てきてしまいます。正常に動作するPCもあるので、どうしたらよいのか・・・。

ディスクの情報を読む処理をしたいため、Bufferサイズを大きくせざるを得なくて、構造体サイズが大きくなってしまいます。これをpublicで宣言していることが駄目なようなのですが、その先が進みません。宜しくご教示ください。

環境はVB6で、WindowsXPです。

Public Type SCSI_PASS_THROUGH
  length                As Integer
  ScsiStatus            As Byte
  PathId                As Byte
  TargetId              As Byte
  Lun                   As Byte
  CdbLength             As Byte
  SenseInfoLength       As Byte
  DataIn                As Byte
  DataTransferLength    As Long
  TimeOutValue          As Long
  DataBufferOffset      As Long
  SenseInfoOffset       As Long
  Cdb(0 To 15)          As Byte
End Type

Public Type SCSI_PASS_THROUGH_WITH_BUFFERS
  spt                   As SCSI_PASS_THROUGH
  Filler                As Long     '  4Byte境界
  SenseBuf(0 To 31)     As Byte
  DataBuf(0 To 32767)   As Byte     '  0x8000にする
End Type

Public buf As SCSI_PASS_THROUGH_WITH_BUFFERS

魔界の仮面弁士 2006-02-23 07:39:07 No: 94350

> 随分前に掲載されていたEject可能なデバイスをEjectするという話を
参考にした URL 等があるならば、掲載してもらえると助かります。

> Public Type SCSI_PASS_THROUGH
「Lenで測ったサイズ」と「LenBで測ったサイズ」が異なるタイプの
構造定義になっているようですね。

API 側の "#pragma pack" の指定如何では、構造体のアライメントを調整する
必要があるかと思いますが、その点は考慮されていますでしょうか。
(すみません。手元に DDK が無いため、当方では確認できません。)

> 構造体サイズが大きくなってしまいます。
なにも、構造体に拘る必要は無いような気がします。連続したメモリ領域を
確保しておき、そこから RtlMoveMemory で切り出すようにしてみては如何でしょう。

なつき 2006-02-23 19:19:26 No: 94351

魔界の仮面弁士様、早々の回答ありがとうございます。

・複数台あるCDトレイの開閉
http://madia.world.coocan.jp/vb/vb_bbs2/200408_04080131.html

↑これを参考に最初のコーディングを開始しました。

http://www.vbarchiv.net/workshop/workshop78s4.html
http://www.vbarchiv.net/archiv/tipp_1251.html

などを参考にコマンド送信のところまでこぎつけました。

>構造体のアライメントを調整する必要がある
に関しましては、正直なところ、理解不足であり、わかりません。

>連続したメモリ領域を確保しておき、そこからRtlMoveMemory で切り出すようにしてみては如何でしょう
これはどのようにしたらよいのでしょうか？GlobalAllocなどいろいろ調べているのですが、使い方がよくわかりませんでした。もうしわけありませんが、もう少し詳細な使用方法をご教示願えないでしょうか。

現在作成しているもの(メモリが十分な？PCでは動作します)は下記です。

*標準モジュール

'引数のsptwbはpublic定義したbufを直接やりとりしています。
Public Function SendCmdSpti(Cdb0 As Byte, Cdb1 As Byte, Cdb2 As Byte, Cdb3 As Byte, Cdb4 As Byte, Cdb5 As Byte, _
                            Cdb6 As Byte, Cdb7 As Byte, Cdb8 As Byte, Cdb9 As Byte, Cdb10 As Byte, Cdb11 As Byte, _
                            CdbLen As Long, ByRef sptwb As SCSI_PASS_THROUGH_WITH_BUFFERS, Size As Long, Dir As Byte) As Long
    Dim length As Long
    Dim returned As Long
    Dim status As Long
    Dim SptDir As Byte
    Dim OL As t_OVERLAPPED
    Dim ErrorCode As Long
    ErrorCode = ASCASCQ_NORMAL

    SptDir = SCSI_IOCTL_DATA_UNSPECIFIED
    If DRVCTL_DIR_RD = Dir Then
        SptDir = SCSI_IOCTL_DATA_IN
    ElseIf DRVCTL_DIR_WR = Dir Then
        SptDir = SCSI_IOCTL_DATA_OUT
    End If

    sptwb.spt.length = LenB(sptwb.spt)
    sptwb.spt.PathId = 0
    sptwb.spt.TargetId = 0
    sptwb.spt.Lun = 0
    sptwb.spt.CdbLength = CdbLen
    sptwb.spt.SenseInfoLength = SENSE_LEN
    sptwb.spt.DataIn = SptDir
    sptwb.spt.DataTransferLength = Size
    sptwb.spt.TimeOutValue = 1800  '最大30分まで
    sptwb.spt.SenseInfoOffset = LenB(sptwb.spt) + Len(sptwb.Filler)
    sptwb.spt.DataBufferOffset = LenB(sptwb.spt) + Len(sptwb.Filler) + UBound(sptwb.SenseBuf) + 1
    sptwb.spt.Cdb(0) = Cdb0
    sptwb.spt.Cdb(1) = Cdb1
    sptwb.spt.Cdb(2) = Cdb2
    sptwb.spt.Cdb(3) = Cdb3
    sptwb.spt.Cdb(4) = Cdb4
    sptwb.spt.Cdb(5) = Cdb5
    sptwb.spt.Cdb(6) = Cdb6
    sptwb.spt.Cdb(7) = Cdb7
    sptwb.spt.Cdb(8) = Cdb8
    sptwb.spt.Cdb(9) = Cdb9
    sptwb.spt.Cdb(10) = Cdb10
    sptwb.spt.Cdb(11) = Cdb11

    length = sptwb.spt.DataBufferOffset + sptwb.spt.DataTransferLength

    If hDevice = INVALID_HANDLE_VALUE Then Exit Function
    status = DeviceIoControl(hDevice, _
                             IOCTL_SCSI_PASS_THROUGH_DIRECT, _
                             sptwb, _
                             length, _
                             sptwb, _
                             length, _
                             returned, _
                             OL)

    If status = False Then
if 1 then   ' エラーメッセージを出力するときは1にする。
        Dim MsgId As Long
        Dim ret As Long
        Dim sVal As String
        Dim sCodes As String
        Dim sBuff As String

        MsgId = GetLastError()
        sBuff = Space(MAX_PATH)
        ret = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or _
                            FORMAT_MESSAGE_IGNORE_INSERTS Or _
                            FORMAT_MESSAGE_MAX_WIDTH_MASK, _
                            ByVal 0&, MsgId, 0&, sBuff, MAX_PATH, ByVal 0&)
        sBuff = Left$(sBuff, ret)

        MsgBox "ErrorCode=" & MsgId & "::" & sBuff, vbExclamation
End If
        ' DeviceIoControl() NG
        ErrorCode = ASCASCQ_API_ERROR
    Else
        ' DeviceIoControl() OK
        If sptwb.spt.ScsiStatus <> 0 Then
            ' SCSI エラー
            ErrorCode = sptwb.SenseBuf(ASC_BYTE_NO) * &H100 + sptwb.SenseBuf(ASCQ_BYTE_NO)
        End If
    End If
'    Debug.Print "SPTI-ErrorCode = ", Hex(ErrorCode)
    SendCmdSpti = ErrorCode

End Function

*Form

'ドライブ情報を取得する

ZeroMemory buf, LenB(buf) 'bufをクリアする
'INQUIRYコマンドでドライブ情報を取得する
ErrorCode = SendCmdSpti(&H12, &H0, &H0, &H0, &H24, &H0, buf, &H24, DRVCTL_DIR_RD)

sData = StrConv(buf.DataBuf, vbUnicode)
DrvList(DrvCnt).VendorID = Mid(sData, 9, 8)         'VendorID取り込み
DrvList(DrvCnt).ProductID = Mid(sData, 17, 16)      'DriveName取り込み
DrvList(DrvCnt).ProductRev = Mid(sData, 33, 4)      'Rev取り込み
DrvList(DrvCnt).VendorStr = Mid(sData, 37, 20)      '
DrvList(DrvCnt).Letters = Letter

なつき 2006-02-23 19:25:32 No: 94352

一部、訂正です。

>ErrorCode = SendCmdSpti(&H12, &H0, &H0, &H0, &H24, &H0, buf, &H24, DRVCTL_DIR_RD)

ErrorCode = SendCmdSpti(&H12, &H0, &H0, &H0, &H24, &H0, &H0, &H0, &H0, &H0, &H0, &H0, CDB6GENERIC_LENGTH, buf, &H24, DRVCTL_DIR_RD)