VB6のコードをVB.NETに移したい

2023/08/08 01:21

このQ&Aのポイント

VB6のサンプルコードをVB.NET用に書き直して実行すると思った結果が得られない。
現在のコードではAs AnyをAs Objectに変更し、ComboBoxのアイテムに数値が設定できないため、Select Caseで判断している。
サンプルコードの一部（インターネットキャッシュに関する箇所）が欠落しているため、具体的な訂正方法が分からない。

ベストアンサー

VB6のコードをVB.NETに移したいのですが

2008/02/14 02:28

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 どうしてもここから分からないので、お助けいただきたいです。よろしくお願いいたします。

popopompom
お礼率43% (75/173)

Visual Basic
回答数2
ありがとう数1

みんなの回答 （2）
専門家の回答

質問者が選んだベストアンサー

ベストアンサー

dsuekichi
ベストアンサー率64% (171/265)

2008/02/14 15:05 回答No.2

> ツールの中にあるＶＢ６を自動で変換するという機能を使って > 変換した際にLongが全部Integerになっていたので、 > 全部Longに戻してしまってあります。つまり、「APIを使用するとき、型を変更しないとかなりの確率で誤動作」するので、親切にも直してくれた（LongをIntegerにしてくれた）のに、貴方は、それを無効にしたって事です。 Integerにしてください。

質問者

お礼 2008/02/14 15:25

ご回答ありがとうございます。全部Integerに直しました。変数の数値が変わって別のエラーが出たのでそれを調べて見たいと思います。ありがとうございました。

その他の回答 (1)

dsuekichi
ベストアンサー率64% (171/265)

2008/02/14 12:50 回答No.1

> その他の訂正箇所は > 全部のAs Any を　As Objectに変更していて、他はやっていないのでしょうか？例えば、Long型からInteger型への修正とか・・・＃VB6のLong型は32ビット、Integer型は16ビットでしたが、＃VB.NETでは、Long型は64ビット、Integer型は32ビットなので、＃APIを使用するとき、型を変更しないとかなりの確率で誤動作しますけど・・・

質問者

補足 2008/02/14 14:45

ご回答ありがとうございます。ツールの中にあるＶＢ６を自動で変換するという機能を使って変換した際にLongが全部Integerになっていたので、全部Longに戻してしまってあります。現在は↓のようになっているので、ご覧頂けると幸いです。 http://www.geocities.jp/popopompom_oshiete_goo/iecache1.htm

関連するQ&A

複数ファイルを1つにまとめる　コード添削願い
複数のファイルを1つのファイルにまとめようとがんばっています。リストボックスを用意し、ファイル一覧をつくり、そこからアドレスを取得して、まとめていくという手順です。ただ、最後のWriteFile関数の部分で、書き込みが出来ずエラーが返ります。なぜかが分かりません。ご教授お願いします。 Dim num As Long Dim buf As BytePtr Dim hFile As HANDLE Dim n As Long Dim LastFileSize As Long num=SendDlgItemMessage(hMainWnd,ListBox1,LB_GETCOUNT,0,0) For n=0 to num-1 Step 1 'ファイル名を取得 Dim name As BytePtr Dim len As Long Dim s As String Dim path As String Dim FileSize As Long Dim dwAccessByte As DWord len=SendDlgItemMessage(hMainWnd,ListBox1,LB_GETTEXTLEN,n,0)+1 name=malloc(len) SendDlgItemMessage(hMainWnd,ListBox1,LB_GETTEXT,n,name) s=MakeStr(name) free(name) 'ファイルパスを連結し、読み込む path=str+"\"+s 'ファイルハンドルの作成 hFile=CreateFile(path,GENERIC_READ,FILE_SHARE_READ or FILE_SHARE_WRITE,ByVal 0,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0) If hFile=INVALID_HANDLE_VALUE Then MessageBox(hMainWnd,Ex"ファイルハンドル作成時にエラーが発生しました！","Error File Number Is "+Str$(n)+" .",MB_OK or MB_ICONWARNING) Exit Sub End If 'ファイルのサイズの取得 FileSize=GetFileSize(hFile,0) LastFileSize=LastFileSize+FileSize '領域確保 If n=0 Then buf=malloc(FileSize+1) Else buf=realloc(buf,FileSize+1) End If 'ファイルの読み込み If ReadFile(hFile,buf,FileSize,VarPtr(dwAccessByte),ByVal 0)=0 Then MessageBox(hMainWnd,"ファイル読み込み時にエラーが発生しました！！","Error "+Str$(n),MB_OK or MB_ICONWARNING) MessageBox(hMainWnd,Ex"FileSize="+Str$(FileSize)+Ex"\r\ndwAccessByte="+Str$(dwAccessByte),"",MB_OK or MB_ICONWARNING) End If 'ファイル名とサイズを記録 Open dir+"\FileInfo.txt" For Append As #1 Print #1,s+"="+Str$(FileSize) Close #1 CloseHandle(hFile) Next hFile=CreateFile(dir+"\game.test",GENERIC_WRITE,0,ByVal 0,CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,0) If hFile=INVALID_HANDLE_VALUE Then MessageBox(hMainWnd,Ex"ファイルハンドル作成時にエラーが発生しました！","Error File Number Is At Last",MB_OK or MB_ICONWARNING) Exit Sub End If If WriteFile(hFile,buf,LastFileSize,VarPtr(dwAccessByte),ByVal 0)=FALSE Then MessageBox(hMainWnd,"ファイル作成時にエラーが発生しました！！","Last Error",MB_OK or MB_ICONWARNING) MessageBox(hMainWnd,Str$(LastFileSize)+","+Str$(dwAccessByte),0,0) End If CloseHandle(hFile) free(buf) MessageBox(hMainWnd,"処理終了","End",MB_OK or MB_ICONINFORMATION)
- ベストアンサー
- Visual Basic
作成したコードの間違っている箇所が分かりません。
Ｅｘｃｅｌ　ＶＢＡのコードを作成したのですが、間違った数値が返ってきてしまいます。どこが間違っているのか分からず困っています。お力を貸していただければと思います。Ｂ９セル以下のＢ列の奇数番号（Ｂ９，Ｂ１１，Ｂ１３・・・）に任意の数字（１～９）が入っています。その数字が３または５の場合、その行のＨ列からＰ列の数値が入っているセルの数をカウントしたく思っています。（Ｈ列からＰ列には空欄または時刻のデータが入っています。）また、シートが２０枚ほどあり、すべてのシートで同じ作業を行い、最終的には別シートを作成し、Ａ列にシート名、Ｂ列にカウントしたセルの数を表示させます。ちなみに全シート、データはＡ列からＰ列、１行目から１２０行目くらいまで入っています。（空欄のセルもあります。）以下がコードです。 Sub Try1() Dim sumSheet As Worksheet Dim ws As Worksheet Dim i As Long, LastRow As Long Dim n As Long, nCount As Long '集計シートの作成 With ActiveWorkbook.Worksheets On Error Resume Next Set sumSheet = .Item("sum") On Error GoTo 0 If sumSheet Is Nothing Then Set sumSheet = .Add(After:=.Item(.Count)) sumSheet.Name = "sum" Else sumSheet.UsedRange.ClearContents End If ReDim res(1 To .Count - 1, 1 To 2) End With '集計 n = 0 For Each ws In ActiveWorkbook.Worksheets If ws.Name <> "sum" Then With ws LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row nCount = 0 For i = 9 To LastRow Step 2 Select Case .Cells(i, 2).Value Case 3,5 nCount = nCount + WorksheetFunction.Count(.Cells(i, 8).Resize(, 9)) End Select Next n = n + 1 res(n, 1) = .Name res(n, 2) = nCount End With End If Next sumSheet.Range("A1").Resize(n, 2).Value = res sumSheet.Activate MsgBox "集計しました" End Sub ＶＢＡ初心者です。よろしくお願いいたします。
- ベストアンサー
- Visual Basic
VBをＶＢＡに　ソースコードあり
二度ほど　こちらを利用させていただき、一歩ずつ理解してきているのですが、回りにＶＢ、ＶＢＡを使っている方がいなく、相談出来る所がここしかなく　また投稿させて頂きました今回　迷っている事は　ＶＢのソースコードがありそれをＶＢＡで実行する場合、どこで宣言すればいいのかという事ですＶＢの～ソースコード～メインふぉーむデータ受信関数 Private Sub RF720CLib_RFIDMessage(ByVal Message As String, ByVal MessageSize As Long) Dim code As String Dim cmd As String Dim body As String code = RF720CLib.GetResponseCode(Message, MessageSize) cmd = RF720CLib.GetCmdCode(Message, MessageSize) body = RF720CLib.GetResponseBody(Message, MessageSize) If code = "00" Then If cmd = "RD" Then For cnt = 0 To csvline - 1 If Vegetable(cnt).m_ID = body Then End If Next End If If cmd = "IS" Then ReadStep = ReadStep + 1 End If End If End Sub ↑ こちらで　RF720CLib　ライブラリーを使い　ＲＤ　リードなどを行ってるとは思うのですがＶＢＡの場合フォームをロード時に　イベントとして宣言すればいいのでしょうか？それとも　上記のはＶＢですので　ＶＢＡで使う場合また新しく作り変えなければいけないのでしょうか？ＶＢとＶＢＡは全く違うもの　として考えた方がいいのでしょうか RF720CLibは　アクティブＸコントロールでＶＢＡでも使えましたとても　困っております宜しくお願いします
- 締切済み
- Visual Basic
続）VBAで作業の効率化をしたいです！
昨日は回答して頂いた方々誠にありがとうございます！２日続けての投稿失礼致します！今回はまた別のことをしています。うちの職場の勤務指定の一部分なんですが、日勤、中勤が出勤日で非番、週休が休日です。（見辛くてすみません）赤色の日は祝日です。勤務指定の右の欄に日勤中勤非番週休のそれぞれの合計を出しています。それとは別に祝日（赤色）のみの合計も出したいのですが、うまくいきませんでした。自分なりに調べてみた所、関数では文字色の判定が不可能みたいでした。そこで、昨日同サイトにて、教えて頂いたプログラムを元に、自分なりにマクロを作成してみたのですが、自宅では確認できない為、どこかおかしな所がないかアドバイスをお願いします！ Sub Test() Dim mRow As Long, mCol As Long Dim nCount As Long Dim tCount As Long Dim hCount As Long Dim sCount As Long Application.ScreenUpdating = False For mRow = 2 To Cells(Rows.Count, "A").End(xlUp).Row nCount = 0 tCount = 0 hCount = 0 sCount = 0 For mCol = Columns("B:B").Column To Columns("H:H").Column If Cells(mRow, mCol).fontcolor = 3 Then Select Case Cells(mRow, mCol).Value Case "日勤" nCount = nCount + 1 Case "中勤" tCount = tCount + 1 Case "非番" hCount = hCount + 1 Case "週休" sCount = sCount + 1 End Select End If Next Cells(mRow, 14).Value = nCount Cells(mRow, 15).Value = tCount Cells(mRow, 16).Value = hCount Cells(mRow, 17).Value = sCount Next Application.ScreenUpdating = True End Sub すみませんが、スマホで記述している為、tabキーやスペースがグチャグチャになっています。
- ベストアンサー
- Excel（エクセル）
VB.NETのことで困っています。
VB.NETのプログラムで白黒判別プログラムを作成することになったのですが、GetPicxelの使い方が間違っているらしく正しくカウントしてくれません。ちなみに今作成している問題のプログラムは以下のプログラムです。 Function CountNumColor(ByRef DotWW As Long, ByRef DotHH As Long, ByRef CHECK_C As Long) As Integer Dim Form1 As Object Dim NumEQ As Double Dim NumNot As Long Dim x, y As Long NumEQ = 0 NumNot = 0 System.Windows.Forms.Application.DoEvents() For x = 0 To DotHH - 1 For y = 0 To DotWW - 1 System.Windows.Forms.Application.DoEvents() If CHECK_C = Val("Bitmap.GetPixel(x,y)") Then NumEQ = NumEQ + 1 Else NumNot = NumNot + 1 Debug.Write("x,y,Val(Bitmap.GetPixel(x, y)") End If Next y Next x CountNumColor = NumEQ End Function このプログラムで問題がありましたらぜひとも教えてください。GetPicxel以外の間違いに気づいた人がいた場合もご意見をお待ちしております。また、この質問で分からないことがございましたら遠慮なく書き込んでください。気づき次第返答いたします。
- ベストアンサー
- Visual Basic
VB.NETでXMLの読み込みを行うと例外エラーが出てしまい大変困って
VB.NETでXMLの読み込みを行うと例外エラーが出てしまい大変困っています。どなたかお願いします。 Protected Sub Button4_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button4.Click Dim FILENAME As String FILENAME = "C:\\TEST\" If i = 1 Then FILENAME = FILENAME & "AAA\111.xml" Call testmethod(FILENAME) ElseIf i = 2 Then FILENAME = FILENAME & "BBB\222.xml" Call testmethod(FILENAME) End If End Sub Private Sub testmethod(ByVal FILENAME) If File.Exists(FILENAME) Then Dim xlr As XmlTextReader xlr = New XmlTextReader(FILENAME) While xlr.Read() Select Case xlr.LocalName Case "Personal" TextBox1.Text = xlr.ReadString Case "LastUpdate" Label1.Text = xlr.ReadString End Select End While xlr.Close() End If End Sub こんな感じでコードを書いているのですがWhile xlr.Read()のところで例外エラーが出てしまいます。原因が全然つかめず困っています。 New XmlTextReader(FILENAME)のFILENAMEを変数でなく直接パスを書くとうまくいくのですが変数にするとなぜかハンドリングできなくなります。どなたかご解説お願いします。
- ベストアンサー
- Visual Basic
VB6 二重起動確実防止について
VB6 SP5にて２重起動確実な防止処理をいれようとCreateMutex 関数を使用しようと思っています。 CreateMutex 関数を埋め込んでEXEを実行すると実際に対象となるプログラムが起動しているにも関わらず起動してしまいます。何がいけないのか？検討がつかず困っています。下記がプログラムになります。何かわかりましたらご回答の程、よろしくお願い致します。 ***Win32API**************** Option Explicit ' CreateMutex 関数 Private Declare Function CreateMutex Lib "KERNEL32.DLL" Alias "CreateMutexA" ( _ ByRef lpMutexAttributes As Long, _ ByVal bInitialOwner As Long, _ ByVal lpName As String _ ) As Long ' CloseHandle 関数 Private Declare Function CloseHandle Lib "KERNEL32.DLL" ( _ ByVal hObject As Long _ ) As Long ************************************ SUB MAIN********************************* Public Sub Main() Dim hMutex As Long hMutex = CreateMutex(ByVal 0&, 0&, App.Title) On Error GoTo Err_Main If Err.LastDllError = 0 Then Dim cForm As Form1 Set cForm = New Form1 Call cForm.Show(vbModal) End If Err_Main: If hMutex <> 0 Then Call CloseHandle(hMutex) End If End Sub ************************************************
- ベストアンサー
- その他（プログラミング・開発）
VBのコードが理解できません　解説いただけないでしょうか？
Dim ObjIE As Object Dim ObjShell As Object Dim ObjWindow As Object Dim WinExist As Boolean WinExist = False Set ObjShell = CreateObject("Shell.Application") For Each ObjWindow In ObjShell.Windows If TypeName(ObjWindow.Document) = "HTMLDocument" Then 　WinExist = True 　Set ObjIE = ObjWindow End If Next Set ObjShell = Nothing If Not WinExist = True Then Set ObjIE = CreateObject("InternetExplorer.Application") End If ObjIE.Navigate "http://nantokakantoka.html" ObjIE.Visible = True このコードを解説いただけないでしょうか？特に WinExist For Each ObjWindow In ObjShell.Windows If TypeName(ObjWindow.Document) = "HTMLDocument" Then が何をしているのか分からないんです。
- ベストアンサー
- Visual Basic
VB6でのmmioOpen関数の使い方
VB6でwaveファイルから音の波形を取得するプログラムを作りたいと思っているのですが、mmioOpen関数の使い方が分からずに困っています。とりあえず現在の状況を書くと、 Private Declare Function mmioOpen Lib "winmm.dll" Alias "mmioOpenA" (ByVal szFileName As String, lpmmioinfo As MMIOINFO, ByVal dwOpenFlags As Long) As Long Private Declare Function mmioClose Lib "winmm.dll" (ByVal hmmio As Long, ByVal uFlags As Long) As Long Private Type MMIOINFO dwFlags As Long fccIOProc As Long pIOProc As Long wErrorRet As Long htask As Long cchBuffer As Long pchBuffer As String pchNext As String pchEndRead As String pchEndWrite As String lBufOffset As Long lDiskOffset As Long adwInfo(4) As Long dwReserved1 As Long dwReserved2 As Long hmmio As Long End Type Dim p1 As MMIOINFO Dim h As Long Dim closewav As Long Private Sub Command1_Click() openfilename = "C:\sample.wav" 'WAVEファイルを開く h = mmioOpen(openfilename, p1, MMIO_READ) MsgBox h If h <> 0 Then MsgBox "WAVEファイルのオープンに失敗" End If 'WAVEファイルを閉じる closewav = mmioClose(h, MMIO_FHOPEN) MsgBox closewav End Sub だれか分かる方がいれば、間違っている箇所、やり方などを教えてください。よろしくお願いします。
- ベストアンサー
- 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