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

このQ&Aのポイント
  • ActiveBasic 4.23.00を使用して、リソースの追加方法について教授していただきましたが、文字列以外のファイル(例:zipファイル)を追加する方法を知りたいです。
  • また、プログラムBにリソースを追加した際に、プログラムBのアイコンが消えてしまいます。この問題を回避する方法を教えていただきたいです。
  • さらに、プログラムBから追加したリソースを読み込むプログラムを実行する際にエラーが発生し、回避方法を知りたいです。
回答を見る
  • ベストアンサー

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に書きました。 実行すると、読み出しの部分でエラーが生じるのですが、どのように回避していけばよろしいのでしょうか。 長々と多くの質問をしてしまいすみません。 しかし、全然解決できずにもやもやしていて困っています。 何かやり方をご存知の方がいらっしゃいましたらご教授をお願いします。

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

  • ベストアンサー
回答No.4

 こんばんは。補足頂きました。  う~ん、此れは厳しいですなあ・・・。  取りあえず、実験台のプロジェクトを作成して、exeと取り込みたいファイルをプロジェクトのフォルダに置いた後、フォームにボタンを2つ用意して、以下を試してみては如何でしょう。 '----------------------------------------------------------------------------- ' イベント プロシージャ '----------------------------------------------------------------------------- ' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。 ' ウィンドウ ハンドル: hMainWnd ' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。 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 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_NAMEID=1000 'ファイルサイズ Const RT_SIZEID=2000 'ファイル内容 Const RT_FILEID=3000 '書き込ませたいexe又はdllの名前 Dim szModuleName[MAX_PATH + 1] As TCHAR '取り込まれるファイルの名前 Dim szResourceName[MAX_PATH + 1] As TCHAR '----------------------------------------------------------------------------- ' ウィンドウメッセージを処理するためのコールバック関数 Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As LRESULT ' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。 ' イベントプロシージャの呼び出しを行います。 MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam) End Function '----------------------------------------------------------------------------- ' ここから下は、イベントプロシージャを記述するための領域になります。 Sub MainWnd_Destroy() test_DestroyObjects() PostQuitMessage(0) End Sub Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT) Dim pszModName As LPTSTR Dim pszResName As LPTSTR pszModName = "xxx.exe" pszResName = "mybitmap.bmp" memcpy(szModuleName, pszModName, lstrlen(pszModName)) memcpy(szResourceName, pszResName, lstrlen(pszResName)) End Sub 'ボタン1でExe又はDllにファイルを取り込み Sub MainWnd_CommandButton1_Click() Dim hUpdate As HANDLE Dim hFile As HANDLE Dim dwSize As DWORD Dim pBuffer As LPVOID Dim dummy As DWORD Dim fDiscard As BOOL hUpdate = BeginUpdateResource(szModuleName, FALSE) If hUpdate = NULL Then MessageBox(hMainWnd,"アップデート対象を開く事に失敗!","Error",MB_OK or MB_ICONHAND) Exit Sub End If hFile = CreateFile(szResourceName, GENERIC_READ, 0, ByVal 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0) If hFile=INVALID_HANDLE_VALUE Then MessageBox(hMainWnd, szResourceName, 0, 0) MessageBox(hMainWnd,"ファイルハンドルの作成に失敗しました!","Error",MB_OK or MB_ICONHAND) Exit Sub End If dwSize = GetFileSize(hFile, NULL) pBuffer = malloc(dwSize) ReadFile(hFile, pBuffer, dwSize, VarPtr(dummy), ByVal 0) fDiscard = UpdateResource(hUpdate, RT_MANIFEST, MAKEINTRESOURCE(RT_NAMEID), 1041, szResourceName, lstrlen(szResourceName)) If fDiscard = FALSE Then MessageBox(hMainWnd,"ファイル名書き込み中にトラブル発生!","Error",MB_OK or MB_ICONHAND) goto *Error End If fDiscard = UpdateResource(hUpdate, RT_MANIFEST, MAKEINTRESOURCE(RT_SIZEID), 1041, VarPtr(dwSize), 4) If fDiscard = FALSE Then MessageBox(hMainWnd,"ファイルサイズ書き込み中にトラブル発生!","Error",MB_OK or MB_ICONHAND) goto *Error End If fDiscard = UpdateResource(hUpdate, RT_MANIFEST, MAKEINTRESOURCE(RT_FILEID), 1041, pBuffer, dwSize) If fDiscard = FALSE Then MessageBox(hMainWnd,"ファイルを書き込み中にトラブル発生!","Error",MB_OK or MB_ICONHAND) goto *Error End If *Error free(pBuffer) EndUpdateResource(hUpdate, fDiscard xor TRUE) CloseHandle(hFile) End Sub 'ボタン2でExe又はDllに取り込まれたファイルを外に書く Sub MainWnd_CommandButton2_Click() Dim hFile As HANDLE Dim hUpdate As HINSTANCE Dim hResource As HRSRC Dim hGlobal As HGLOBAL Dim pszName As LPTSTR Dim dwSize As DWORD Dim dummy As DWORD Dim pBuffer As LPVOID Dim sizeOfRes As DWORD hUpdate = LoadLibrary(szModuleName) If hUpdate = NULL Then MessageBox(hMainWnd,"読み取り対象を開く事に失敗!","Error",MB_OK or MB_ICONHAND) Exit Sub End If '---------------------------------------------------------------------------------- 'Exe又はDllから取り込まれたファイルの文字を取り出す ↓ '---------------------------------------------------------------------------------- hResource = FindResource(hUpdate, MAKEINTRESOURCE(RT_NAMEID), RT_MANIFEST) sizeOfRes = SizeofResource(hUpdate, hResource) if hResource = NULL Or sizeOfRes = 0 Then MessageBox(hMainWnd,"ファイル名読み込み中にトラブル発生!","Error",MB_OK or MB_ICONHAND) goto *Error End If hGlobal = LoadResource(hUpdate, hResource) pszName = malloc(sizeOfRes + 1) memcpy(pszName, LockResource(hGlobal), sizeOfRes) pszName[sizeOfRes] = 0 '---------------------------------------------------------------------------------- 'Exe又はDllから取り込まれたファイルの文字を取り出す ↑ '---------------------------------------------------------------------------------- '---------------------------------------------------------------------------------- 'Exe又はDllから取り込まれたファイルのサイズを取り出す ↓ '---------------------------------------------------------------------------------- hResource = FindResource(hUpdate, MAKEINTRESOURCE(RT_SIZEID), RT_MANIFEST) sizeOfRes = SizeofResource(hUpdate, hResource) if hResource = NULL Or sizeOfRes = 0 Then MessageBox(hMainWnd,"ファイルサイズ読み込み中にトラブル発生!","Error",MB_OK or MB_ICONHAND) goto *Error End If hGlobal = LoadResource(hUpdate, hResource) memcpy(VarPtr(dwSize), LockResource(hGlobal), sizeOfRes) '---------------------------------------------------------------------------------- 'Exe又はDllから取り込まれたファイルのサイズを取り出す ↑ '---------------------------------------------------------------------------------- '---------------------------------------------------------------------------------- 'Exe又はDllから取り込まれたファイルを取り出す ↓ '---------------------------------------------------------------------------------- hResource = FindResource(hUpdate, MAKEINTRESOURCE(RT_FILEID), RT_MANIFEST) sizeOfRes = SizeofResource(hUpdate, hResource) if hResource = NULL Or sizeOfRes = 0 Then MessageBox(hMainWnd,"ファイル読み込み中にトラブル発生!","Error",MB_OK or MB_ICONHAND) goto *Error End If hFile = CreateFile(pszName, GENERIC_WRITE, 0, ByVal 0, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, 0) If hFile=INVALID_HANDLE_VALUE Then MessageBox(hMainWnd, pszName, 0, 0) MessageBox(hMainWnd,"ファイルハンドルの作成に失敗しました!","Error",MB_OK or MB_ICONHAND) Exit Sub End If hGlobal = LoadResource(hUpdate, hResource) WriteFile(hFile, LockResource(hGlobal), dwSize, VarPtr(dummy), ByVal 0) CloseHandle(hFile) '---------------------------------------------------------------------------------- 'Exe又はDllから取り込まれたファイルを取り出す ↑ '---------------------------------------------------------------------------------- *Error free(pszName) FreeLibrary(hUpdate) End Sub

if-so-at
質問者

お礼

遅くなってすみません。 出来ました! 此処までのお付き合い、ありがとうございました!!

その他の回答 (3)

回答No.3

 こんばんは。補足頂きました。 #define RT_MANIFEST 24 で上手くいかなければ、 #define RT_MANIFEST MAKEINTRESOURCE(24)  其の他、めぼしい物を載せておきます。 #define RT_CURSOR MAKEINTRESOURCE(1) #define RT_BITMAP MAKEINTRESOURCE(2) #define RT_ICON MAKEINTRESOURCE(3) #define RT_MENU MAKEINTRESOURCE(4) #define RT_DIALOG MAKEINTRESOURCE(5) #define RT_STRING MAKEINTRESOURCE(6) #define RT_FONTDIR MAKEINTRESOURCE(7) #define RT_FONT MAKEINTRESOURCE(8) #define RT_ACCELERATOR MAKEINTRESOURCE(9) #define RT_RCDATA MAKEINTRESOURCE(10) #define RT_MESSAGETABLE MAKEINTRESOURCE(11) #define DIFFERENCE 11 #define RT_GROUP_CURSOR MAKEINTRESOURCE((ULONG_PTR)RT_CURSOR + DIFFERENCE) #define RT_GROUP_ICON MAKEINTRESOURCE((ULONG_PTR)RT_ICON + DIFFERENCE) #define RT_VERSION MAKEINTRESOURCE(16) #define RT_DLGINCLUDE MAKEINTRESOURCE(17) #define RT_PLUGPLAY MAKEINTRESOURCE(19) #define RT_VXD MAKEINTRESOURCE(20) #define RT_ANICURSOR MAKEINTRESOURCE(21) #define RT_ANIICON MAKEINTRESOURCE(22) #define RT_HTML MAKEINTRESOURCE(23)

if-so-at
質問者

お礼

遅くなりました。 回答ありがとうございます。 何とか追加には成功しました。 しかし、追加したりソースを書き出そうと思ったのですが、思うように動きません。 1:テキストファイルの場合 ファイルは出力されるが、中身は0KB 2:その他のファイル 読み込めない(INVALID_HANDLE_VALUEが返る) 問題のコードは、補足の方に書かせていただきます すみませんが、もう少しお付き合いいただけないでしょうか

if-so-at
質問者

補足

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=1 Const RT_MANIFEST="BINTYPE" Const RT_MANIFESTSIZEID=2 Const RT_MANIFESTSIZE="FILESIZE" Const RT_MANIFESTFILEID=3 Const RT_MANIFESTFILE="FILENAME" Dim FileName[MAX_PATH] As Byte Dim hDLL As DWord, hResource As DWord, lResource As DWord Dim hSize As DWord,fSize As DWord,hName As DWord,fName As DWord Dim FileSize As Long,Name As BytePtr Dim File As BytePtr GetModuleFileName(NULL,FileName,MAX_PATH) hDLL=LoadLibrary(FileName) If hDLL=0 Then MessageBox(hMainWnd,"hDLLエラー",0,0) Exit Sub EndIf hResource=FindResource(hDLL,RT_MANIFESTID,RT_MANIFEST) If hResource=0 Then FreeLibrary(hDLL) MessageBox(hMainWnd,"追加エラー",0,0) Exit Sub EndIf hSize=FindResource(hDLL,RT_MANIFESTSIZEID,RT_MANIFESTSIZE) hName=FindResource(hDLL,RT_MANIFESTFILEID,RT_MANIFESTFILE) lResource=LoadResource(hDLL,hResource) fSize=LoadResource(hDLL,hSize) fName=LoadResource(hDLL,hName) FileSize=LockResource(fSize) Name=LockResource(fName) File=LockResource(lResource) FreeResource(lResource) FreeResource(fSize) FreeResource(fName) FreeLibrary(hDLL) 'ファイルを作成する Dim path[MAX_PATH] As Byte Dim pathstr As String Dim hFile As DWord Dim dummy As DWord Dim NameStr As String GetCurrentDirectory(MAX_PATH,path) pathstr=path NameStr=Name hFile=CreateFile(pathstr+"\"+NameStr,GENERIC_WRITE,0,ByVal 0,CREATE_NEW,FILE_ATTRIBUTE_NORMAL,0) If hFile=INVALID_HANDLE_VALUE Then MessageBox(hMainWnd,pathstr+"\"+NameStr,0,0) MessageBox(hMainWnd,"ファイルの読み込みに失敗しました!","Error",MB_OK or MB_ICONHAND) Exit Sub End If WriteFile(hFile,File,FileSize,VarPtr(dummy),ByVal 0) MessageBox(0,File,0,0) MessageBox(0,NameStr,0,0) MessageBox(0,Str$(FileSize),0,0) CloseHandle(hFile)

回答No.2

 こんにちは。補足頂きました。  以下に書かれている様に、  UpdateResource()  http://msdn.microsoft.com/ja-jp/library/cc364849.aspx  記録したいリソースの種類によって、RT_???のフラグを使い分けなければいけないのでは。  zipやmid(midiファイル)等は文字列でも、アイコンでもないので、アプリケーション定義データ(自由データ)として、RT_RCDATAフラグで記録するのではないでしょうか。  'プログラムBで、ファイルなどを追加をする時  UpdateResource(IsUpdate, RT_RCDATA, MAKEINTRESOURCE(xxx), MAKELANGID(LANG_JAPANESE, SUBLANG_SYS_DEFAULT), temp, Len(temp))

if-so-at
質問者

お礼

ご回答ありがとうございます。 早速試してみたのですが、 『RT_MANIFEST 無効な識別子』と表示されます。 ActiveBasicには定義されていないようなので、定義の値を探してみましたが見つかりません。 どう表記していけばいいのでしょうか。 すみませんが、知識をお貸しいただけないでしょうか。

回答No.1

 こんにちは。リソースを持っているプログラムBの方ですが、  BeginUpdateResource()  http://msdn.microsoft.com/ja-jp/library/cc410614.aspx  EndUpdateResource()  http://msdn.microsoft.com/ja-jp/library/cc410830.aspx  上記のAPIリファレンスを見る所、  追加したい場合は、  BeginUpdateResource(pszFileName, FALSE)  として、  変更をセーブしたい時は、  EndUpdateResource(hUpdate, FALSE)  とするのではないでしょうか。  と言う事は、  以下が犯人で(此れだと以前書いて来たリソースが消されてしまう)、 IsUpdate=BeginUpdateResource(buf1, TRUE)'FileName はターゲットファイルのフルパス。Ex:"C:\test.exe" にリソースを埋め込む場合、FileName="C:\test.exe"  以下で追記ではないでしょうか。 IsUpdate=BeginUpdateResource(buf1, FALSE)'FileName はターゲットファイルのフルパス。Ex:"C:\test.exe" にリソースを埋め込む場合、FileName="C:\test.exe"

if-so-at
質問者

お礼

ご回答ありがとうございます。 文字列の追加と読み出しは出来ました。 しかし、最終的には、ファイル/フォルダの書き込みと読み出しを行おうと思っています。 ファイルなどの追加/読み出しはどのような関数を使用すればいいのでしょうか。 よろしければご教授の方をお願いします。

関連するQ&A

  • 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でいつもエラーが返ってきます。 何故かが分かりません。 すみませんが、ご存知の方がいらっしゃいましたら、ご教授の方をお願いします。

  • 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回ループした後、フリーズしてしまいます。 すみませんが、何故そうなるかが分かる方がいらっしゃいましたら、すみませんが、ご教授ください。 お願いします。

  • 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

  • activebasicについて

    activebasicの中級者のものです。 ActivebasicにてWindowsPCのログイン中のユーザー名というのは取得できるのでしょうか。 Activebasicのヘルプを見て、サンプルコードをコピー、コンパイルしたものの、エラーが大量発生し、、、、。 ということでお願いします_(._.)_ 【サンプルコード】 http://www.activebasic.com/help_center/Pages/API/SystemService/SystemInformation/GetUserName.htm Declare Function GetUserName Lib "kernel32" Alias "GetUserNameA" _ (lpBuffer As BytePtr, _ ByRef nSize As Long) As Long lpBuffer 【ページ内の解説の意味もさっぱり分かりません(´;ω;`)】 Win32API: GetUserName ユーザー名を取得します。 定義 Declare Function GetUserName Lib "kernel32" Alias "GetUserNameA" _ (lpBuffer As BytePtr, _ ByRef nSize As Long) As Long lpBuffer 文字列バッファへのポインタを指定します。このバッファにユーザー名が格納されます。 nSize (ポインタ参照) lpBuffer パラメータで指定したバッファのバイト数が格納されている、32ビット整数型変数へのポインタを指定します。 関数が成功すると、取得したユーザー名のバイト数が格納されます。 戻り値 関数が成功すると、TRUE が返ります。失敗すると、FALSE が返ります。 環境情報 インクルード ファイル: api_system.sbp 内で定義済み DLLファイル: advapi32.dll よろしくお願いいたします。

  • ExcelVBAでのkernel32(64bit)

    今までExcel2000のVBAから、以下のようなコードを使ってC++で作ったコマンドプロンプトで動くプログラムを動かすプログラムを作っていましたが、これを64bitのWindows7上で動いているExcel2010で使おうとしたらメッセージが出ました。いろいろ調べてみたところ、たぶんDeclareにPtrSafeを付ければ良いようなのですが、その際、他のコードはそのままで良いのでしょうか。特に、コード中のLongはそのままで良いのか気になるのですが...。ちなみに、下記コードの条件コンパイルはネットで調べて見よう見まねで付けたもので、Excel2000のときには付けていないものでした。ご存じの方がいらっしゃいましたらご教授ください。 '------------------------------------------------------------------------------ ' Win32 API関数・定数の宣言 '------------------------------------------------------------------------------ #If VBA7 And Win64 Then '64bit Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _   ByVal dwMilliseconds As Long) As Long Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _   ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long #Else '32bit Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _   ByVal dwMilliseconds As Long) As Long Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _   ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long #End If Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF Private Const INFINITE As Long = &HFFFF '------------------------------------------------------------------------------ ' Run '------------------------------------------------------------------------------ Public Sub Run(ByVal project_name As String)   Dim program As String   Dim task_id As Long   Dim h_proc As Variant   program = mdlFunc.ProgramPath() & mdlFunc.ProgramOption(project_name) 'プログラム名   task_id = Shell(program, vbHide)   h_proc = OpenProcess(PROCESS_ALL_ACCESS, False, task_id)   If OpenProcess(PROCESS_ALL_ACCESS, False, task_id) <> vbNull Then     Call WaitForSingleObject(h_proc, INFINITE)     CloseHandle h_proc   End If End Sub

  • VBAにおける Option Explicitの役割

    VBAにおける Option Explicitの役割 VBAでゲームを作ることを勉強している初心者です。 本に従ってもっとも基本的なスロットゲームをためしました。 プログラム本体の前にある下記のOption Explicitを省くとコンパイルエラーになります。 VBAにおける Option Explicitはプログラム本体中にあるどのキーがどのスロットを止めるなどの指示を 具体的記述なしに有効にするなどの役目があるのでしょうか。 Option Explicit Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Declare Function GetTickCount Lib "kernel32" () As Long 'Windows起動後経過時間取得API どなたか教えていただけると助かります。 よろしくお願いいたします。

  • 64ビットエクセルでのAPI宣言/PtrSafe

    エクセルのInputboxで、入力された文字列を自動的にアスタリスクで隠すようにする方法を探し http://okwave.jp/qa/q2371878.html の回答No1のコードがまさに最適なコードで、これまで非常に助かっていました。 ところが、64bitのエクセルでは動かないことがわかりました。 表示されたエラーメッセージの言葉から調べて、PtrSafeという言葉を入れなければならないようなのでAPI宣言を以下のようにしてみました。 #If VBA7 And Win64 Then '64ビット版 Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long #Else '32ビット版 Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long #End If ところが、回答No1のコードで Sub Report_Open() を実行すると Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _ Optional YPos, Optional HelpFile, Optional Context) As String のところがハイライトされてエラーになります。 どう直せば良いのでしょうか? 全文のコードを乗せると字数制限に引っかかりますので、申し訳ありませんが宣言以外の部分は http://okwave.jp/qa/q2371878.html の回答No1のコードを見てくださいますようお願いします。

  • DataReport(PrintReport)の同期(待ち)について教えてください

    只今、VB6のDataReportを使用して500ページほど 印刷したいのですが100ページほどしか印刷されません。 原因は印刷が完了する前にDataReportの解放を行っているためです。 DataReportの解放前に数秒プログラムを停止させる方法があるのですが できればPrintreportメソッドで出力が完了したかの判断を行いたいです。 それに近い質問があり以下のように実行したのですがうまくいきませんでした。 具体的な解決方法があればとてもありがたいです。 【プログラムロジック.vbs】 '起動プロセスのオープン(状態の取得準備) Public Declare Function OpenProcess Lib "KERNEL32" _ (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long '起動プロセスとのシンクロ(待機する) Public Declare Function WaitForSingleObject Lib "KERNEL32" _ (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long '起動プロセスのクローズ(終了) Public Declare Function CloseHandle Lib "KERNEL32" _ (ByVal hObject As Long) As Long '起動プロセスが実行中か調べる(状態の取得) Public Declare Function GetExitCodeProcess Lib "KERNEL32" _ (ByVal hProcess As Long, lpExitCode As Long) As Long Public Const SYNCHRONIZE = &H100000 Public Const INFINITE = &HFFFF 【プログラムロジック.frm】 Dim IDProcess As Long Dim hProcess As Long Dim ret As Long IDProcess = Control.PrintReport hProcess = OpenProcess(SYNCHRONIZE, 1, IDProcess) ret = WaitForSingleObject(hProcess, INFINITE) ret = CloseHandle(hProcess) 上記方法でテストしたのですが 「IDProcess」には「1」が返ります。 「hProcess」には「0」が返ります。 スプールにJOBがたまるまで「WaitForSingleObject」で WAITされると思ったのですがとくに待ちになりませんでした。 環境はWindowsXP、Windows2003サーバです。 よろしくお願いします。

  • GetProcessWorkingSetSizeでエラーが発生します

    VB6で画像処理アプリケーションの開発を行っている者です。 下記記述でワーキングセット領域を変更しようとしていますが、GetProcessWorkingSetSizeの部分でエラーが発生します。 使用PCにより、「問題が発生したため、Visual Basic を終了します。 ご不便をおかけして申し訳ありません。」や有無を言わさず開発環境が終了してしまう場合がありますが、いずれにしても原因が分かりません。 どなたかアドバイスいただけませんでしょうか? よろしくお願い致します。 (標準モジュールで宣言) Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long Declare Function GetProcessWorkingSetSize Lib "kernel32" (ByVal qq As Integer, ByVal pp As Integer, ByVal rr As Integer) As Long Declare Function SetProcessWorkingSetSize Lib "kernel32" (ByVal phph1 As Long, ByVal wkminwkmin1 As Long, ByVal wkmaxwkmax1 As Long) As Long Declare Function GetLastError Lib "kernel32.dll" () As Long (実行部) Sub WorkingSetChange() Dim id As Long 'アプリケーションプログラムのID用変数 Dim ph As Long 'アプリケーションプログラムのハンドル用変数 Dim wkmin As Long '最小ワーキングセット用変数 Dim wkmax As Long '最大ワーキングセット用変数 Dim bret As Long Const PROCESS_SET_QUOTA = &H100 Const PROCESS_QUERY_INFORMATION = &H400 'アプリケーションプログラムのIDを取得する id = GetCurrentProcessId() 'アプリケーションプログラムのハンドルをオープンする ph = OpenProcess(PROCESS_SET_QUOTA + PROCESS_QUERY_INFORMATION, False, id) 'アプリケーションプログラムの最大ワーキングセット値と最小ワーキングセット値を取得 bret = GetProcessWorkingSetSize(ph, wkmin, wkmax) '最小ワーキングセット値を1MBに設定 wkmin = 1 * 1024 * 1024 '最大ワーキングセット値を3MBに設定 wkmax = 3 * 1024 * 1024 'アプリケーションプログラムの最大ワーキングセット値と最小ワーキングセット値を変更 bret = SetProcessWorkingSetSize(ph, wkmin, wkmax) 'アプリケーションプログラムのハンドルをクローズする bret = CloseHandle(ph) End Sub

  • VB6 二重起動確実防止について

    VB6 SP5にて2重起動確実な防止処理をいれようと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 ************************************************

専門家に質問してみよう