• 締切済み

activebasicについて

ayumi9821の回答

  • ayumi9821
  • ベストアンサー率30% (51/165)
回答No.1

ActiveBasicというとN88互換と思っていましたがかなり進化したようですね。私が開いたときにはそのリンクが切れていたので原因が分かりませんが、バージョン違いのコードと言うことはありませんか。1と2と3の間では全くといって良いほど互換性はなく、4と5もかなり異なっているように感じます。手直しが必要かも知れません。

関連するQ&A

  • エクセル VBAでコンピューター名を所得・・・

    いつも皆様には大変お世話になっております。 今回の質問は コンピューター名を所得する方法についてなのですが、 Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" _ (ByVal lpBuffer As String, nSize As Long) As Long Public Sub コンピュータ名() Dim nBuffer As String * 16 Call GetComputerName(nBuffer, Len(nBuffer)) MsgBox Left(nBuffer, InStr(nBuffer, vbNullChar) - 1) End Sub 通常時はこれで動くのですが、 やりたいのが ボタン→ユーザーフォームコマンドボタンの流れで作りたいのです。 Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" _ (ByVal lpBuffer As String, nSize As Long) As Long Private Sub CommandButton1_Click() Dim nBuffer As String * 16 Call GetComputerName(nBuffer, Len(nBuffer)) MsgBox Left(nBuffer, InStr(nBuffer, vbNullChar) - 1) End Sub と作ると、上の2行で止まってしまいます。 多分上の2行をどこか別のところに書けばいいのかな?と思うのですが、どこに書いてもエラー出まくりです。 どなたか私に愛の手をお願い致します。

  • 強制終了・フリーズしてしまう

    新規にエクセルを立ち上げて 標準モジュールに Option Explicit Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" _ (ByVal lpBuffer As String, nSize As Long) As Integer Sub ahtGetComputerName() Dim str As String MsgBox GetComputerName(str, 16) End Sub を貼り付けて実行すると 2003だといきなりエクセルが閉じます。 「変更しますか?」も聞かれません。 2007だと画像の画面が出ます。 パソコン名を取得するコードだと思ってたのですがエクセルを強制的に閉じるコードなのでしょうか? 他のapiは使えます。

  • 現在ファイルを開いている全てのユーザー名を取得

    パソコン1に入っているアクセスファイル(accdb)に パソコン1とパソコン2で同時に開いています。 共有している状態です。 その際、現在ファイルを開いている全てのユーザー名を取得したいのですが http://okwave.jp/qa/q3589812.html を参考に ' // 標準モジュール Private Declare Function GetUserName Lib "ADVAPI32.dll" Alias "GetUserNameA" ( _     ByVal lpBuffer As String, _     ByRef nSize As Long _ ) As Long Private Const MAX_PATH As Long = 256 ' // Windows のログインユーザー名を取得する Public Function GetLoginUserName() As String   Dim sBuffer As String   sBuffer = String$(MAX_PATH, vbNullChar)   If CBool(GetUserName(sBuffer, MAX_PATH) > 0) Then     GetLoginUserName = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)   End If End Function Sub 使い方サンプル()   Dim sUserName As String      sUserName = GetLoginUserName()   MsgBox "USER: " & sUserName, vbInformation    End Sub を実行してみたのですが、それぞれ自分のユーザー名しか取得されません。 http://billyboy.blog81.fc2.com/blog-entry-157.html の Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _ (ByVal lpBuffer As String, _ nSize As Long) As Long Function GetLoginName() Dim strBuffer As String * 255, retValue As Long retValue = GetUserName(strBuffer, 255) GetLoginName = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1) End Function Sub sample() MsgBox GetLoginName() End Sub を実行しても同じです。 http://www.tsware.jp/tips/tips_013.htm も自分のユーザー名しか取得できません。 どれも標準モジュールに貼り付けました。 現在ファイルを開いているユーザー名を取得するにはどうすればいいでしょうか?

  • VB2008 iniファイルの全セクション取得方法

    こんばんわ。iniファイルの全セクションを取得したく、 以下のコードを使うことはわかったのですが、ここから先がVB初心者の為全く解かりません。ボタン1を押したらC:\Test.ini のファイルの全セクションを取得というコードはどのように記入すればよいのでしょうか。 どうぞ宜しくお願いいたします。 Declare Function GetPrivateProfileSectionNames Lib "Kernel32.dll" _ Alias "GetPrivateProfileSectionNamesA" _ (ByVal lpszReturnBuffer As String, ByVal nSize As Long, _ ByVal lpFileName As String) As Long

  • ユーザー名の取得で

    ユーザー名の取得がうまくいきません。 どなたか教えて下さい。 環境はVB.net 2003です。 '宣言部 Declare Ansi Function GetUserNameByDeclare Lib "advapi32.dll" _ Alias "GetUserNameA" (ByVal lpBuffer As String, ByRef nSize As Integer) As Integer 'ソース内   Const UNLEN As Integer = 256   Dim tusr As String   Dim ln As Integer   tusr = Space(UNLEN)   ln = Len(tusr)   GetUserNameByDeclare(tusr, ln)   strdir = "C:\Documents and Settings\" & tusr & "\My Documents" 上記、ユーザー名(tusr)は取得できるんですが、strdirのtusr以下の部分 "\My Documents" が削られてしまいます。 どこが悪いんでしょう? よろしくお願いします。

  • 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のコードを見てくださいますようお願いします。

  • 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 インターネットを通じてソフト間で通信する

    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

  • EXCELVBA フォルダ検索API

    エクセルからVBAでフォルダを選択させるコマンドを、APIを使ってフォルダ検索ダイアログボックスを出すまでは見よう見真似でできるのですが、このとき「あたらしいフォルダ」のボタンは必要ないので出したくないのですが、どこかに定数を指定すればよろしいかご存知でしたら教えてください。 (使用OS: Windows2000,Excel:2003) ちなみにコピペした宣言部分は以下のものです。 *************** Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _ (ByVal pidl As Long, ByVal pszPath As String) As Long Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _ (lpBrowseInfo As BROWSEINFO) As Long Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long) Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, lParam As Any) As Long Public Const WM_USER = &H400 Public Const BFFM_SETSELECTIONA = (WM_USER + 102) Public Const BFFM_INITIALIZED = 1 ********************

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