- 締切済み
【VB6】印刷ダイアログの表示を繰り返すと異常終了
開発言語：VB6 お世話になります。 DEVMODE構造体とDEVNAME構造体に、プリンタや用紙サイズ、印刷の向きなどを指定し、Win32APIのPrintDialogで印刷ダイアログを表示しています。 この処理を何回か呼び出すと、プログラムが異常終了します。 異常終了する場所は、PrintDialogを呼び出した直後だと思われます。 いろいろ調べたのですが、原因がわかりません。 長くなりますが、ソースコードの一部を添付させて頂きます。 ご覧頂き、おかしい点などございましたらご指摘いただけるとありがたいです。 よろしくお願いします。 以下ソースコード ----------------------------------------------------------------------------------- PrintDlg.lStructSize = Len(PrintDlg) PrintDlg.hwndOwner = phwnd PrintDlg.flags = plngPrintFlags strDeviceName = Printer.DeviceName strDriverName = Printer.DriverName sngPaperBin = Printer.PaperBin strPortNo = Printer.Port If mstrDriverName <> "" And _ mstrDeviceName <> "" And _ mstrPortNo <> "" Or _ msngDefaultSource <> 0 Then For Each objPrinter In Printers If objPrinter.DeviceName = mstrDeviceName Then strDeviceName = mstrDeviceName strDriverName = mstrDriverName sngPaperBin = msngDefaultSource strPortNo = mstrPortNo Exit For End If Next End If udtPrinterDefaults.DesiredAccess = PRINTER_ACCESS_USE If OpenPrinter(Trim(strDeviceName), hPrinter, udtPrinterDefaults) <> 0 Then bufSize = DocumentProperties(NULLPTR, hPrinter, Trim(strDeviceName), NULLPTR, NULLPTR, 0) If bufSize < 1 Then MsgBox "プリンタ情報の取得に失敗しました。", vbCritical GoTo Exit_Proc Else ReDim aDevMode(bufSize - 1) Call DocumentProperties(NULLPTR, hPrinter, Trim(strDeviceName), aDevMode(0), NULLPTR, DM_OUT_BUFFER) Call CopyMemory(DevMode, aDevMode(0), Len(DevMode)) End If Call ClosePrinter(hPrinter) Else MsgBox Err.LastDllError MsgBox "プリンタの取得に失敗しました。", vbCritical GoTo Exit_Proc End If DevMode.dmPaperSize = mintPaperSize DevMode.dmOrientation = mintPaperOrnt DevMode.dmDefaultSource = sngPaperBin PrintDlg.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(DevMode)) lpDevMode = GlobalLock(PrintDlg.hDevMode) If lpDevMode > 0 Then CopyMemory ByVal lpDevMode, DevMode, Len(DevMode) bReturn = GlobalUnlock(lpDevMode) End If With DevName .wDriverOffset = 8 .wDeviceOffset = .wDriverOffset + 1 + Len(strDriverName) .wOutputOffset = .wDeviceOffset + 1 + Len(strDeviceName) .wDefault = 0 .extra = strDriverName & Chr(0) & strDeviceName & Chr(0) & strPortNo & Chr(0) End With PrintDlg.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or _ GMEM_ZEROINIT, Len(DevName)) lpDevName = GlobalLock(PrintDlg.hDevNames) If lpDevName > 0 Then CopyMemory ByVal lpDevName, DevName, Len(DevName) bReturn = GlobalUnlock(lpDevName) End If If PrintDialog(PrintDlg) Then mhDC = PrintDlg.hdc lpDevName = GlobalLock(PrintDlg.hDevNames) CopyMemory DevName, ByVal lpDevName, Len(DevName) bReturn = GlobalUnlock(lpDevName) GlobalFree PrintDlg.hDevNames lpDevMode = GlobalLock(PrintDlg.hDevMode) CopyMemory DevMode, ByVal lpDevMode, Len(DevMode) bReturn = GlobalUnlock(PrintDlg.hDevMode) GlobalFree PrintDlg.hDevMode mstrDriverName = Mid(DevName.extra, DevName.wDriverOffset - 8 + 1) mstrDriverName = Left(mstrDriverName, InStr(mstrDriverName, Chr(0)) - 1) mstrDeviceName = Mid(DevName.extra, DevName.wDeviceOffset - 8 + 1) mstrDeviceName = Left(mstrDeviceName, InStr(mstrDeviceName, Chr(0)) - 1) mstrPortNo = Mid(DevName.extra, DevName.wOutputOffset - 8 + 1) mstrPortNo = Left(mstrPortNo, InStr(mstrPortNo, Chr(0)) - 1) msngDefaultSource = DevMode.dmDefaultSource mintPaperOrnt = DevMode.dmOrientation mintPaperSize = DevMode.dmPaperSize gfShowPrinter = True End If
- PAMD2
- お礼率66% (2/3)
- Visual Basic
- 回答数3
- ありがとう数2
- みんなの回答 （3）
- 専門家の回答
みんなの回答
- MAXIMAX
- ベストアンサー率60% (50/83)
#2 です。なかなか解決できずに困っていらっしゃるようですね・・・・・・。 前者の方法も後者と効果は変わらないようにおもいますが、以下のような感じですね。 (DevMode の設定値変更後のコメントが付いている 3 行が追加変更です) ----- DevMode.dmPaperSize = mintPaperSize DevMode.dmOrientation = mintPaperOrnt DevMode.dmDefaultSource = sngPaperBin CopyMemory aDevMode(0), DevMode, Len(DevMode) ' 追加、DevMode を aDevMode に書き戻す PrintDlg.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, bufSize) ' バッファサイズを bufSize に lpDevMode = GlobalLock(PrintDlg.hDevMode) If lpDevMode > 0 Then CopyMemory ByVal lpDevMode, aDevMode(0), bufSize 'コピー元を aDevMode に、サイズを bufSize に bReturn = GlobalUnlock(lpDevMode) ----- aDevMode のサイズが DevMode と同じであれば意味はありません。ダイアログ表示後に取り出すデータは必要なとこだけ取り出せればいいので、DevMode に取り出すことで問題ないと思います。 解決できるといいですね・・・・・・・。
- MAXIMAX
- ベストアンサー率60% (50/83)
DEVMODE の扱いがちょっと気になりました。一応調べてみたほうがいいかも・・・・・・レベルなのですが、書きます。 DEVMODE というのはデバイスによってサイズが違うことになっているため、単一の DEVMODE 構造体で全体を表現することはできないことになっています。 DevMode 変数の構造がわからないのですが、おそらくどのデバイスでも共通部分の構造体のみが定義されているのではないかと推測しますが、デバイスが返す DEVMODE は、そのデバイス固有の Private エリアがあり、そのためサイズが一定しないことになっています(ソースで使われている DevMode という変数のサイズと、サイズを取得して ReDim した aDevMode のサイズが違うことがあると考えます)。 このため、aDevMode から DevMode だけ引き出し、内容を設定して hDevMode に DevMode のサイズ分だけ設定しているため、プライベートエリアの情報が欠落(というか範囲外のメモリなので不定値になってしまっている)と考えられます。 対処法は2つ考えられます。ひとつは DevMode を設定した後、DevMode をもう一度 aDevMode に書き戻し、hDevMode には aDevMode 分のサイズのメモリを確保・設定します。 もう一つはDevMode 構造体の最後に、必要以上の空の配列でも用意していおいて(要は余裕で aDevMode が入るであろうサイズ)、aDevMode をそっくり DevMode にコピーしてから DevMode を設定し、hDevMode に DevMode のサイズを確保・設定します(aDevMode 分のサイズでもいいはずですが、大きい分には構わないはず)。 という感じでは・・・・・・・、とちょっと推測します。おそらく、範囲外になっているプライベートエリアの部分が、最初は 0 フィルされていたのが実行中にダーティデータ化して誤動作しているのでは、と推測しています。 ちょっと長くてごめんなさい。一度確認してみてはいかがでしょうか？？
- piroin654
- ベストアンサー率75% (692/917)
>PrintDlg.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(DevMode)) >lpDevMode = GlobalLock(PrintDlg.hDevMode) これらのハンドルは解放されていますか。 思いつくのはこれぐらいですが。
お礼
回答を頂きありがとうございました。（お礼が遅くなり申し訳ありません） 最後に、以下の２行を追加してみましたが、ダメでした。 GlobalFree PrintDlg.hDevNames GlobalFree PrintDlg.hDevMode その後、いろいろ試しているのですが、未だ解決には至っておりません。 もし、また何かありましたらお願いします。
関連するQ&A
- ダイアログボックスを表示したい。
下記処理コードを実行したときに、 ファイル選択のダイアログ表示をさせるのにファイル名を決まった形にしないと駄目みたいです。 (例)strLookupFileName = "abcms_E000_H*.csv;" ファイル名に関係なくダイアログを表示させるにはどうしたら良いのでしょうか？ 今現在、ファイル名を適当なものに変えると「キャンセルされました。」のメッセージボックスが表示されます。 例：strLookupFileName = "abc明細.xls"←エラー（これでも可に） (処理コード) 'ファイル選択 strFileName = FileNameGet(Me.Hwnd, strHomeDirectory, strLookupFileName, "CSV ファイル", "ファイル選択") If strFileName = "" Then MsgBox "キャンセルされました。", vbInformation + vbOKOnly, " " Exit Sub End If ↓ Public Function FileNameGet(Owner As Variant, DefaultDirectory As String, DefaultFilter As String, DefaultFilterName As String, Title As String) As Variant On Error GoTo Err Dim dlg As OPENFILENAME Dim rslt As Long dlg.hwndOwner = Owner dlg.hInstance = 0 'dlg.nFilterIndex = 0 dlg.lpstrTitle = Title & Chr(0) & Chr(0) dlg.lpstrFileTitle = Space(256) & Chr(0) & Chr(0) dlg.lpstrInitialDir = DefaultDirectory & Chr(0) & Chr(0) dlg.lpstrFile = DefaultFilter & Space(256) & Chr(0) & Chr(0) dlg.lpstrFilter = DefaultFilter & Chr(0) & Chr(0) dlg.nMaxFile = Len(dlg.lpstrFile) dlg.nMaxFileTitle = Len(dlg.lpstrFileTitle) dlg.lStructSize = Len(dlg) rslt = GetOpenFileName(dlg) If rslt = 0 Then FileNameGet = "" Exit Function End If 'ファイル名チェック If IsNull(dlg.lpstrFile) Or dlg.lpstrFile = "" Then MsgBox "ファイル名が取得できませんでした。", vbInformation + vbOKOnly, " " FileNameGet = Null Exit Function End If 'FileNameGet = StrConv(MidB(StrConv(dlg.lpstrFile, vbFromUnicode), 1, (dlg.nFileExtension + 3)), vbUnicode) FileNameGet = Left$(dlg.lpstrFile, InStr(dlg.lpstrFile, vbNullChar) - 1 On Error GoTo 0 Exit Function Err: MsgBox Err.Description End Function
- ベストアンサー
- Visual Basic
- VB6 OpenPrinterのエラー
OS：WindowsXP SP3 言語：VB6 SP6 現在、指定されたプリンタのジョブを取得して、全てジョブを一時停止にするプログラムを作っています。 下記コードはタイマーイベントで実行されるコードなのですが、、、 「lngRet = OpenPrinter(mPrinterName, hPrinter, ByVal 0&)」の部分で、 アプリケーションエラー（※添付画像参照）が発生してしまいます。 最初のうちは発生しませんが、数秒後にエラーになります。（タイマー間隔は0.5秒に設定） 内容をご存知の方がいましたら教えていただけないでしょうか？ 宜しくお願い致します。 ------------------------------------------------------------- Dim lngRet As Long Dim i As Integer Dim intRow As Integer Dim lngTypeLen As Long Dim hPrinter As Long Dim Level As Long Dim bytJob() As Byte Dim dwNeeded As Long Dim dwReturned As Long Dim lngJobID() As Long Dim udtJobInfo1() As JOB_INFO_1 Dim ftDate As FILETIME Dim ltDate As FILETIME Dim stDate As SYSTEMTIME Dim udtPrinterDefaults As PRINTER_DEFAULTS '初期化 Call PgdGrid.RemoveItems(0, PgdGrid.Items) PgdGrid.Enabled = False Erase lngJobID 'プリンタアクセス権 udtPrinterDefaults.DesiredAccess = PRINTER_ALL_ACCESS 'プリンタをオープンし、プリンタのハンドルを取得 ↓エラーになる＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊ lngRet = OpenPrinter(mPrinterName, hPrinter, ByVal 0&) ↑エラーになる＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊ 'まずEnumJobsを実行し、必要なメモリサイズ(バッファのバイト数)を調べる lngRet = EnumJobs(hPrinter, 0&, &HFFFFFFFF, 1&, ByVal 0&, 0&, dwNeeded, dwReturned) If dwNeeded = 0& Then Call ClosePrinter(hPrinter) Exit Sub End If '配列初期化 ReDim bytJob(dwNeeded - 1) '実際のデータを取得するために関数を実行 lngRet = EnumJobs(hPrinter, 0, &HFFFFFFFF, 1, bytJob(0), dwNeeded, dwNeeded, dwReturned) '配列初期化 ReDim udtJobInfo1(dwReturned - 1) ReDim lngJobID(dwReturned - 1) For i = 0 To dwReturned - 1 Call MoveMemory(udtJobInfo1(i), bytJob(Len(udtJobInfo1(0)) * i), Len(udtJobInfo1(0))) lngJobID(i) = udtJobInfo1(i).JobId lngRet = OpenPrinter(mPrinterName, hPrinter, udtPrinterDefaults) 'ジョブの状態を一時停止にする If (udtJobInfo1(i).Status And JOB_STATUS_PAUSED) Or (udtJobInfo1(i).Priority = 2) Then '一時停止 or 本PGで既に設定したものは状態を変えない Else '優先順位を変える（フラグ） udtJobInfo1(i).Priority = 2 lngRet = SetJob(hPrinter, lngJobID(i), 1, ByVal udtJobInfo1(i), JOB_CONTROL_PAUSE) If lngRet = 0 Then 'エラー MsgBox GetLastErrorMessage(GetLastError) End If '一時停止にする lngRet = SetJob(hPrinter, lngJobID(i), 0&, 0&, JOB_CONTROL_PAUSE) If lngRet = 0 Then 'エラー MsgBox GetLastErrorMessage(GetLastError) End If End If 'プリンタをクローズ Call ClosePrinter(hPrinter) Next i -------------------------------------------------------------
- ベストアンサー
- Visual Basic
- ファイルを読み込んだらVBがフリーズする
↓のコードだと、ファイルを読み込んだ時点でVBがフリーズします（平気なファイルも一部ある）。原因と解決法を教えてください。 Private Sub Command1_Click() CommonDialog1.Filter = "テキスト(*.txt)|*.txt|すべて(*.*)|*.*" CommonDialog1.FilterIndex = 1 CommonDialog1.Flags = cdlONFileMustExist CommonDialog1.CancelError = True On Error Resume Next CommonDialog1.ShowOpen If (Err = 0) Then FileRead CommonDialog1.FileName End If On Error GoTo 0 End Sub Private Sub FileRead(FL As String) Dim FileNo As Integer Dim strDAT As String Dim strELM As String Dim pot1 As Integer, pot2 As Integer Dim pDB1 As Integer, pDB2 As Integer FileNo = FreeFile() Open FL For Input As #FileNo While Not EOF(FileNo) Line Input #FileNo, strDAT strDAT = strDAT & ":" pot1 = InStr(strDAT, ":") While pot1 > 0 strELM = Left(strDAT, pot1) pot2 = InStr(strELM, "OPEN") While pot2 > 0 pDB1 = InStr(strELM, Chr(&H22)) If pDB1 > 0 Then '前の『"』の位置 pDB2 = InStr(pDB1 + 1, strELM, Chr(&H22)) If pDB2 > 0 Then RichTextBox1.Text = RichTextBox1.Text & _ Mid(strELM, pDB1 + 1, pDB2 - pDB1 - 1) & vbCrLf End If End If pot2 = InStr(pDB2 + 1, strELM, "OPEN") Wend strDAT = Mid(strDAT, pot1 + 1) pot1 = InStr(strDAT, ":") Wend Wend Close #FileNo End Sub
- ベストアンサー
- Visual Basic
- VB2008EEのチェックボックスにて、
VB2008EEのチェックボックスにて、 9個のチェックボックスをオン/オフで9個のテキストボックスに文字を表示/非表示させる場合、 一旦チェックをオンにすると値が入ったままになって、オフにしても表示されてしまうため チェックがオフのものはボタン1クリックで空にしています。 1～9まであるのですが、1～4までは機能しているのですが、5～9が機能しません。 1～4にチェックが入っていると下記は実行されません。 5～9にチェックが入っていても下記が実行されてしまいます。 （実際は各番号） ↓ If CheckBox5.CheckState = CheckState.Unchecked Then layp5 = "" End If なぜ4までと5からで動作が変わるのでしょうか？ -------------------------------------------------------------- Private Sub CheckBox1_CheckedChanged(ByVal sender As System.Object,ByVal e As System.EventArgs) Handles CheckBox1.CheckedChanged layp1 = "1" End Sub '実際は2～8も記述あり Private Sub CheckBox9_CheckedChanged(ByVal sender As System.Object,ByVal e As System.EventArgs) Handles CheckBox1.CheckedChanged layp9 = "9" End Sub Private Sub Button1_Click(ByVal sender As System.Object, ByVal eAsSystem.EventArgs) Handles Button1.Click If CheckBox1.CheckState = CheckState.Unchecked Then layp1 = "" End If '実際は2～8も記述あり If CheckBox9.CheckState = CheckState.Unchecked Then layp9 = "" End If If (layp1 = "1") Then TextBox1.Text = "aaaaa" End If If (layp2 = "2") Then TextBox2.Text = "bbbbb" End If If (layp3 = "3") Then TextBox3.Text = "ccccc" End If If (layp4 = "4") Then TextBox4.Text = "ddddd" End If If (layp5 = "5") Then TextBox5.Text = "eeeee" End If If (layp6 = "6") Then TextBox6.Text = "fffff" End If If (layp7 = "7") Then TextBox7.Text = "ggggg" End If If (layp8 = "8") Then TextBox8.Text = "hhhhh" End If If (laypca = "9") Then TextBox9.Text = "iiiii" End If End Sub
- ベストアンサー
- Visual Basic
- VBの印刷について
visual basic6の印刷について質問です。 現在ピクチャーボックス内にテキストボックスやオプションボタンなどの コントロールを配置しています。 それを印刷したいのですがうまくいきません。 各コントロールが認識されずに真っ白な状態で印刷されます。 以下のソースで各コントロールが認識されていないことがわかりました。 Private Sub print_cmd_Click() print_mt = MsgBox("印刷しますか？", vbYesNo,) If print_mt = vbYes Then Picture2.Picture = Picture2.Image SavePicture Picture2.Picture, App.Path & "\abc.bmp" End If End Sub bmpで表示しようとしても何も確認できません。。。 Printer.PaintPicture Picture1.Image Printer.EndDoc でやっても白紙ででてきます。 AutoRedrowはTrueにしてます。 なぜピクチャーボックス内のコントロールが認識されないのでしょうか？ 各コントロールは正常に動作しています。
- 締切済み
- Visual Basic
- エクセルVBA 重複を表示したい
エクセルVBA 重複を表示したい Ａ列で重複すると警告するコードを以下のように作成しました。 これを修正してＡ列で重複して、なおかつＢ列でも重複した場合警告するコードにしたいのです。 添付した図では「同姓同名あり、確認してください、鈴木一郎、山口」と表示したいのです。 ご教授よろしくお願いします。 Sub test() Dim myRange As Range Dim 同一flag As Boolean Dim MsgStr As String For Each myRange In Range("A2:A10") If WorksheetFunction.CountIf(Range("A2:A10"), myRange) > 1 Then If 同一flag = False Then 同一flag = True If InStr(1, MsgStr, myRange) = 0 Then MsgStr = MsgStr & myRange & vbCrLf End If End If Next If 同一flag = True Then MsgBox "同姓同名あり" & Chr(13) & _ "確認してください" & Chr(13) & _ vbCrLf & MsgStr Else End If End Sub
- ベストアンサー
- その他MS Office製品
- ファイルのパス名をダイアログボックスから選びたい
下のコードの９行目のOPEN " "の中（ファイルのパス名が入る）を、ダイアログボックスから選べるようにするにはどうすればよいのでしょうか。至急、回答をお願いします。 Private Sub Command1_Click() Dim FileNo As Integer 'ファイル番号 Dim strDAT As String '行データ Dim strELM As String 'マルチステートメントの分解 Dim pot1 As Integer, pot2 As Integer '『:』、『OPEN』の位置 Dim pDB1 As Integer, pDB2 As Integer '『"』の位置(前と後) FileNo = FreeFile Open " " For Input As #FileNo 'ファイルをセットする While Not EOF(FileNo) Line Input #FileNo, strDAT '行データを読み込む strDAT = strDAT & ":" pot1 = InStr(strDAT, ":") 'マルチステートメント対応 While pot1 > 0 strELM = Left(strDAT, pot1) 'マルチステートメントの分解 pot2 = InStr(strELM, "OPEN") 'OPENの位置 While pot2 > 0 pDB1 = InStr(strELM, Chr(&H22)) '『"』の位置 If pDB1 > 0 Then '前の『"』の位置 pDB2 = InStr(pDB1 + 1, strELM, Chr(&H22)) If pDB2 > 0 Then '後ろの『"』があったら RichTextBox1.Text = RichTextBox1.Text & _ Mid(strELM, pDB1 + 1, pDB2 - pDB1 - 1) & vbCrLf End If End If pot2 = InStr(pDB2 + 1, strELM, "OPEN") 'OPENはもうないか Wend '次の命令文 strDAT = Mid(strDAT, pot1 + 1) pot1 = InStr(strDAT, ":") Wend Wend End Sub
- 締切済み
- Visual Basic
- FormClosing イベント から終了を取り消すには VB2005
VB2005で開発しているのですが。 FormClosingイベントの中で。Formの終了イベントを取り消すにはどうしたらよいでしょうか？ たとえば。こんなコードがあったら 終了イベントの取り消しにはなんと書いたらよいでしょうか？ Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing If TextBox1.Text = "01" Then MsgBox("完了！！", MsgBoxStyle.OkCancel) Else ' ここに取消終了のコードを書いたらいいのですか？ End If End Sub すいませんが。アドバイスをお願いします。 開発環境： XinXP Pro SQL Server2005 Express VS2005 Pro VB2005
- ベストアンサー
- Visual Basic
- VB.NET クラス内でプログラムを終了するには?
VBAでは、エラーでプログラムを終了する時には Endステートメントを記述していましたが、 このVBAをVB.NET(クラスライブラリ、DLL)に 書き換えていますが VB.NETでClass1クラスの中にtest()メソッドを作って この中にEndステートメントを記述すると 「クラスライブラリプロジェクトで Endステートメントを使用することができません。」 というメッセージが表示されますが エラーでプログラムを終了するには どのように記述すればいいのでしょうか。 Public Class Class1 Public Sub test(ByVal a As String) If a = "" Then MsgBox("致命的なエラーです") End <===エラー発生 End If End Sub End Class よろしくお願いします。(WindowsXP,VS2010)
- ベストアンサー
- Visual Basic
- VB6のコードをVB.NETに移したいのですが
WEBで見つけたVB6のサンプルコードをVB.NET用に書き直して いるのですが、なんとか波線のエラーはなくなったものの 実行すると、思った結果が得られません。 正しい訂正方法を教えて頂きたいです。 サンプルコードは下記のサイトにありました。 http://vbnet.mvps.org/index.html?code/internet/findfirstcacheentry.htm インターネットキャッシュに関するものです。 文字数の関係で全部は書けないのですが、現在は↓のようになっています。 その他の訂正箇所は 全部のAs Any を As Objectに変更していて、 ComboBoxのアイテムに数値が設定できないようなので、 Select Caseで判断するようにしています。 Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim numEntries As Long Dim cacheType As Long Select Case ComboBox1.SelectedIndex Case Is = 0 cacheType = &H1S Case Is = 1 cacheType = &H8S Case Is = 2 cacheType = &H10S Case Is = 3 cacheType = &H20S Case Is = 4 cacheType = &H40S Case Is = 5 cacheType = &H10000 Case Is = 6 cacheType = &H100000 Case Is = 7 cacheType = &H200000 Case Is = 8 cacheType = URLCACHE_FIND_DEFAULT_FILTER End Select Label1.Text = "Working ..." Label1.Refresh() ListBox1.Items.Clear() ListBox1.Visible = False numEntries = GetCacheURLList(cacheType) ListBox1.Visible = True Label1.Text = VB6.Format(numEntries, "###,###,###,##0") & "files found" End Sub Private Function GetCacheURLList(ByRef cacheType As Long) As Long Dim ICEI As INTERNET_CACHE_ENTRY_INFO Dim hFile As Long Dim cachefile As String Dim nCount As Long Dim dwBuffer As Long Dim pntrICE As Long dwBuffer = 0 hFile = FindFirstUrlCacheEntry(vbNullString, 0, dwBuffer) If (hFile = ERROR_CACHE_FIND_FAIL) And (Err.LastDllError = ERROR_INSUFFICIENT_BUFFER) Then pntrICE = LocalAlloc(LMEM_FIXED, dwBuffer) If pntrICE Then CopyMemory(pntrICE, dwBuffer, 4) hFile = FindFirstUrlCacheEntry(vbNullString, pntrICE, dwBuffer) If hFile <> ERROR_CACHE_FIND_FAIL Then Do CopyMemory(ICEI, pntrICE, Len(ICEI)) If (ICEI.CacheEntryType And cacheType) Then cachefile = GetStrFromPtrA(ICEI.lpszSourceUrlName) ListBox1.Items.Add(cachefile) nCount = nCount + 1 End If Call LocalFree(pntrICE) dwBuffer = 0 Call FindNextUrlCacheEntry(hFile, 0, dwBuffer) pntrICE = LocalAlloc(LMEM_FIXED, dwBuffer) CopyMemory(pntrICE, dwBuffer, 4) Loop While FindNextUrlCacheEntry(hFile, pntrICE, dwBuffer) End If End If End If Call LocalFree(pntrICE) Call FindCloseUrlCache(hFile) GetCacheURLList = nCount End Function どうしてもここから分からないので、お助けいただきたいです。 よろしくお願いいたします。
- ベストアンサー
- Visual Basic
お礼
回答を頂きありがとうございました。（お礼が遅くなり申し訳ありません） > もう一つはDevMode 構造体の最後に、必要以上の空の配列でも用意していおいて(要は余裕で > aDevMode が入るであろうサイズ)、aDevMode をそっくり DevMode にコピーしてから DevMode > を設定し、hDevMode に DevMode のサイズを確保・設定します(aDevMode 分のサイズでもいいは > ずですが、大きい分には構わないはず)。 こちらを試してみました。 具体的には、DevMode 構造体の最後に、以下の１行を追加しました。 dmFiller(2048) As Byte が、うまくいきませんでした。 その後、いろいろ試しているのですが、未だ解決には至っておりません。 もし、また何かありましたらお願いします。
補足
引き続きご回答を頂けるとありがたいです。 >対処法は2つ考えられます。ひとつは DevMode を設定した後、DevMode をもう一度 aDevMode に書き戻し >hDevMode には aDevMode 分のサイズのメモリを確保・設定します。 ひとつめの方法、具体的にどのようなコーディングになりますでしょうか？ お手数をおかけして申し訳ありませんが、ご教示いただけるとありがたいです。 よろしくお願いします。