ActiveBasicリソースの追加/読み込み

このQ&Aのポイント
  • ActiveBasic 4.23.00を使用している中で、リソースの追加/読み込みの方法を探していました。
  • Declare関数を使用してリソースを追加する方法やエラーメッセージの処理を行いながら、ファイルの暗号化ソフトの作成を試みました。
  • しかし、IsUpdate=0でエラーが発生し、解決策がわからなくなってしまいました。ご存知の方はいらっしゃいますか?
回答を見る
  • ベストアンサー

ActiveBasic リソースの追加/読み込み

ActiveBasic 4.23.00 を使用しています。 今回、ファイルの暗号化ソフトを作成しようと思い、手段を考えていたところ、ON ERROR RESUME NEXT様のリソースの追加/読み込みの項目を見つけ、 これでやってみようと作成を始めました。 Declare Function BeginUpdateResource Lib "kernel32" Alias "BeginUpdateResourceA" (pFileName As BytePtr,bDeleteExistingResources As Long) As Long Declare Function UpdateResource Lib "kernel32" Alias "UpdateResourceA" (hUpdate As Long,lpType As BytePtr,lpName As BytePtr,wLanguage As Long,lpData As VoidPtr,cbData As Long) As Long Declare Function EndUpdateResource Lib "kernel32" Alias "EndUpdateResourceA" (hUpdate As Long,fDiscard As Long) As Long '定数 Const RT_MANIFESTID=1 Const RT_MANIFEST="BINTYPE" Sub MainWnd_CommandButton1_Click() Dim IsUpdate As Long Dim Update As Long Dim temp As String 'EditBoxをチェック Dim Ed1 As Long Dim Ed2 As Long Dim buf1 As BytePtr Dim buf2 As BytePtr Ed1=GetWindowTextLength(GetDlgItem(hMainWnd,EditBox1)) Ed2=GetWindowTextLength(GetDlgItem(hMainWnd,EditBox2)) If Ed1=0 Then MessageBox(hMainWnd,"埋め込み用物質が選択されていません","Error 1",MB_OK or MB_ICONHAND) Exit Sub End If If Ed2=0 Then MessageBox(hMainWnd,"埋め込み先物質が選択されていません","Error 2",MB_OK or MB_ICONHAND) Exit Sub End If buf1=malloc(Ed1+1) buf2=malloc(Ed2+1) GetDlgItemText(hMainWnd,EditBox1,buf1,Ed1) GetDlgItemText(hMainWnd,EditBox2,buf2,Ed2) temp=MakeStr(buf2) IsUpdate=BeginUpdateResource(buf1,TRUE)'FileName はターゲットファイルのフルパス。Ex:"C:\test.exe" にリソースを埋め込む場合、FileName="C:\test.exe" If IsUpdate=0 Then'エラー free(buf1) free(buf2) MessageBox(hMainWnd,"リソースの埋め込み先に異常あり","Error 3",MB_OK or MB_ICONHAND) Exit Sub EndIf Update=UpdateResource(IsUpdate,RT_MANIFEST,RT_MANIFESTID,MAKELANGID(LANG_JAPANESE,SUBLANG_SYS_DEFAULT),temp,Len(temp)) If Update=0 Then'エラー EndUpdateResource(IsUpdate,TRUE) free(buf1) free(buf2) MessageBox(hMainWnd,"リソースの埋め込み時に異常事態発生","Error 4",MB_OK or MB_ICONHAND) Exit Sub End If EndUpdateResource(IsUpdate,FALSE) free(buf1) free(buf2) MessageBox(hMainWnd,"たぶんエラーなく書き込みを完了しました。","Success!!",MB_OK or MB_ICONINFORMATION) End Sub このように書いてみたのですが、IsUpdate=0でいつもエラーが返ってきます。 何故かが分かりません。 すみませんが、ご存知の方がいらっしゃいましたら、ご教授の方をお願いします。

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

  • ベストアンサー
  • redfox63
  • ベストアンサー率71% (1325/1856)
回答No.1

buf1に読み込んだファイル名が完全でないのではありませんか? BytePtr型へ読み込まずにString型へ読み込んだほうがいいかもしれませんよ dim ss as String GetDlgItemText( hMainWnd, EditBox1, ss, 256 ) といった具合で APIに渡すときも String型ならそのままでいいようです IsUpdate = BeginUpdateResource( ss, TRUE ) といった具合で どうしても BytePtr型がいいのであれば GetDlgItemText( hMainWnd, EditBox1, buf1, Ed+1 ) として 文字列の終端記号のNull文字の分まで読み込むようにしましょう

if-so-at
質問者

お礼

出来ました! ありがとうございました

関連するQ&A

  • ActiveBasic リソースの追加と読み込み

    ActiveBasic 4.23.00を使用しています。 以前、リソースの追加方法を教授していただきました。 リソースの追加と言うものは出来るようになったのですが、 文字列の都合上、以前の質問を使用させていただきます。 http://oshiete1.goo.ne.jp/qa4983148.html 上のコードを使用しているのですが、これだとやはり、『文字列』しか追加できないのでしょうか。 zip等のファイルを追加していきたいと思っているのですが、どのようにすればよろしいのでしょうか。 また、このコードを使用して、リソースをプログラムBに追加したところ、 プログラムBのアイコンが消えてしまいました。 これは、何か回避する方法があるのでしょうか。 最後に、 Declare Function FindResource Lib "kernel32" Alias "FindResourceA" (hInstance As DWord,lpName As BytePtr,lpType As BytePtr) As DWord Declare Function FreeResource Lib "kernel32" (hResData As DWord) As DWord Declare Function SizeofResource Lib "kernel32" (hInstance As DWord,hResInfo As DWord) As DWord Declare Function LoadResource Lib "kernel32" (hInstance As DWord,hResInfo As DWord) As DWord Declare Function LockResource Lib "kernel32" (hResData As DWord) As Long Const RT_MANIFESTID=50'埋め込んだ時と同じIDにしてください Const RT_MANIFEST="BINTYPE" Dim FileName[MAX_PATH] As Byte Dim hDLL As DWord, hResource As DWord, lResource As DWord Dim File As BytePtr GetModuleFileName(NULL,FileName,MAX_PATH) hDLL=LoadLibrary(FileName) If hDLL=0 Then MessageBox(hMainWnd,"ファイルの取得に失敗","Error 1",MB_OK or MB_ICONHAND) Exit Sub End If hResource=FindResource(hDLL,RT_MANIFESTID,RT_MANIFEST) If hResource=0 Then FreeLibrary(hDLL) MessageBox(hMainWnd,"ファイルの取り出しに失敗!","Error 1",MB_OK or MB_ICONHAND) Exit Sub End If lResource=LoadResource(hDLL,hResource) File=LockResource(lResource) FreeResource(lResource) FreeLibrary(hDLL) プログラムBに追加した物を取り出すプログラムですが、これはプログラムBに書きました。 実行すると、読み出しの部分でエラーが生じるのですが、どのように回避していけばよろしいのでしょうか。 長々と多くの質問をしてしまいすみません。 しかし、全然解決できずにもやもやしていて困っています。 何かやり方をご存知の方がいらっしゃいましたらご教授をお願いします。

  • ActiveBasic 音楽のループ再生

    Active Basic4.23.00でプログラムを書いています。 音楽再生ソフトを作ってみようと思い、作り始めたのですが、なかなかループ再生が出来ません。 チェックボックス1がチェックされていると、ループさせようと思っています。 ↓問題のコード Sub MainWnd_MciNotify(flags As Long, DevID As DWord) If SendMessage(GetDlgItem(hMainWnd,CheckBox1),BM_GETCHECK,0,0)=BST_CHECKED Then Dim bErr As Long Dim mpp As MCI_PLAY_PARMS mpp.dwCallback=hMainWnd mpp.dwFrom=0 bErr=mciSendCommand(mop.wDeviceID,MCI_PLAY,MCI_NOTIFY or MCI_FROM,mpp) If bErr Then MessageBox(hMainWnd,"デバイス再生エラー","Error",MB_OK or MB_ICONHAND) Exit Sub End If Else mpp.dwCallback=hMainWnd mpp.dwFrom=0 End If End Sub 一見、(少なくとも自分は)成功しているように見えるのですが、 2回ループした後、フリーズしてしまいます。 すみませんが、何故そうなるかが分かる方がいらっしゃいましたら、すみませんが、ご教授ください。 お願いします。

  • Active Basic 他のアプリケーションを終了させる

    Active Basic4.23.00を使用しています。 指定したほかのプロセスを終了させようと思っているのですが、 なかなか上手くいきません。 Dim hWnd As HWND Dim err As Long Dim code As DWord hWnd=FindWindow("notepad",NULL) If hWnd=NULL Then MessageBox(hMainWnd,"FindWindowでエラーが発生!","Error",MB_OK or MB_ICONHAND) Exit Sub End If GetExitCodeProcess(hWnd,code) If code=STILL_ACTIVE Then MessageBox(hMainWnd,"GetExitCodeProcessでSTILL_ACTIVEが返った!","Error",MB_OK or MB_ICONHAND) Exit Sub End If err=TerminateProcess(hWnd,code) If err=0 Then MessageBox(hMainWnd,"TerminateProcessでエラーが発生!","Error",MB_OK or MB_ICONHAND) MessageBox(0,Str$(code),"GetExitCodeProcessで取得したコード",MB_OK or MB_ICONINFORMATION) Exit Sub End If このようなコードを書きました。 すみませんが、間違いの指摘のほうをお願いします。 それと、『FindWindow』関数についてです。 ヘルプに、 >lpClassName >検索するクラス名を指定します。必要のないときは、NULL を指定することができます。 とありますが、クラス名≒プロセス名と考えてもいいのでしょうか。 また、lpClassNameを指定し、lpWindowNameにNULLを指定(今回のコードのような場合)では、ハンドルを取得できないのでしょうか。 すみませんが、ご教授をお願いします。

  • 複数ファイルを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)

  • 数列の計算後

    前に質問したのですが、 文字列を数列として扱う関数は分かりました。 その数字を計算し、変数に格納する所までは出来たのですが、 SetDlgItemText関数で、EditBox4にその変数を表示することが出来ません。 変数内には、きちんと数字が入ってます。 MessageBox関数を用いて変数内をテストで表示させようとすると、 アクセスエラーが出ます。 小数点も扱いたいので、Double型を指定しているのですが・・・ どう対処したら良いか分かりません。 すみませんが、ご教授願います・・・ ↓問題のコードです 'EditBoxの内容を取得 Dim Buffer As BytePtr Dim Length As Long Length = GetWindowTextLength(GetDlgItem(hMainWnd,EditBox1)) Buffer = calloc(Length+1) GetWindowText(GetDlgItem(hMainWnd,EditBox1),Buffer,Length+1) SaishoKazu=Val(Buffer) Length = GetWindowTextLength(GetDlgItem(hMainWnd,EditBox3)) Buffer = calloc(Length+1) GetWindowText(GetDlgItem(hMainWnd,EditBox3),Buffer,Length+1) AtoKazu=Val(Buffer) free(Buffer) '計算処理 If Kigo="+" Then Ans=SaishoKazu+AtoKazu End If SetDlgItemText(hMainWnd,EditBox4,Ans)

  • ActiveBasic 再描写処理が読み出されても、描写していた物を削除しない方法

    ActiveBasic4.23.00を使ってプログラムを書いています。 例えば、次のようなコードがあったとします。 'グローバル Dim DragFlag As Long Dim hDC As HDC '此処まで Sub MainWnd_Destroy() ReleaseDC(hMainWnd,hDC) test_DestroyObjects() PostQuitMessage(0) End Sub Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT) hDC = GetDC(hMainWnd) End Sub Sub MainWnd_LButtonDown(flags As Long, x As Integer, y As Integer) DragFlag = 1 MoveToEx(hDC,x,y,ByVal NULL) End Sub Sub MainWnd_MouseMove(flags As Long, x As Integer, y As Integer) If DragFlag = 0 Then Exit Sub LineTo(hDC,x,y) End Sub Sub MainWnd_LButtonUp(flags As Long, x As Integer, y As Integer) DragFlag = 0 End Sub (ABWiki様を参考にさせていただきました。) これで、簡単なお絵かきが出来ますが、再描写(例えば、ウインドウの大きさを変えるなど)をするとすべて消えてしまいます。 これを、描いた線を消さずに再描写することは出来ないのでしょうか。 すみませんがご教授ください。

  • Active Basic 再描写処理

    最近デバイスコンテキストを何とか理解してきたので、実験的に『上から物体が振ってくるのを避ける』というゲームを作ってみようと思い作り始めました。 『←』が押されれば、棒人間を左に、『→』が押されれば、棒人間を右に移動させる処理と、ランダムで●が上から落ちてくるという処理をタイマーを使ってやってみました。(スレッドとかはまだ勉強していないので) 一応完成はしたのですが、棒人間を動かすと、どうしても●がちらつきます。 この場合は、どういう風に処理をすればいいのでしょうか? プログラムはこう書きました。 グローバル変数 Dim hBmp01 As HWND Dim hBmp02 As HWND Dim hBmp03 As HWND Dim hBmp04 As HWND Dim hMemDC As HDC Dim BmpInfo As Long Dim hBomDC As HWND Dim Bomxy As RECT Dim x As Long Dim y As Long Dim bx As Long Dim by As Long Dim n As Long '---------------------------------------------------- 省略 '----------------------------------------------------- Sub MainWnd_Destroy() DeleteObject(hBmp01) DeleteObject(hBmp02) DeleteObject(hBmp03) DeleteObject(hBmp04) YokeGame_DestroyObjects() PostQuitMessage(0) End Sub Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT) SetWindowText(hMainWnd,"画像描写テスト ~爆弾的なものを避けるゲーム~") hBmp01 = LoadImage(0,".\画像\人\普通.bmp",IMAGE_BITMAP,0,0,LR_LOADFROMFILE) hBmp02 = LoadImage(0,".\画像\人\右.bmp",IMAGE_BITMAP,0,0,LR_LOADFROMFILE) hBmp03 = LoadImage(0,".\画像\人\左.bmp",IMAGE_BITMAP,0,0,LR_LOADFROMFILE) hBmp04 = LoadImage(0,".\画像\爆弾\ボム.bmp",IMAGE_BITMAP,0,0,LR_LOADFROMFILE) GetWindowRect(hBmp04,Bomxy) If hBmp01=0 or hBmp02=0 or hBmp03=0 or hBmp04=0 Then MessageBox(hMainWnd,Ex"画像の読み込みに失敗しました\r\n強制終了します。","Error",MB_OK or MB_ICONHAND) DeleteObject(hBmp01) DeleteObject(hBmp02) DeleteObject(hBmp03) DeleteObject(hBmp04) SendMessage(hMainWnd,WM_CLOSE,0,0) End If x=290 y=275 BmpInfo=1 bx = 320 by = 0 SetTimer(hMainWnd,0,300,0) End Sub Sub Kettei() Dim ok As Long by=0 Do Randomize bx = Fix(Rnd()*100) If bx>0 and 630>bx Then ok=TRUE End If Loop Until ok=TRUE End Sub Sub MainWnd_Paint(hDC As HDC) hMemDC = CreateCompatibleDC(hDC) hBomDC = CreateCompatibleDC(hDC) If BmpInfo = 1 Then SelectObject(hMemDC,hBmp01) Else If BmpInfo = 2 Then SelectObject(hMemDC,hBmp02) Else If BmpInfo = 3 Then SelectObject(hMemDC,hBmp03) End If BitBlt(hDC,x,y,40,50,hMemDC,0,0,SRCCOPY) Sleep(30) SelectObject(hMemDC,hBmp01) BitBlt(hDC,x,y,40,50,hMemDC,0,0,SRCCOPY) Sleep(30) SelectObject(hBomDC,hBmp04) BitBlt(hDC,bx,by,9,9,hBomDC,0,0,SRCCOPY) DeleteDC(hMemDC) DeleteDC(hBomDC) BmpInfo = 1 End Sub Sub MainWnd_KeyDown(KeyCode As Long, flags As Long) If KeyCode = 37 Then If x<=0 Then x=0 Exit Sub End If x = x - 10 BmpInfo=3 End If If KeyCode = 39 Then If x>=600 Then x = 600 Exit Sub End If x = x + 10 BmpInfo=2 End If InvalidateRect(hMainWnd,ByVal 0,TRUE) End Sub Sub MainWnd_Timer(TimerID As DWord) If TimerID = 0 Then by = by + 10 InvalidateRect(hMainWnd,Byval 0,TRUE) If by >=360 Then Kettei() End If End If End Sub っと、このようになりました。(一応動きます) strictには、チェックを入れていません。 バージョンは、4.23.00を使っています。 それと、InvalidateRect関数なのですが、 InvalidateRect(hMainWnd,Byval 0,TRUE) の、二つ目のパラメータ(?)部分に、全体を再描写させるときに何故『Byval 0』と表記するのでしょうか? ヘルプには、NULL を指定すると、クライアント領域全体が更新領域に設定されますと書かれていますが、NULLを指定すると無効な識別となります。 すみませんが、分かる方がいらっしゃいましたら、ご教授をお願いします。

  • ActiveBasic インターネットを通じてソフト間で通信する

    AB 4.23.00を使用しています。 今回、ネットワークのプログラムの勉強を始め、とりあえず、 ネットワークを通して、ソフト間で簡単なチャットが出来るものを作ってみようと思い、作り始めました。 以前、CreateMailslot関数などで出来ると思い、探し回ったのですが、どうしても出来ないので、質問させていただいたところ、『それでは出来ない』とのこと(http://oshiete1.goo.ne.jp/qa5833366.html)だったので、 新たな方法を探していたところ、ソケットというものを使えば出来るというようなことが書かれているページを見つけ、早速参考にさせていただいています。 ですが、どうも、構造というか、その辺がよく分かっていないので、 どこにどの値をどう入れればいいのか・・・などがよく分かりません。 送信用のプログラムは、おそらく書けていると思いますが(一応貼らせていただきます)、 受信用のプログラムでちょっとつまずいています。 connect関数の接続先はどう指定すればいいのか、ということです。 ご存知の方、いらっしゃいましたら、ご教授の方、お願いします。 【送信用】 #console #include <api_winsock2.sbp> Declare Function bind Lib "wsock32.dll" (s As Long,ByRef sName As sockaddr,namelen As Long) As Long Declare Function listen Lib "wsock32.dll" (s As Long,backlog As Long) As Long Declare Function accept Lib "wsock32.dll" (s As Long,ByRef addr As sockaddr,ByRef addrlen As Long) As Long Dim wsaData As WSADATA WSAStartup(MAKELONG(2,0),wsaData) Print "WSAStartup--->"+Date$()+" "+Time$() Dim s As DWord s=socket(AF_INET,SOCK_STREAM,0) If s=0 Then Print "Error-------->Cannot Socket Create" Sleep(-1) End If Dim sar As SOCKADDR With sar .sa_family=AF_INET End With If bind(s,sar,Len(sar))<>0 Then Print "Error-------->BIND ERROR" Sleep(-1) End If Dim sarlen As Long Dim news As DWord listen(s,128) news=accept(s,sar,sarlen) Dim buf[256] As Byte recv(news,buf,256,0) send(news,"HELLO",lstrlen("HELLO"),0) closesocket(s) closesocket(news) Print "SENDED" Sleep(-1) ----------------------------------------------------------------- 【受信用(途中まで)】 #console #include <api_winsock2.sbp> Declare Function bind Lib "wsock32.dll" (s As Long,ByRef sName As sockaddr,namelen As Long) As Long Declare Function listen Lib "wsock32.dll" (s As Long,backlog As Long) As Long Declare Function accept Lib "wsock32.dll" (s As Long,ByRef addr As sockaddr,ByRef addrlen As Long) As Long Dim wsaData As WSADATA WSAStartup(MAKELONG(2,0),wsaData) Print "WSAStartup--->"+Date$()+" "+Time$() Dim s As DWord s=socket(AF_INET,SOCK_STREAM,0) If s=0 Then Print "Error-------->Cannot Socket Create" Sleep(-1) End If Dim sar As SOCKADDR With sar .sa_family=AF_INET End With If bind(s,sar,Len(sar))<>0 Then Print "Error-------->BIND ERROR" Sleep(-1) End If Dim sock_sin As SOCKADDR_IN With sock_sin .sin_family=AF_INET End With If connect(s,sock_sin,Len(sock_sin))<>0 Then Print "Error-------->connect ERROR" Sleep(-1) End If

  • BASIC言語でmciSendCommand関数を扱う時

    Active Basicでゲームを作っています。 BGMを流すときに、PlaySound関数で音を鳴らそうと思ったのですが、 これはwav形式しか鳴らせないと知り、mciSendCommand関数を勉強することにしました。 mciSendCommand関数で、BGM(今回はmid)を読み出そうと思ったのですが、 『リピート再生』が出来ません。 いろいろ探してみたのですが、理解できませんでした。 そこで、いろいろ実験したのですが、どうも思うように動いてくれません。 MainWndとMenuの二つのウインドウがあります。 グローバル変数に Dim bErr As Long Dim mop As MCI_OPEN_PARMS を定義してあります。 ↓書いたコード(Menuウインドウ) mop.lpstrElementName=".\BGM\bgm01.mid" bErr=mciSendCommand(0,MCI_OPEN,MCI_OPEN_ELEMENT,mop) If bErr Then MessageBox(hMainWnd,"BGMの読み込みに失敗しましたので、強制終了します。","Error",MB_OK or MB_ICONHAND) SendMessage(hMainWnd,WM_CLOSE,0,0) End If '再生 Dim mpp As MCI_PLAY_PARMS mpp.dwCallback=hMainWnd bErr=mciSendCommand(mop.wDeviceID,MCI_PLAY,MCI_NOTIFY,mpp) If bErr Then MessageBox(hMainWnd,"BGMの再生に失敗したので、強制終了します。","ERROR",MB_OK or MB_ICONHAND) SendMessage(hMainWnd,WM_CLOSE,0,0) End If SetWindowPos(hMainWnd,HWND_TOP,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW) SetTimer(hMainWnd,2,213000,0) ここで、1回目の再生処理を入れて、SetTimer関数で、曲の長さ分のタイマーをセットして、曲が終了したらもう一度再生しなおすという方法でしました。 (探したサイトには、『リピート機能は無い』と書いてあったので) ↓タイムアウト時の処理(MainWnd) If TimerID=2 Then Dim mpp As MCI_PLAY_PARMS mpp.dwCallback=hMainWnd mpp.dwFrom=0 bErr=mciSendCommand(mop.wDeviceID,MCI_PLAY,MCI_NOTIFY,mpp) If bErr Then MessageBox(hMainWnd,"BGMの再生に失敗したので、強制終了します。","ERROR",MB_OK or MB_ICONHAND) SendMessage(hMainWnd,WM_CLOSE,0,0) End If End If 初めて扱う部分なので、まだ良く分かっていません。 どなたか良いやり方をご存知の方がいらっしゃいましたらご教授下さい。 お願いします。

  • シリアル通信:オフライン時にうまく終了してくれません

    シリアルプリンタの制御をVB6で行っております。 以下のようなコードですが、うまく終了してくれません。 'グローバル 'プリンタの状態 Dim BUF as String '起動時 Private Sub Form_Load() MSComm1.PortOpen = True Text1.Text = "" Timer1.Enabled = True End Sub '終了 Private Sub Form_Unload(Cancel As Integer) Timer1.Enabled = False MSComm1.PortOpen = False End Sub 'タイマー Private Sub Timer1_Timer() Timer1.Enabled = False Call CheckPrint Timer1.Enabled = True End Sub Private Sub MSComm1_OnComm() Dim TimeOut As Long Dim sTime As Long Dim eTime As Long Select Case MSComm1.CommEvent '受信 Case comEvReceive TimeOut = 100 sTime = timeGetTime Do If (TimeOut - eTime) < 0 Then Exit Do End If eTime = (timeGetTime - sTime) Loop Until MSComm1.InBufferCount >= 82 BUF = MSComm1.Input End Select End Sub プリンタの状態チェック Private Sub CheckPrint() Dim sTime As Long Dim eTime As Long Dim TimeOut As Long Dim i As Integer Dim n As Integer BUF = "" 'プリンタの情報取得コマンド MSComm1.Output = "~HS" 'タイマ開始 TimeOut = 400 sTime = timeGetTime eTime = 0 Do DoEvents If BUF <> "" Then Exit Do End If eTime = (timeGetTime - sTime) Loop Until TimeOut - eTime < 0 If BUF <> "" Then ... .. 宜しくお願いします。

専門家に質問してみよう