Page 816 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ 通常モードに戻る ┃ INDEX ┃ ≪前へ │ 次へ≫ ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ ▼プロテクトの掛け方 keiko 03/1/27(月) 8:21 ┗Re:プロテクトの掛け方 ぴかる 03/1/27(月) 9:48 ┗Re:プロテクトの掛け方 keiko 03/1/27(月) 11:21 ┗Re:プロテクトの掛け方 ぴかる 03/1/27(月) 11:35 ┗Re:プロテクトの掛け方 BOTTA 03/1/27(月) 11:46 ┗Re:プロテクトの掛け方 keiko 03/2/21(金) 15:26 ┣Re:プロテクトの掛け方 こう 03/2/22(土) 12:35 ┃ ┗Re:プロテクトの掛け方 keiko 03/2/22(土) 13:22 ┃ ┗MACアドレスからシリアルNO こう 03/2/22(土) 14:16 ┃ ┗1端末のみ使用可能 keiko 03/2/22(土) 18:23 ┃ ┗Re:1端末のみ使用可能 よろずや 03/2/22(土) 22:34 ┃ ┗Re:1端末のみ使用可能 keiko 03/2/23(日) 10:45 ┃ ┗Re:1端末のみ使用可能 よろずや 03/2/23(日) 20:40 ┃ ┗Re:1端末のみ使用可能 keiko 03/2/24(月) 10:57 ┃ ┗Re:1端末のみ使用可能 こうちゃん 03/2/24(月) 12:54 ┃ ┗Re:1端末のみ使用可能 keiko 03/2/24(月) 19:29 ┃ ┣Re:1端末のみ使用可能 ごんぼほり 03/2/24(月) 19:45 ┃ ┃ ┗Re:1端末のみ使用可能 keiko 03/2/24(月) 20:32 ┃ ┗使い方のわからないDLLは使わないほうがいいかも・・ こうちゃん 03/2/24(月) 20:50 ┃ ┗WMI こう 03/2/25(火) 2:52 ┃ ┗Re:WMI keiko 03/2/25(火) 8:14 ┗Re:プロテクトの掛け方 JuJu 03/3/1(土) 18:32 ─────────────────────────────────────── ■題名 : プロテクトの掛け方 ■名前 : keiko ■日付 : 03/1/27(月) 8:21 -------------------------------------------------------------------------
Excelで作成したものを、例えばパスワードが無いと使用 出来なくさせるようなことは、どうすれば出来るの でしょうか? 一人だけなら良いのですけど・・・さまざまなユーザーさん が出てくると思います。 例えば、IDを入れないと使用出来なくさせれば、いいのかなと思い ますが、どうやれば良いか分かりません。 この方法で無くても良いのですが、なにか良い方法がありますでしょうか? 出来がよければベクターさんに投稿しようと思ったのですけど、プロテクト の掛け方がよく分からなくて困っていました。 ご存知の方、ご教授願います。 |
keikoさん、おはようございます。 そのファイルをオープンと同時にパスワード入力ユーザーフォームを表示させて、入力OKにて編集可としてみたらどうでしょう?。パスワードをTextBox1とした場合、下記のコードを入れると表示は"*"となります。マクロもパスワードでプロテクトをかけるのもお勧めします。的外れの事を言ってたら、ゴメンナサイです。 Private Sub TextBox1_Change() TextBox1.PasswordChar = "*" End Sub |
ぴかるさんへ その方法でも良いのですけど、その人が他の人に譲与した時に パスワードを教えれば動くことになります。 それでは、問題なのであくまでその人だけ使用させたいのですよ。 何か良い方法ありませんか? |
パスワードを使用しないということですか?。パスワードは暗証番号と同じで教えないのが普通と思います。やられたい事が、私には申し訳ありませんが全く分かりません。他の方からのお答えをお待ちして下さい。 |
keikoさん、ぴかるさん、こんにちは。 石鹸箱の http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=332;id= このツリーが参考になるのでは? 詳しくはJuJuさんに |
BOTTA さん ぴかるさん、こんにちは。 >石鹸箱の >http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=332;id= >このツリーが参考になるのでは? > >詳しくはJuJuさんに 試行錯誤を色々試してみましたが、シリアルナンバーを発行して 1台のみ動かす方法とは?がわかりません(泣) シリアルナンバーを一度入力して、それ以後はシリアルナンバーの 入力は行わないのと、その入力したシリアルナンバーは、使えない 方法とは、どうするのでしょうか? 分かる方ならどなたでも構いません。詳しくは、JuJuさんにとありましたが JuJuさんなにか良い方法などありますか? |
keiko さん、こんにちわ。 >試行錯誤を色々試してみましたが、シリアルナンバーを発行して >1台のみ動かす方法とは?がわかりません(泣) 「インストールした1台のみ実行させたい」んですよね。 そのPCがネットワーク環境を使用可能が前提ですが、 NICのMACアドレスを入手して、そのMACアドレスから シリアルNOを作成して、それを入力させる方法はいかがでしょう? NICを変更したりすると、シリアルの再発行が必要になりますが... また、企業ユーザなどで、IPアドレスやログインIDがユニークなので あれば、それからシリアルを作成する案もあるかなと思います。 #全然VBAの回答になっていない(汗) |
こうさん,こんにちわ。 こうさんの言いましたOSを変更した時、シリアル番号をその都度発行 する方法でも構いません。 具体的にどのように行えばよろしいのでしょうか? 私は、まだ未熟なもので言葉だけの説明ではいまいちわからないのです。 もし、よろしければExcelでシリアル番号を入力して使用する方法を 教えて頂けないでしょうか? |
>こうさんの言いましたOSを変更した時、シリアル番号をその都度発行 >する方法でも構いません。 OSではなくNIC(Network Interface Card:俗に言うLANカード,LANボード)です。 NICにはMACアドレスという全世界で1つの固有な値があります。 具体的には、Win2000の場合は、コマンドプロンプトで「ipconfig /all」を 実行したときの「Physical Address」(00-99-AA-77-BB-CCなどのコード)です。 >具体的にどのように行えばよろしいのでしょうか? 実はVBAで作ったことがないので、コードを記載することができませんが、 検索サイトでキーワード「MACアドレスを取得」で検索すると見つかります。 で、シリアルの作成方法ですが、予め実行するPCのMACアドレスを取得して おき、VBAの実行開始時に実行PCのMACアドレスを入手し一致しているかの 確認を行えば、そのPC(正確にはMACアドレス)でしか実行できなくすること が可能になります。 当然VBAの修正が入りますので、使用可能PCが多くなるとその分メンテナンス が大変になります。 #あれれ、シリアルの入力云々の回答ではなくなってきました... >もし、よろしければExcelでシリアル番号を入力して使用する方法を >教えて頂けないでしょうか? このスレッドを読み直してみたんですが、keikoさんの要件は、 (1)ExcelVBAを開発した。ベクターに登録したい。 (2)指定した人のみ(ライセンス取得を行った人?)が使用できるようにしたい。 (3)他の人に譲与した時にパスワードを教えれば動くことになります。 ということですよね。 (3)については、不正コピーやシリアルの漏洩などという法律違反にあたる行為 で、ほとんどのシェアウェア作家さんやメーカーさんが悩んでいる問題であり、 現在のところ画期的な対策方法は無いと思います。 さらに全然回答になってません。ごめんなさい。(涙) |
1端末のみ使えるようにしたいのですけど、 難しいようですね。 どなたか分かる方いませんでしょうか? 宜しくお願いします |
▼keiko さん: >1端末のみ使えるようにしたいのですけど、 >難しいようですね。 >どなたか分かる方いませんでしょうか? >宜しくお願いします (1)インストール後最初の起動で、MACアドレスを暗号化したものを表示する。 (2)ユーザーは、表示されたものをkeiko さんに伝える。 (3)keiko さんは、それをさらに暗号化したものをIDとしてユーザーに伝える。 (4)ユーザーは、ID入力画面にIDを入力する。 (5)プログラムで、MACアドレスを暗号化したものをさらに暗号化したものとIDを 比較する。 暗号化ルーチンは何を使いましょうかね。 何か適当なものを独自に作るのがいいでしょうね。 |
よろずやさん,こんにちは。 MACアドレスのことを調べて みたのですけど、VBAでは 見つかりません。 もしよろしければ、詳しく教えて 欲しいのですが、よろしいでしょうか? 私が未熟なものですみません。 宜しくお願いします。 |
▼keiko さん: >よろずやさん,こんにちは。 >MACアドレスのことを調べて >みたのですけど、VBAでは >見つかりません。 > 検索サイトでキーワード「MACアドレスを取得」で検索すると見つかります。 と、こうさんが言ってますので「VB MACアドレスを取得」で検索してみました。 Googleで104件ヒット。 APIの使い方は、VBもVBAも同じです。 |
Private Sub CommandButton1_Click() Dim Obj As Integer Set Obj = CreateObject("Skyfull.Netwok") Dim MACAddress As String strMACAddress = Obj.MACAddress TextBox1.Text = Obj Set Obj = Nothing End Sub で、取得出来ないのですけど何か間違ってるのでしょうか? これが終わりましたら暗号化するのですよね? みなさんのアドバイスをお聞きして理解はしているのですが 実行するとなると難しいものですね(苦笑) |
keikoさん、こんにちは >Private Sub CommandButton1_Click() > Dim Obj As Integer > > Set Obj = CreateObject("Skyfull.Netwok") > > Dim MACAddress As String > > strMACAddress = Obj.MACAddress > TextBox1.Text = Obj > Set Obj = Nothing > >End Sub > >で、取得出来ないのですけど何か間違ってるのでしょうか? >これが終わりましたら暗号化するのですよね? >みなさんのアドバイスをお聞きして理解はしているのですが >実行するとなると難しいものですね(苦笑) SCNetwork.dllを使うということでいいですか? (私は使ったことがありませんので、該当するであろうものを探して試験してみました。) 最初にdllを参照設定します。 VBEの「ツール」「参照設定」で「参照ボタン」をクリックしてSCNetwork.dllを指定します。 ここまではできていますよね? んで、こんな感じでモジュール作ったらMACアドレス表示できましたよ。 Private Sub CommandButton1_Click() 'IntでなくObj型で宣言します。 Dim Obj As Object Dim MACAddress As String 'rが抜けていますね。正確に書きましょう。 Set Obj = CreateObject("Skyfull.Network") MACAddress = Obj.MACAddress MsgBox MACAddress Set Obj = Nothing End Sub #Skyfull.Network今回初めてみたので、詳細はわかりません。^^; 本件のような書き込みする場合は、元ねた(今回はSkyfull.Networkの入手先や使い方)を詳細に書かないと、回答しようがありませんよ^^; |
余計な投稿は削除しました。見ていた方すみません MACアドレスの取得に成功しました(喜) で、また問題が発生しました。 This Workbookから Private Sub Workbook_Open() Dim Obj As Object Dim MACAddress As String Set Obj = CreateObject("Skyfull.Network") MACAddress = Obj.MACAddress If MACAddress = "使用するPCのMACアドレス" Then Else End End If Set Obj = Nothing End Sub を書きまして、他のパソコンに移動してみました。 ところが[ActiveXコンポーネントが見つかりません]とエラーです。 そのパソコンには、dllが無いからなんですね。 それを回避するには、フォルダを作成してその中にdllを入れておく と考えたのですが、コードでdllを指定しないといけません。 同じフォルダにあるのでAppPathなんかで命令すると思うのですが dllを参照するコードはどのように書けばよいのでしょうか? |
コマンドで ipconfig /all とか net config workstation とかをつかって 情報をテキストファイルにはき出させて処理するのも 一つの方法のような気がします。 ipconfigとかnetコマンドって OSバージョンでちがいましたっけ? ちょっとこの辺わかりませんけど。 |
やっぱり、dllは使わないほうが無難ですか? 使わないでMACアドレスを取得なんて出来るのでしょうか? VBでならあるのですが・・・VBAとなると上手く動かない ようです。 dllを使用しないでMACアドレス取得出来る方教えてください。 お願い致します。 |
keikoさん、こんばんは >ところが[ActiveXコンポーネントが見つかりません]とエラーです。 >そのパソコンには、dllが無いからなんですね。 >それを回避するには、フォルダを作成してその中にdllを入れておく >と考えたのですが、コードでdllを指定しないといけません。 >同じフォルダにあるのでAppPathなんかで命令すると思うのですが >dllを参照するコードはどのように書けばよいのでしょうか? Skyfull.Networkではファンクションは公開していないようです。(私が見つけられなかっただけかもしれませんが) 折角MACアドレスを取得できるところまでいったところですが、APIのほうが早そうですね。 こちらを参照してください。 http://www.remus.dti.ne.jp/~shenron/access/knowhow/MacAddress.html といっても、どう使うかわからないかもしれませんので、上記リンクから抜粋しちゃいますと・・(いいのかな?) すべて標準モジュールに書いて、一番下のtest()を実行してみてください。 Option Explicit Private Declare Function Netbios Lib "netapi32.dll" _ (pncb As NET_CONTROL_BLOCK) As Byte Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ (hpvDest As Any, _ ByVal hpvSource As Long, _ ByVal cbCopy As Long) Private Declare Function GetProcessHeap Lib "kernel32" () As Long Private Declare Function HeapAlloc Lib "kernel32" _ (ByVal hHeap As Long, ByVal dwFlags As Long, _ ByVal dwBytes As Long) As Long Private Declare Function HeapFree Lib "kernel32" _ (ByVal hHeap As Long, _ ByVal dwFlags As Long, _ lpMem As Any) As Long Private Const NCBASTAT As Long = &H33 Private Const NCBNAMSZ As Long = 16 Private Const HEAP_ZERO_MEMORY As Long = &H8 Private Const HEAP_GENERATE_EXCEPTIONS As Long = &H4 Private Const NCBRESET As Long = &H32 Private Type NET_CONTROL_BLOCK 'NCB ncb_command As Byte ncb_retcode As Byte ncb_lsn As Byte ncb_num As Byte ncb_buffer As Long ncb_length As Integer ncb_callname As String * NCBNAMSZ ncb_name As String * NCBNAMSZ ncb_rto As Byte ncb_sto As Byte ncb_post As Long ncb_lana_num As Byte ncb_cmd_cplt As Byte ncb_reserve(9) As Byte ncb_event As Long End Type Private Type ADAPTER_STATUS adapter_address(5) As Byte rev_major As Byte reserved0 As Byte adapter_type As Byte rev_minor As Byte duration As Integer frmr_recv As Integer frmr_xmit As Integer iframe_recv_err As Integer xmit_aborts As Integer xmit_success As Long recv_success As Long iframe_xmit_err As Integer recv_buff_unavail As Integer t1_timeouts As Integer ti_timeouts As Integer Reserved1 As Long free_ncbs As Integer max_cfg_ncbs As Integer max_ncbs As Integer xmit_buf_unavail As Integer max_dgram_size As Integer pending_sess As Integer max_cfg_sess As Integer max_sess As Integer max_sess_pkt_size As Integer name_count As Integer End Type Private Type NAME_BUFFER name As String * NCBNAMSZ name_num As Integer name_flags As Integer End Type Private Type ASTAT adapt As ADAPTER_STATUS NameBuff(30) As NAME_BUFFER End Type Public Function GetMACAddress(Optional ByRef BoolError As Boolean) As String Dim tmpMacAddress As String Dim pASTAT As Long Dim NCB As NET_CONTROL_BLOCK Dim AST As ASTAT Dim ASTLength As Long BoolError = False ASTLength = Len(AST) NCB.ncb_command = NCBRESET Call Netbios(NCB) NCB.ncb_callname = "*" & Space(15) NCB.ncb_command = NCBASTAT NCB.ncb_lana_num = 0 NCB.ncb_length = ASTLength pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS _ Or HEAP_ZERO_MEMORY, NCB.ncb_length) If pASTAT = 0 Then BoolError = False Else NCB.ncb_buffer = pASTAT Call Netbios(NCB) CopyMemory AST, NCB.ncb_buffer, ASTLength tmpMacAddress = Format$(Hex(AST.adapt.adapter_address(0)), "00") & "-" & _ Format$(Hex(AST.adapt.adapter_address(1)), "00") & "-" & _ Format$(Hex(AST.adapt.adapter_address(2)), "00") & "-" & _ Format$(Hex(AST.adapt.adapter_address(3)), "00") & "-" & _ Format$(Hex(AST.adapt.adapter_address(4)), "00") & "-" & _ Format$(Hex(AST.adapt.adapter_address(5)), "00") HeapFree GetProcessHeap(), 0, pASTAT GetMACAddress = tmpMacAddress BoolError = True End If End Function Sub test() MsgBox GetMACAddress End Sub |
#Skyfull.Networkってwww.sky-com.co.jpさんのの無料コントロールなんですね。 #これはこれでお手軽でよいかも... #ただ、配布となると面倒ですね。 MACアドレスの件(シリアルとは関係ないんですが)興味があったので 色々調べてみました。 >折角MACアドレスを取得できるところまでいったところですが、APIのほうが早そうですね。 >こちらを参照してください。 >http://www.remus.dti.ne.jp/~shenron/access/knowhow/MacAddress.html 先を越されました(笑) Excel97だと00-00-00-・・・・と表示されます その1 Microsoft.com にもありました(VCですが) [SDK32] イーサネット アダプタのMACアドレスを取得する (118623) //search.microsoft.com/default.asp?qu=MAC%83A%83h%83%8C%83X%82%CC%8E%E6 %93%BE&boolean=ALL&nq=NEW&so=RECCNT&ig=01&ig=02&ig=03&ig=04 &ig=05&ig=06&ig=07&ig=08&ig=09&ig=10&ig=11&ig=12&i=00&i=01& i=02&i=03&i=04&i=05&i=06&i=07&i=08&i=09&i=10&i=11&siteid=japan (途中で改行を入れたので、URLとして使用するときは文字列をくっつけてください) その2 WMI(Windows Management Instrumentation)を使用する 「WMI Fun !!」//homepage2.nifty.com/tcubic/ さんの - NICの情報を取得する -//homepage2.nifty.com/tcubic/wmifun/win32_networkadapterconfiguration.html をちょっと改造して、 Sub GetMacAddr() Dim NicSet As SWbemObjectSet Dim Nic As SWbemObject Dim Locator As SWbemLocator Dim Service As Object Set Locator = New WbemScripting.SWbemLocator Set Service = Locator.ConnectServer Set NicSet = Service.ExecQuery("Select * From Win32_NetworkAdapterConfiguration") For Each Nic In NicSet If Nic.IPEnabled = True Then MsgBox Nic.MACAddress End If Next Set NicSet = Nothing Set Nic = Nothing Set Locator = Nothing Set Service = Nothing End Sub 'NICが複数刺さっている場合も数分表示されます。 Win2000+Excel2000(SR1) WinXP +Excel97(SR1) で確認済み。 |
アドバイスしてくださったみなさん! お蔭様で上手くいきました。 有り難う御座いました。 |
こんにちはぁ >JuJuさんなにか良い方法などありますか? あらら、名前が出てた(笑) MACアドレスを抜く方法が出ていたので、私はボリュームシリアルで^^; こんな感じで使ってね a = GetVolumeSerialNumber(Application.LibraryPath) ---- 8< ---- 8= ---- 8< ---- 8= ---- 8< ---- 8= ---- 8< ---- 8= ---- Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long Private Function GetVolumeSerialNumber(ByVal strPathName As String) As Long Dim lngSerialNumber As Long Dim lngFileNameLength As Long Dim lngFlags As Long '' ドライブ名の抜き出し If InStr(strPathName, "\") > 0 Then strPathName = Left$(strPathName, InStr(strPathName, "\")) ElseIf Len(strPathName) > 0 Then strPathName = strPathName & "\" End If '' ボリューム情報の取得 If GetVolumeInformation(strPathName, vbNullString, 0&, lngSerialNumber, lngFileNameLength, lngFlags, vbNullString, 0&) <> 0& Then ' 取得成功 Else ' 取得失敗 lngSerialNumber = 0 End If GetVolumeSerialNumber = lngSerialNumber End Function |