あさじゃけん さん 2005年 03月 28日 20時 15分 51秒

書き込み遅くなりました(汗
皆さんいろいろ意見をありがとうございます(^^

■むたぐち さんへ
> MVP認定を受けたのに、あまり仕事をしてなくて恐縮です。
いえいえ、とんでもないです。
「このサイトの存在=仕事してる」です(^^
全てに答える義務もないと思いますし、維持管理だけでも大変なものです。
これからもこの調子で(?w)頑張って下さいね!

■ちゃ さんへ
> Network越しのAccessということであれば、ADSIのIADsResource
> あたりを利用してやる手は使えませんでしょうか?
ActiveDirectoryを構築していないワークグループ環境なんです;
なのでADSIが使えませんです(><;
#せめてWindowsドメイン環境にしてほすぃ〜

■ばんのしゃーによかばんた さんへ
> それが、回避策なんかではなく、正しい解決方法だと思いますよ。
言われてみると、確かにそうですね(汗

でも私は、この場合のエラートラップするべき場所は「Lockする処理に対してのエラー処理」であって、「移動や削除のエラー処理」ではないと思っています。
あるべき姿を考えた場合、これから扱おうとしているフォルダ、ファイル、サブフォルダに対してLockするメソッドが実装されていれば、エラー処理的にはすっきりだったのではないかと思います。
まぁ、そうすると当然使いにくくなります(笑)
オブジェクト指向ならではかも知れませんが、コピー、削除、移動といった処理が、複数の処理を一つにまとめて簡潔に扱えるようにしたために、こうなったんだと思いますね(^^;
で。
理想はともかく、結局一つの処理になってるので、コピー、削除、移動でトラップするしかないわけですが(笑)

>>■困ってる点1(MoveHereでこけるとエラー処理ができない)
>「非同期」の場合、エラーの判別が出来ないだけでなく、MoveHere()の処理が
>スクリプトの空間終了に巻き込まれて、派手なこけ方をするかも。
ええ、まさにそのことです(笑)
Shell.Applicationの処理内でダイアログが表示され、OKを押すと、実行していたスクリプトごと処理が終了してしまい、On Error Resume Nextなんてまったく効かない状態でした(^^;


■私の解決策
で、やっぱり理屈うんぬんより、私自身、チェックしないと気持ち悪いので、自分なりに解決策を見つけました。

最初はこういう感じで「net file」を使った解決方法を検討してみましたが・・・とても使えません(汗
http://www.atmarkit.co.jp/fwin2k/win2ktips/083opened_net_file/083opened_net_file.html

なので、以下のサイトを参考に、次のような関数を作りました。
http://support.microsoft.com/default.aspx?scid=kb;ja;405455


IsFileLock.vbs
'============================================================
'--------------------------------------------------
'test
'--------------------------------------------------
Dim blnTest
blnTest = checkLockFile("C:\test\test.xls")
'blnTest = checkLockFile("C:\test\test.txt")
Wscript.Echo blnTest

'--------------------------------------------------
'ファイルがロックされているか判断する。
'戻り値:エラーもしくはロックされていればTrue、ロックされていない場合はFalse
'--------------------------------------------------
Function IsFileLock(strTargetFile)
     Dim blnRet
     Dim objFso
     Dim objFile

     blnRet = True

     Set objFso = CreateObject("Scripting.FileSystemObject")

     On Error Resume Next
     '追加書き込みモード=8で開けるかどうかで判断する。
     '※書き込みモード=2で開くと対象ファイルを壊すので注意!!
     Set objFile = objFso.OpenTextFile(strTargetFile,8,False)
     On Error GoTo 0

     Select Case Err.Number
          Case 0
               '正常(ロックされていない)
               blnRet = False
               '何もせず閉じる。(タイムスタンプは変更されないようです)
               objFile.Close

          Case 70
               '書き込みできません。(ロックされている)
'               Wscript.Echo Err.Number & " : " & Err.Description

          Case Else
               'その他のエラー(ファイルが存在しない等)
'               Wscript.Echo Err.Number & " : " & Err.Description
     End Select

     Set objFile = Nothing
     Set objFso = Nothing

     IsFileLock = blnRet
End Function
'============================================================
この関数の対象は、単体のファイルのみですが、これでとりあえずチェックは出来ます。
その他のエラーをどう扱うか、ちょっと悩みましたが、上記関数ではロックとして扱っています。
なので、戻り値をどうするかは、使い勝手にあわせて変更すればOKですかね。

#思わず大事なファイルを書き込みモードで壊しちゃったよ(泣)

フォルダの場合は、私の前回の書き込みのWMIのRenameを使った方法で一旦リネームし、それをロック処理として扱い、判断することでいけそうです。
ただ、ネットワーク共有フォルダに対して、処理できないので、リモートで実行させなければならないですが・・・

とりあえず、フォルダ用のロック関数も作ろうかと思ってますので、できあがったら投稿しますね(^^;
(もはや移動してしまうので、ロックしてるかチェックする関数ではないですね)

ばんのしゃーによかばんた さん 2005年 03月 28日 19時 28分 25秒

>ばんのしゃーによかばんた さん 2005年 03月 11日 16時 29分 55秒
>メモ帳でスクリプトを修正した後、名前を付けて保存するつもりが、
>上書き保存してしまいました。
>メモ帳さんには自動でバックアップを取って欲しいものです。

バックアップファイルが残るのはやっぱ鬱陶しいので、ごみ箱に送ります。

NotePad.VBS
――――――――――――――――――――――――――――――――――――――
Option Explicit
Dim wShell
Dim fso
Dim Path
Dim args:ReDim args(WScript.Arguments.Count-1)
Dim k
Dim NotePad
Dim nFile
Dim oFile
Dim Name
Dim TempName

NotePad=Left(WScript.FullName,InStrRev(WScript.FullName,"\"))
If LCase(Right(NotePad,9))="\command\" Then
 NotePad=Left(NotePad,Len(NotePad)-8)
End If
NotePad=NotePad&"NotePad.EXE"

Set wShell=CreateObject("WScript.Shell")
If WScript.Arguments.Count Then
 For k=0 To WScript.Arguments.Count-1
  args(k)=WScript.Arguments.Item(k)
 Next
 Path=Join(args)
 Set fso=CreateObject("Scripting.FileSystemObject")
 Randomize
 TempName="."&Right(Int(1000*Rnd+1000),3)
 fso.CopyFile Path,Path&TempName,False
 Call wShell.Run(NotePad&" "&Path,,True)
 Set nFile=fso.GetFile(Path)
 Set oFile=fso.GetFile(Path&TempName)
 If nFile.DateLastModified=oFile.DateLastModified Then
  Call oFile.Delete(True)
 Else
  Name=nFile.Name
  nFile.Name=Name&"."&Right(Int(1000*Rnd+1000),3)
  oFile.Name=Name
  Call RemoveFile(oFile.ParentFolder.Path,Name)
  nFile.Name=Name
 End If
Else
 Call wShell.Run(NotePad)
End If

Sub RemoveFile(FolderName,FileName)
Dim ssfBITBUCKET:ssfBITBUCKET=10
Dim Shell
Dim Folder
Dim FolderItem
Set Shell=CreateObject("Shell.Application")
Set Folder=Shell.NameSpace(FolderName)
Set FolderItem=Folder.ParseName(FileName)
Shell.NameSpace(ssfBITBUCKET).MoveHere FolderItem
Do
 Set FolderItem=ParseName(Folder,FileName)
 If FolderItem Is Nothing Then Exit Do
 WScript.Sleep 100
Loop
'WScript.Sleep 200
End Sub

Function ParseName(Folder,Name) 'For Windows98
Set ParseName=Nothing
On Error Resume Next
Set ParseName=Folder.ParseName(Name)
End Function
――――――――――――――――――――――――――――――――――――――
ここで、RemoveFile()はごみ箱送りの汎用削除関数。
MoveHere()が非同期なので、追突防止のため、ParseName()を使って待ち合わせ。
ParseName()はXPがNothingを返し、98がエラーで帰る非互換を吸収する共通関数。
MoveHere()でわざわざFolderItemを指定しているのは、98/NTで日本語を含む
文字列パス名だとファイルシステムエラーになるという報告があったためですが、
FolderItemでうまく行くかどうかは未確認です。
このように98でも動くように作ってますが、環境がないので確認できません。


ばんのしゃーによかばんた さん 2005年 03月 28日 19時 27分 58秒

>ばんのしゃーによかばんた さん 2005年 02月 21日 17時 07分 42秒
>コンソールコマンドをWindows GUIから起動して、結果もWindows画面に出します。
>RunWithArgs.VBS

ショートカット(.LNK)を作成しておくと、
コンソールコマンドがWindowアプリのようになります。

例えば、リンク先を、
"C:\Documents and Settings\ユーザ名\SendTo\RunWithArgs.VBS" "C:\Program Files\Support Tools\filever.exe" /V
としておき、起動して、プロンプトにEXEファイルなどのパスを入れると、
Window画面にファイルバージョン情報を表示します。

さらに、リンク先を、
WScript.EXE "C:\Documents and Settings\ユーザ名\SendTo\RunWithArgs.VBS" "C:\Program Files\Support Tools\filever.exe" /V
にして、SendToに置き、EXEファイルを送ったり、ドロップすると、
Window画面にファイルバージョン情報を表示します。

また、リンク先を、
"C:\Documents and Settings\ユーザ名\SendTo\RunWithArgs.VBS" "C:\Support Tools\tlist.exe"
としておき、起動して、プロンプトに/Sなどオプションを入れると、
Window画面にタスク情報を表示します。

コンソールを立ち上げて、いろいろ入力する手間要らずで、とても快適です。


sei さん 2005年 03月 27日 02時 01分 55秒

管理人様へ

そうですか、それなら以前作ったスクリプトを
見直さなくてもよさそうです。ご回答ありがとう
ございました。

でもなんで今まで気づかなかったんだろう?
と思って試したらVBSは自ら提供するオブジェクトを
予約語として保護しないんですね。WscriptもDimで
再宣言できますね。
でもRegExpはクラス名とはいえ、そうでもないのが
よく分からない…
errもなんか変。
option explicitされてるのにDimで
再宣言可能ってのもおかしいような。

option explicit
dim err, regexp, a
err=1
msgbox err ' 1
'b=1 ' 未宣言エラー

regexp=1
msgbox regexp ' 1
set a=new regexp ' OK
msgbox typename(a) ' RegExp



>その挙動は昔からそうでしたよー。
>
>MsgBox wscript Is wsh
>
>結果はTrueです。

管理人むたぐち さん 2005年 03月 26日 21時 04分 26秒

To: ばんのしゃーによかばんた さん 2005年 03月 26日 16時 51分 57秒

> 無地(無字)のフォルダアイコンにフォルダ名(英字先頭3文字程度)を重ね> たアイコンを
> 自動的に作ってフォルダのアイコンに指定するってことが出来ますでしょ> うか。

簡単です。
ただし、doodle2では「本物の」icoファイルは作れないので、擬似icoファイルになります。擬似とは、要するにbmpをicoにリネームしただけという意味です。これでも一応はアイコンとして使えますが、16x16表示時に専用アイコンを表示したりすることはできません。

32*32ピクセルのbmpファイルを用意し、folder.bmpと名前をつけて保存してください。そして以下のスクリプトに、アイコンを作りたいフォルダをドロップすれば、スクリプトのあるフォルダに、フォルダアイコンが生成します。

Set d = WScript.CreateObject("Doodle2.MyCanvas")
Set Fs = WScript.CreateObject("Scripting.FileSystemObject")
sScriptFolder = Fs.GetParentFolderName(WScript.ScriptFullName)
If Fs.FileExists(sScriptFolder & "\folder.bmp") Then
     d.LoadFromFile sScriptFolder & "\folder.bmp"
     If d.Height <> 32 Or d.Width <> 32 Then
          MsgBox("folder.bmpのサイズが違います。")
          WScript.Quit
     End If
Else
     MsgBox("folder.bmpがありません")
     WScript.Quit
End If
cBlack=d.RGBToColor(255,0,0)
d.FontSize = 9
d.FontName = "MS UI Gothic"
d.FontColor= cBlack
For Each sArg In WScript.Arguments
     If Fs.FolderExists(sArg) Then
          sName = Fs.GetFileName(sArg)
          sShortName = Left(sName,3)
          d.LoadFromFile sScriptFolder & "\folder.bmp",False
          d.StringWrite 6,14,sShortName
          d.SaveToFile sScriptFolder & "\" & sName & ".bmp"
          Fs.MoveFile sScriptFolder & "\" & sName & ".bmp",sScriptFolder & "\" & sName & ".ico"
     End If
Next
msgbox "done"

ばんのしゃーによかばんた さん 2005年 03月 26日 16時 52分 16秒

>つちや さん 2005年 03月 23日 15時 44分 07秒
>なお、bin.base64の代わりにbin.hexを使うと、また違った趣が出てきます。

この誘導尋問(?)に乗せられて答えると、こんな感じ?

HexText="320033003400"
ByteArray=HexTextToByteArray(HexText)
Text=HexTextFromByteArray(ByteArray)
MsgBox TypeName(ByteArray)
MsgBox HexText&vbCrLf&CStr(ByteArray)&vbCrLf&Text

Function HexTextFromByteArray(bin)
Dim DM, EL

Set DM = CreateObject("Microsoft.XMLDOM")
Set EL = DM.CreateElement("tmp")
EL.DataType = "bin.hex"
EL.NodeTypedValue = bin
HexTextFromByteArray = EL.Text
End Function

Function HexTextToByteArray(HexText)
Dim DM, EL

Set DM = CreateObject("Microsoft.XMLDOM")
Set EL = DM.createElement("tmp")
EL.DataType = "bin.hex"
EL.Text = HexText
HexTextToByteArray = EL.NodeTypedValue
End Function

この延長で、バリアント配列←→バイト配列も出来ますね。


ばんのしゃーによかばんた さん 2005年 03月 26日 16時 51分 57秒

>管理人むたぐち さん 2005年 03月 25日 01時 28分 09秒
>Doodle2(http://www.vector.co.jp/soft/winnt/prog/se219120.html)を使ったお遊びスクリプトを一つ。

これ(Doodle2)を使うと、
無地(無字)のフォルダアイコンにフォルダ名(英字先頭3文字程度)を重ねたアイコンを
自動的に作ってフォルダのアイコンに指定するってことが出来ますでしょうか。
昔、アイコンエディタで手作りしたことがありますが面倒なのでやめました。
そういうツールが既に有りそうな気もしますが。。。


ばんのしゃーによかばんた さん 2005年 03月 26日 16時 51分 38秒

追記。

>あさじゃけん さん 2005年 03月 24日 19時 26分 13秒
>そのとき、テキストファイルなどはいいのですが、

ちっとも、よくないです。
確率が低い、頻度が少ない、だけで、必ず発生するので、同じ対策が必須です。

>■困ってる点1(MoveHereでこけるとエラー処理ができない)
>Shell.ApplicationでMoveHereすると、ファイルが開かれていたときに、完全にこけてしまい、スクリプトでエラー処理が出来ないので困ってます。

Shell.Applicationの動作は、
「V/L」(Windows/IE)、パッチ、「対象物」(ローカルFS、ごみ箱など)、
「指定方法」(文字列、FolderItem(s)など)、
「Shell.Applicationの作成方法」(Explorer/WSH/HTM/SCなど)、
などによってさまざまに変わるので、業務用途には使わないほうがよいと思います。

「XP SP2」で「ローカルFS」の場合、MoveHere()は「同期」ですが、そのエラーはErrに
反映されないようです。それでは、スクリプトからはエラー処理が出来ませんね。

「完全にこけてしまい」というのは、MoveHere()が「非同期」なのかも。
「非同期」の場合、エラーの判別が出来ないだけでなく、MoveHere()の処理が
スクリプトの空間終了に巻き込まれて、派手なこけ方をするかも。


管理人むたぐち さん 2005年 03月 26日 08時 43分 52秒

To: sei さん

その挙動は昔からそうでしたよー。

MsgBox wscript Is wsh

結果はTrueです。

sei さん 2005年 03月 25日 23時 57分 56秒


'Dim wsh
MsgBox TypeName(wsh) 'Object(えっ!?)
MsgBox wsh.version ' 5.6(…)

wshってオブジェクトでしたっけ?

最近になってWSH5.6を導入したんでこれのせい
なんでしょうか?
REMをはずすと型はEmptyになるんですが
以前はそうじゃなかったような…

ちゃっぴ さん 2005年 03月 25日 22時 35分 13秒

ちょっと、読み違えていましたね。

>> 今はエラーが出たらそのつどエラートラップすることで
>> 問題を回避していますが、根本的な解決方法があれば私も知りたいですね。
> それが、回避策なんかではなく、正しい解決方法だと思いますよ。

ですね。Lockされているか否かは、その処理を行う際、
内部で行っているはずなので、わざわざ2度も行う必要は
ないと思います。

あと、Lockされている以外にも移動や削除ができないCaseは
いっぱいありますし…
NTFS Access権ではじかれてるとか…
PathがそのMethodで扱える範囲を超えているなんてのも…

いちいち、条件分岐させていたら大変です。

WSHでErrorになった場合、その時点でOSがStopするわけではないのですから
むしろ、積極的にError Trapを使用すべきだと思ってます。

ばんのしゃーによかばんた さん 2005年 03月 25日 18時 41分 08秒

>管理人むたぐち さん 2005年 03月 25日 01時 19分 02秒
>あさじゃけんさんの質問の件ですが、私も同様の問題を抱えて
>困っていたりします。
>今はエラーが出たらそのつどエラートラップすることで
>問題を回避していますが、根本的な解決方法があれば私も知りたいですね。

それが、回避策なんかではなく、正しい解決方法だと思いますよ。

>あさじゃけん さん 2005年 03月 24日 19時 26分 13秒
>共有フォルダで、ユーザがそのファイルを開いてる可能性が高いファイルを操作するため、移動やコピー、削除といった操作をする前に、「ファイルがロックされているかどうか判断したい」のです。

それは、無駄なことです。仮令、それが分かったとしても仕方がありません。

例えば、

>ばんのしゃーによかばんた さん 2005年 03月 12日 15時 57分 24秒
>普通に考えると、
>On Error Resume Next
>=====================
>Set xl=GetObject(,"Excel.Application")
>On Error GoTo 0
>If IsEmpty(xl) Then
> Set xl=CreateObject("Excel.Application")
>=====================
>End If
>のようにしがちですが、
>これは、===の区間をロックシリアライズしないと、多重処理で破綻します。

と同じです。

>で。。
>唯一、判断できそうなのが、以下のコードのようなものでしたが・・・
> errResults = objFolder.Rename("c:\test2")
>マイクロソフトのサンプルのまんまですが、これの戻り値で、2が帰ってきたら、使ってます・・・と。。
>そんなぁ・・・(泣
>チェックのためだけに、実際に移動してしまわないといけないのが・・・ちょっと問題です(汗
>何か良い解決方法はないでしょうか。

これは、正しい解決方法ですよ。

つまり、移動し終わるまでの間に他者に使われる可能性を減らすためにも、
先にリネームしておく、というのは、よいアイデアです。

リネーム出来れば、緩くロックを掛けたようなものだし、
リネーム出来なければ、ロックが取れなかったということです。

>で、他にも困ってます(汗
>■困ってる点1(MoveHereでこけるとエラー処理ができない)
>Shell.ApplicationでMoveHereすると、ファイルが開かれていたときに、完全にこけてしまい、スクリプトでエラー処理が出来ないので困ってます。

MoveをCopyとDeleteに分ける。

>■困ってる点2(WMIのRename、Copyにて、PCをまたいだ処理ができない)
>\\192.168.0.1\test\targetfolderを\\192.168.0.2\test2へコピーできないです。(ローカルのみ、もしくはリモートのみなら可能ですが・・・)

FSOで出来ません?


管理人むたぐち さん 2005年 03月 25日 01時 28分 09秒

Doodle2(http://www.vector.co.jp/soft/winnt/prog/se219120.html)を使ったお遊びスクリプトを一つ。

sInput = InputBox("短い文字列を入力してください")

Set d = WScript.CreateObject("Doodle2.MyCanvas")
Set Fs = WScript.CreateObject("Scripting.FileSystemObject")

cBlack=d.RGBToColor(0,0,0)
cWhite=d.RGBToColor(255,255,255)
d.FontSize = 9
d.FontName = "MS Pゴシック"
d.BkColor=cWhite
d.FontColor= cBlack

Set ts=Fs.CreateTextFile("out.txt",True)

For Each str In Split(sInput,"\n")
     d.NewCanvas d.StringWidth(str),d.StringHeight(str)
     d.StringWrite 0, 0, str
     For I=0 To d.Height
          sOutLine=""
          For J = d.Width To 0 step -1
               If d.PixelGet(J,I)=cBlack Then
                    sOutLine= "■" & sOutLine
               Else
                    sOutLine= "□" & sOutLine
               End If
          Next
          ts.WriteLine sOutLine
     Next
Next

ts.Close
MsgBox "done"


□□□□□□□□□□□□□□□□□□□□□□□□□
■□□□■□□□■□■■■■□□□■□□□□■□□
■□□□■□□□■■□□□□■□□■□□□□■□□
■□□□■□□□■■□□□□□□□■□□□□■□□
□■□■□■□■□□■□□□□□□■□□□□■□□
□■□■□■□■□□□■■■□□□■■■■■■□□
□■□■□■□■□□□□□□■□□■□□□□■□□
□■□■□■□■□■□□□□■□□■□□□□■□□
□□■□□□■□□■□□□□■□□■□□□□■□□
□□■□□□■□□□■■■■□□□■□□□□■□□
□□□□□□□□□□□□□□□□□□□□□□□□□

こういうのが簡単に作れます。
掲示板荒らしには使わないでねw

管理人むたぐち さん 2005年 03月 25日 01時 19分 02秒

To: ハンマー77 さん

すみません、私はC#でCGIを作ろうとして挫折してしまったのです…。
VBS on WSHではCGI化に成功したんですけどね。
(その成果が「ダウンロード」のページに公開している「WSHBBS」です)

ですが、標準入出力が扱える言語ならば、原理的には何でもCGIに
できるはずなので、C#でも問題ないはずですよ。
AnHTTPDの設定などに問題はありませんか?
とりあえずVBSあたりでも動くかどうか、チェックしてみるのはいかがでしょうか。


To: つちやさん、あさじゃけんさん

お久しぶりです。
MVP認定を受けたのに、あまり仕事をしてなくて恐縮です。
これからもよろしくお願いします。

あさじゃけんさんの質問の件ですが、私も同様の問題を抱えて
困っていたりします。
今はエラーが出たらそのつどエラートラップすることで
問題を回避していますが、根本的な解決方法があれば私も知りたいですね。

ちゃ さん 2005年 03月 25日 00時 24分 11秒

To あさじゃけん さん 2005年 03月 24日 19時 26分 13秒

> 共有フォルダで、ユーザがそのファイルを開いてる可能性が高いファイル> を操作するため、移動やコピー、削除といった操作をする前に、
> 「ファイルがロックされているかどうか判断したい」のです。

Network越しのAccessということであれば、ADSIのIADsResource
あたりを利用してやる手は使えませんでしょうか?

非常に不効率ですが…

あさじゃけん さん 2005年 03月 24日 19時 26分 13秒

むたぐちさん、いりやさん、つちやさん、ものすごくご無沙汰しております(汗
覚えてもらえてないかも知れませんが、以前、「あさ」とか「じゃけん」とか名乗ってた、あさじゃけんです(w
(ややこしくしてしまって申し訳ない^^;)

前の会社を辞めて以来、ここにはめっきり顔すら出していませんでしたが、最近になって、またWSHを使うことが増えてきたので、wshbbs.vbsでテキストに落としてROMになってました(笑
(LANがインターネットにつながっとらんのです。泣)
最近はExcelを操作することが多く、ADSIなどはサッパリ触らなくなってしまいました(^^;

で、書き込みしたということは・・・やっぱり質問です(汗

■ファイルのロック状態のチェックを行いたい。
あるWin2000オンリーのLAN環境で、PC192.168.0.1より、PC192.168.0.2の共有フォルダへ対して、「フォルダを移動」及び「フォルダのコピー」を行います。

そのとき、テキストファイルなどはいいのですが、Excelのファイルを削除(移動)しようとしたとき、ファイルを開いていると、使用されているため、削除できない旨のエラーがでます。(当然ですよね;;)

共有フォルダで、ユーザがそのファイルを開いてる可能性が高いファイルを操作するため、移動やコピー、削除といった操作をする前に、「ファイルがロックされているかどうか判断したい」のです。

が・・・・判断できる場所が見つけられません。


以下のWMIを使ったスクリプトで、ファイルを開いているときと、閉じているときで、値を比較してみましたが、どのプロパティも変化ありませんでした。
-----------------------------------------------
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}")
Set colFiles = objWMIService.ExecQuery("Select * from CIM_Datafile Where name = 'C:\\test\\test.xls'")
For Each objFile in colFiles
     Wscript.Echo "Access mask: " & objFile.AccessMask
     Wscript.Echo "Archive: " & objFile.Archive
     Wscript.Echo "Compressed: " & objFile.Compressed
     Wscript.Echo "Compression method: " & objFile.CompressionMethod
     Wscript.Echo "Creation date: " & objFile.CreationDate
     Wscript.Echo "Computer system name: " & objFile.CSName
     Wscript.Echo "Drive: " & objFile.Drive
     Wscript.Echo "8.3 file name: " & objFile.EightDotThreeFileName
     Wscript.Echo "Encrypted: " & objFile.Encrypted
     Wscript.Echo "Encryption method: " & objFile.EncryptionMethod
     Wscript.Echo "Extension: " & objFile.Extension
     Wscript.Echo "File name: " & objFile.FileName
     Wscript.Echo "File size: " & objFile.FileSize
     Wscript.Echo "File type: " & objFile.FileType
     Wscript.Echo "File system name: " & objFile.FSName
     Wscript.Echo "Hidden: " & objFile.Hidden
     Wscript.Echo "Last accessed: " & objFile.LastAccessed
     Wscript.Echo "Last modified: " & objFile.LastModified
     Wscript.Echo "Manufacturer: " & objFile.Manufacturer
     Wscript.Echo "Name: " & objFile.Name
     Wscript.Echo "Path: " & objFile.Path
     Wscript.Echo "Readable: " & objFile.Readable
     Wscript.Echo "System: " & objFile.System
     Wscript.Echo "Version: " & objFile.Version
     Wscript.Echo "Writeable: " & objFile.Writeable
Next
-----------------------------------------------

Shell.Applicationや、FileSystemObjectにも、それが判断できる物を見つけられませんでした。

で。。
唯一、判断できそうなのが、以下のコードのようなものでしたが・・・
-----------------------------------------------
strFolder = "c:\\test"

Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}")
Set colFolders = objWMIService.ExecQuery("Select * from Win32_Directory where name = '" & strFolder & "'")
For Each objFolder in colFolders
  errResults = objFolder.Rename("c:\test2")
  Wscript.Echo errResults
Next
-----------------------------------------------
マイクロソフトのサンプルのまんまですが、これの戻り値で、2が帰ってきたら、使ってます・・・と。。
そんなぁ・・・(泣

ちなみにRenameの戻り値一覧は以下の通りでした。

0 The request was successful.
2 Access was denied.
8 An unspecified failure occurred.
9 The name specified was invalid.
10 The object specified already exists.
11 The file system is not NTFS.
12 The platform is not Windows NT or Windows 2000.
13 The drive is not the same.
14 The directory is not empty.
15 There has been a sharing violation.
16 The start file specified was invalid.
17 A privilege required for the operation is not held.
21 A parameter specified is invalid.

チェックのためだけに、実際に移動してしまわないといけないのが・・・ちょっと問題です(汗
何か良い解決方法はないでしょうか。

で、他にも困ってます(汗

■困ってる点1(MoveHereでこけるとエラー処理ができない)
Shell.ApplicationでMoveHereすると、ファイルが開かれていたときに、完全にこけてしまい、スクリプトでエラー処理が出来ないので困ってます。

■困ってる点2(WMIのRename、Copyにて、PCをまたいだ処理ができない)
\\192.168.0.1\test\targetfolderを\\192.168.0.2\test2へコピーできないです。(ローカルのみ、もしくはリモートのみなら可能ですが・・・)

うまいこと回避する方法が見つからなかったので、助言いただけると助かります(^^;
よろしくお願いします。

管理人により削除 さん 2005年 03月 23日 16時 04分 14秒
URL:管理人により削除

管理人により削除

つちや さん 2005年 03月 23日 15時 44分 07秒
URL:http://d.hatena.ne.jp/Fio/

 みなさん、ども。ごぶさたしております。
 話の流れをまったくトレースせずに(すみません)、VBScriptでBase64エンコードするスクリプトでも。ADODB.Streamを使っているので、ファイル読み込み書き込みもできるというわけで。(XPのみの確認です)
 なお、bin.base64の代わりにbin.hexを使うと、また違った趣が出てきます。

'============================================================================
Const adTypeBinary = 1
Const adTypeText = 2

Dim str(2)
str(0) = "雨が降ってゐる荘厳だとか悲壮だとか言へば言へる・・・"
str(1) = EncodeB64(str(0))
str(2) = DecodeB64(str(1))
MsgBox Join(str, vbNewLine)

Function EncodeB64(PlainText)
 Dim ST, DM, EL, bin
 
 Set ST = CreateObject("ADODB.Stream")
 ST.Type = adTypeText
 ST.Charset = "Shift-JIS"
 ST.Open
 ST.WriteText PlainText
 ST.Position = 0
 ST.Type = adTypeBinary
 bin = ST.Read
 ST.Close
 
 Set DM = CreateObject("Microsoft.XMLDOM")
 Set EL = DM.CreateElement("tmp")
 EL.DataType = "bin.base64"
 EL.NodeTypedValue = bin
 EncodeB64 = EL.Text
End Function

Function DecodeB64(Base64Text)
 Dim ST, DM, EL
 Dim bin
 
 Set DM = CreateObject("Microsoft.XMLDOM")
 Set EL = DM.createElement("tmp")
 EL.DataType = "bin.base64"
 EL.Text = Base64Text
 bin = EL.NodeTypedValue
 
 Set ST = CreateObject("ADODB.Stream")
 ST.Open
 ST.Charset = "Shift-JIS"
 ST.Type = adTypeBinary
 ST.Write bin
 ST.Position = 0
 ST.Type = adTypeText
 DecodeB64 = ST.ReadText
 ST.Close
End Function
'============================================================================


管理人により削除 さん 2005年 03月 23日 15時 34分 18秒
URL:管理人により削除

管理人により削除

ばんのしゃーによかばんた さん 2005年 03月 23日 13時 59分 11秒

先日、真夜中に、電話機の番号メモリが勝手に作動して、名前の音声が鳴動する、
という怪現象が数回続けて発生しました。
有名な某メーカの故障タイマが作動したのかと思ってメモリを消したのですが、
今から思えば今回の地震の予兆現象だったのですね。
こういうのはどこかに報告したほうがよいのでしょうか?
でもまぁ、折角だから、もう一度メモリを入れ直して、今後の地震予報機として
活用しようと思います。


rotto さん 2005年 03月 23日 10時 53分 45秒

こんにちは
hta(html+VBS)にリンク集画面を作りました。
そのhtaファイルを共有サーバーに置き
ショートカットで複数のPCからアクセスするような仕組みになっています。

しかし、最近共有サーバー内のhtaが壊れるという現象がおきています。
ファイルの更新日時もかわり、ソースも文字化け(文字コード化?)
してしまいます。

これって、ウィルスとかウィルス駆除ソフトが悪さをしてる可能性は
ありますでしょうか?

ハンマー77 さん 2005年 03月 21日 16時 57分 10秒
URL:初めまして、

Googleから飛んで来ました。
C#でCGIを作る方法を探しております。
"C#でCGI"などと検索しても数件しかヒットせず、情報不足に突き当たっているというのが現状です。
このサイトの管理人様はC#でCGIを作られたことがあるようですが、
C#でCGIを作る上での基本的なこと、参考になるサイトなどがありましたらご教示頂けないでしょうか?
とはいっても、私はまだPerl以外の言語でCGIを動かしたことがなく、
起動すると
     Console.WriteLine("Content-type: text/plain\n\n");
     Console.WriteLine("HelloWorld");
と吐き出すC#のプログラム(***.exe)を作り、ANHTTPDでアクセスできなくて困っているというレベルです。
どうか宜しくお願い致します。

ばんのしゃーによかばんた さん 2005年 03月 19日 16時 58分 52秒

ShellFolderView.SelectItem(vItem, dwFlags)
のflagは0と1だけかと思っていたら、他にも有用なものがありますね。

vItem Required.
The FolderItem object for which the selection state will be set.
dwFlags Required.
A set of flags that indicate the new selection state.
This can be one or more of the following values:
0 Deselect the item.
1 Select the item.
3 Put the item in edit mode.
4 Deselect all but the specified item.
8 Ensure the item is displayed in the view.
16 Give the item the focus.

3はInvokeVerb("Rename")と同じ。

実は、
FolderItem.InvokeVerb("Rename")はFolderItemに効かないで、
別のFocusedItemに効くので、使えないと思っていたのですが、
こっちを使えばよいのですね。

また、これはXPだけかも知れませんが、表示が変更できますね。
ShellFolderView.CurrentViewMode
5 縮小版
6 並べて表示
1 アイコン
3 一覧
4 詳細

今までは、
CreateObject("WScript.Shell").SendKeys "%(vd)"
なんてことをやってました。


ひよこ さん 2005年 03月 18日 14時 44分 07秒

>いりや さん 2005年 03月 14日 19時 02分 05秒

いりやさん、ファイル検索のお返事有難うございました〜〜。
お休みしていたので、お返事遅くなってしまい申し訳ございませんm(__)m

正規表現、ふむふむふむ・・・
理解には時間がかかるかも・・・^^;
これから、試してみますね。
取り急ぎ、お礼まで。報告は、来週になってしまいそうですが・・・^^;;

管理人により削除 さん 2005年 03月 18日 13時 18分 09秒
URL:管理人により削除

管理人により削除

ばんのしゃーによかばんた さん 2005年 03月 17日 20時 07分 47秒

Sub SelectItemRelative(iRelative As Long)
  Shell32.ShellFolderView のメンバ
  Select Item relative to the Current Item
は何に使うのだろうと思っていましたが、それを使ってみました。快適です。

でも使えるのはXPだけ?

FileFinder.VBS
――――――――――――――――――――――――――――――――――――――
Option Explicit
Dim wShell
Dim fv
Dim Shell
Dim Document
Dim FolderItem
Dim cond
Dim N
Dim OP
Dim Value
Dim Error
Dim re
Dim SelectionChanged
Dim k
Dim Prev

Set re=New RegExp
re.IgnoreCase=True

Set wShell=CreateObject("WScript.Shell")
Set fv=WScript.CreateObject("Shell.FolderView.1","FV_")
Set Shell=CreateObject("Shell.Application")
Do
 cond=InputBox("Enter Condition To Select." & vbCrLf & _
        "N[ame]=*.*" & vbCrLf & _
        "S[ize]{< > =}n" & vbCrLf & _
        "D[ate]{< > =}[yy/]mm/dd" & vbCrLf & _
        "T[ime]{< > =}[[yy/]mm/dd] hh:mm" & vbCrLf & _
         vbCrLf & _
         N & OP & Value &vbCrLf & _
         Error & vbCrLf _
        ,WScript.ScriptName,cond,0,0)
 If IsEmpty(cond) Then Exit Do
 If Parse(cond) Then
  Set Document=Shell.Windows.Item.Document
  Call fv.SetFolderView(Document)
  Do
   If Document.SelectedItems.Count Then
    Prev=Document.SelectedItems.Item(0).Name
    Document.SelectItemRelative 1
   Else
    Prev=""
    Document.SelectItemRelative 0
   End If
'   WScript.Echo Prev,Document.SelectedItems.Count
   If Document.SelectedItems.Count<>1 Then Exit Do
   If Prev=Document.SelectedItems.Item(0).Name Then Exit Do
   If Test(Document.SelectedItems.Item(0)) Then Exit Do
  Loop
 End If
Loop
WScript.Quit

Function Parse(ByVal cond)
OP=""
Value=""
Error=""

Select Case Mid(cond,2,1)
Case "<","=",">"
 N=UCase(Left(cond,1))
 cond=Mid(cond,2)
Case Else
 N=UCase(Left(cond,4))
 cond=Mid(cond,5)
End Select

Select Case N
Case "NAME","SIZE","DATE","TIME","N","S","D","T"
Case Else
 Error="Invalid Name"
 Exit Function
End Select

Select Case Mid(cond,2,1)
Case "=",">"
 OP=Left(cond,2)
 cond=Mid(cond,3)
Case Else
 OP=Left(cond,1)
 cond=Mid(cond,2)
End Select

Select Case OP
Case "<","=",">","<=","<>",">="
Case Else
 Error="Invalid Operation"
 Exit Function
End Select

Select Case N
Case "NAME","N"
 If OP="=" Then
  cond=Replace(cond,".","\.")
  cond=Replace(cond,"?",".")
  cond=Replace(cond,"*",".*")
  Value=cond
  re.Pattern="^"&cond&"$"
 Else
  Error="Invalid Operation"
  Exit Function
 End If
Case "SIZE","S"
 If IsNumeric(cond) Then
  Value=CLng(cond)
 Else
  Error="Invalid Number"
  Exit Function
 End If
Case "DATE","D","TIME","T"
 If IsDate(cond) Then
  Select Case N
  Case "DATE","D"
   Value=DateValue(cond)
  Case "TIME","T"
   Value=CDate(cond)
   If DateValue(Value)=0 Then
    Value=Date + Value
   End If
  End Select
 Else
  Error="Invalid Date"
  Exit Function
 End If
End Select

Parse=True
End Function

Function Test(FolderItem)
Dim ModifyDate
Dim Size

Select Case N
Case "NAME","N"
 Test=re.Test(FolderItem.Name)
Case "SIZE","S"
 Size=(FolderItem.Size+1023) \ 1024
 Select Case OP
 Case "<" Test=CBool(Size<Value)
 Case "=" Test=CBool(Size=Value)
 Case ">" Test=CBool(Size>Value)
 Case "<=" Test=CBool(Size<=Value)
 Case "<>" Test=CBool(Size<>Value)
 Case ">=" Test=CBool(Size>=Value)
 End Select
Case "DATE","D","TIME","T"
 Select Case N
 Case "DATE","D"
  ModifyDate=DateValue(FolderItem.ModifyDate)
 Case "TIME","T"
  ModifyDate=FolderItem.ModifyDate
  ModifyDate=DateValue(ModifyDate)+TimeSerial(Hour(ModifyDate),Minute(ModifyDate),0)
 End Select

 Select Case OP
 Case "<" Test=CBool(ModifyDate<Value)
 Case "=" Test=CBool(ModifyDate=Value)
 Case ">" Test=CBool(ModifyDate>Value)
 Case "<=" Test=CBool(ModifyDate<=Value)
 Case "<>" Test=CBool(ModifyDate<>Value)
 Case ">=" Test=CBool(ModifyDate>=Value)
 End Select
End Select

End Function

Function FV_DefaultVerbInvoked()
' WScript.Echo "DefaultVerbInvoked"
 FV_DefaultVerbInvoked=False
End Function


ばんのしゃーによかばんた さん 2005年 03月 17日 20時 07分 23秒

ProgIDとCLSIDの相互変換です。一度使うと手放せません。
――――――――――――――――――――――――――――――――――――――
Option Explicit
Dim wShell
Dim arg

Set wShell=CreateObject("WScript.Shell")

If WScript.Arguments.Count Then
 For Each arg In WScript.Arguments
  If InStr(arg,"-") Then
   arg=xCLSID(arg)
   If arg<>"" Then arg=xProgID(arg)
  Else
   arg=xProgID(arg)
   If arg<>"" Then arg=xCLSID(arg)
  End If
 Next
Else
 Do
  arg=InputBox("Enter ProgID or CLSID",WScript.ScriptName,arg)
  If arg="" Then Exit Do
  If InStr(arg,"-") Then
   arg=xCLSID(arg)
  Else
   arg=xProgID(arg)
  End If
 Loop
End If
WScript.Quit

Function xProgID(ProgID)
Dim Description
Dim CLSID
Dim rows(3)

xProgID=ProgID
rows(0)=Join(Array("ProgID",ProgID),vbTab)

Description=RegRead("HKCR\" & ProgID & "\")
rows(1)=Join(Array("Description",Description),vbTab)

CLSID=RegRead("HKCR\" & ProgID & "\CLSID\")
If CLSID<>"" Then xProgID=CLSID
rows(2)=Join(Array("CLSID",CLSID),vbTab)

WScript.Echo Join(rows,vbCrLf)
End Function

Function xCLSID(CLSID)
Dim Description
Dim InprocServer32
Dim ScriptBlockingInprocServer32
Dim ProgID
Dim VersionIndependentProgID
Dim TypeLib
Dim Version
Dim rows(8)

xCLSID=CLSID
If Left(CLSID,1)<>"{" Then CLSID="{"&CLSID&"}"
rows(0)=Join(Array("CLSID",CLSID),vbTab)

Description=RegRead("HKCR\CLSID\" & CLSID & "\")
rows(1)=Join(Array("Description",Description),vbTab)

InprocServer32=RegRead("HKCR\CLSID\" & CLSID & "\InprocServer32\")
rows(2)=Join(Array("InprocServer32",InprocServer32),vbTab)

ScriptBlockingInprocServer32=RegRead("HKCR\CLSID\" & CLSID & "\InprocServer32\ScriptBlockingInprocServer32")
rows(3)=Join(Array("ScriptBlockingInprocServer32",ScriptBlockingInprocServer32),vbTab)

ProgID=RegRead("HKCR\CLSID\" & CLSID & "\ProgID\")
If ProgID<>"" Then xCLSID=ProgID
rows(4)=Join(Array("ProgID",ProgID),vbTab)

VersionIndependentProgID=RegRead("HKCR\CLSID\" & CLSID & "\VersionIndependentProgID\")
If VersionIndependentProgID<>"" Then xCLSID=VersionIndependentProgID
rows(5)=Join(Array("VersionIndependentProgID",VersionIndependentProgID),vbTab)

TypeLib=RegRead("HKCR\CLSID\" & CLSID & "\TypeLib\")
rows(6)=Join(Array("TypeLib",TypeLib),vbTab)

Version=RegRead("HKCR\CLSID\" & CLSID & "\Version\")
rows(7)=Join(Array("Version",Version),vbTab)

WScript.Echo Join(rows,vbCrLf)
End Function

Function RegRead(Key)
On Error Resume Next
RegRead=wShell.RegRead(Key)
End Function



ばんのしゃーによかばんた さん 2005年 03月 17日 20時 06分 57秒

>むちゃ さん 2005年 03月 07日 13時 58分 48秒
>To: ばんのしゃーによかばんた さん
>> >むちゃ さん 2005年 03月 04日 01時 17分 14秒
>> >実は、HTA(*.hta)で ExecWB メソッドを使用したいと思いまして・・・
>> document.execCommand()で代替出来ませんか?
>execCommand メソッドではだめなようです。
>印刷関連(特に印刷プレビュー)の識別子がないので;;

"Print"はありますが、"PrintPreview"はないようですね。

ExecWBと言えば、HTMなら、
<html><head><script language=vbscript>
Sub window_onload()
Call WB.ExecWB(7, 0)
End Sub
</script></head><body>hogehoge
<object id=WB classid="clsid:8856F961-340A-11D0-A96B-00C04FD705A2">
</object></body></html>
で出来るようですが、HTAでは駄目ですね。

>はちろう さん 2004年 12月 15日 14時 12分 57秒
>HPを作っているのですが、Windowを閉じる関数などがありましたら教えてください。スクリプトで色々な処理を行って、それらが全て終了した後に強制的にWindowを閉じたいと思っています。Window.close()を使ってみたのですが、そうすると、ブラウザ上に「ウィンドウを閉じます。」のようなダイアログが出てしまいます。そういったものを一切出さずに、強制的に閉じる方法があれば是非ご教授願います。

これも、ScriptControl+Shell.ApplicationやwShell.Runなどのほか、
Call WB.ExecWB(45,0)
で出来ますね。

使い道があるかどうかは別にして、
WB.ShowBrowserBar "{EFA24E64-B078-11D0-89E4-00C04FC9E26E}",True
もHTMなら出来ます。

Shell.Windows()で自分探しをしなくて済むのはいいですね。


ばんのしゃーによかばんた さん 2005年 03月 17日 20時 06分 33秒

ひょっとして、Notepad.exeにバックアップオプションがあるかも知れないと思って、
strings.VBS /u /n:2 Notepad.exe
してみると、それはなかったのですが、関連付けによく出て来る/Pと/PTのほかに、
以下のオプションがありました。
/W Unicode
/A ASCII
/.SETUP 不明

/Wと/Aは関連付けやショートカット(.LNK)を追加しておくとよいかも。

ところで、
98ではショートカットの引数がドロップすると消えたと思うのですが、
XPではEXEのショートカットの引数が消えませんね。
出来ないものだと諦めていると損をしますね。
NT系列では昔から出来たのでしょうか?

ところで、関連付けで使われるパラメタですが、
シフトキーの状態が分からないものか、と思ったのですが、
WSHのドロップハンドラでは、
%Lは%1と同じ。
%SはStartやダブルクリックでは1、ドロップでは5でした。
%IはIDLIST(?) :id(?):pidの形式でPIDはSHELL(explorer)のもの。

なので、使い道は不明ですが、
関連付けに、%Sをそれと分かるように書いとけば、ドロップは判別できますね。


ばんのしゃーによかばんた さん 2005年 03月 17日 20時 05分 58秒

例えばフォルダバーが表示されているか、どうかの判定方法は不明ですが、

TypeName(ie.GetProperty("{EFA24E64-B078-11D0-89E4-00C04FC9E26E}"))
が"Empty"なら一度も表示されたことがなく、
"Object"なら一度でも表示されたことがあるという判定が出来るようです。

Sub IE_PropertyChange(Property)
WScript.Echo Property,TypeName(ie.GetProperty(Property))
End Sub
で、エクスプローラバーが表示されるほうは監視できますが、
消えるほうは分かりません。

検索バーのTypeNameは他のバーの"Object"と違って"ISearchBar"ですが、
これの詳細は不明です。なんか使えませんかねぇ。


魔界の仮面弁士 さん 2005年 03月 17日 14時 26分 04秒

》 チャベス さん 2005年03月17日 11時29分35秒
> こちらの環境のユーザー名:パスワードで設定した所、
> ダイアログが出てしまいます。

すみません。最後は \n ではなく、\r\n ですね。

\r\nでも駄目なようなら、"User:Pass" をBASE64変換する部分で
間違えていないか、確認してみてください。

管理人により削除 さん 2005年 03月 17日 14時 10分 16秒
URL:管理人により削除

管理人により削除

チャベス さん 2005年 03月 17日 14時 02分 53秒

いりや さん

返信ありがとうございます。
色々ありそうですね。
調べてみます。


チャベス さん 2005年 03月 17日 11時 29分 35秒

魔界の仮面弁士さん。

教えて頂いた、
-------------------------------------------------------------
var IE = new ActiveXObject("InternetExplorer.Application");
var url = "http://www.kurokiya.sake-ten.jp/zzz/";
IE.Visible = true;
IE.Navigate2(url, null, null, null, "Authorization: Basic bWFpbG1hZ2E6Z3Vlc3Q=\n");
-------------------------------------------------------------
のやり方で、こちらの環境のユーザー名:パスワードで設定した所、
ダイアログが出てしまいます。
以前うまくいったと思ったのは、一度ログインに手作業で成功後
再度スクリプトから実行したケースだけでした。
原因として、ヘッダーの「 Basic 」前後のスペースの数とかが
サーバの環境によって違ったりするのではないかと思いましたが
いかがでしょうか?

いりや さん 2005年 03月 17日 00時 16分 33秒

チャベスさん、

いりや さん 2004年 07月 19日 21時 52分 10秒
http://www.roy.hi-ho.ne.jp/mutaguchi/bbs/list110.shtml
http://hidebbs.net/bbs/umiumi?n=24481462&s=7

その他、

type file site:www.roy.hi-ho.ne.jp/mutaguchi/bbs/

でググってみると一杯ヒットしますよ :)

チャベス さん 2005年 03月 16日 23時 13分 17秒

魔界の仮面弁士さん、早速の返信本当に有難うございます。

Jscriptの件は、正常に起動しました。

以前の質問ですが、
-------------------------------------------------------------------
1.FORMにTYPE=fileで指定したファイルの参照ボタンとファイル名フィールドがあり、入力されたファイルのUPLOADを行うUPLOADボタンもあります。
 ここで、ファイル名は既に分かっているので、自動で、ファイル名を指定して、UPLOADボタンを自動押下することはできますでしょうか?
 セキュリティ上無理なのでしょうか
-------------------------------------------------------------------

ファイル数が多くて自動化したい時、みなさんは、どのような手法で
自動化されているのでしょうか?


魔界の仮面弁士 さん 2005年 03月 16日 22時 22分 29秒

》チャベス さん 2005年03月16日 20時53分51秒
> ただ、scriptのjsファイルで実行すると、エラーが発生してしまいます。
JScriptでは、メソッドの呼び出し時に括弧が必要です。

var IE = new ActiveXObject("InternetExplorer.Application");
var url = "http://www.kurokiya.sake-ten.jp/zzz/";
IE.Visible = true;
IE.Navigate2(url, null, null, null, "Authorization: Basic bWFpbG1hZ2E6Z3Vlc3Q=\n");

チャベス さん 2005年 03月 16日 20時 53分 51秒

返信ありがとうございます。
ご指摘のとおりでできました。

ただ、scriptのjsファイルで実行すると、エラーが発生してしまいます。
navigate2の使い方に問題がありそうなのですが、分かりませんでした。
------------------------------------------------------------------
var IE = WScript.CreateObject("InternetExplorer.Application");
var url = "https://****.html";

IE.Visible = true;
IE.Navigate2 url , , , , "Authorization:Basic ****";
------------------------------------------------------------------
エラー「;」がありません。
となります。

分かりますでしょうか?


魔界の仮面弁士 さん 2005年 03月 16日 16時 13分 10秒

》チャベスさん 2005年03月16日 12時35分54秒
>  UPLOADボタンを自動押下することはできますでしょうか?
こちらに関しては、ボタンのclickメソッドを呼び出すだけですが、

> ここで、ファイル名は既に分かっているので、自動で、ファイル名を指定して、
こちらは無理だと思います。
SendKeysで送り込むぐらいはできるかも知れませんが、不安定ですしね。

> https://ユーザID:パスワード@***.html
この構文が使えるかどうかは、環境によって異なります。
(最近の環境では不可能です)
http://www.microsoft.com/japan/technet/security/bulletin/MS04-004.mspx

かわりに、Navigate2メソッドの Headers引数を使ってみてください。
イメージ的には、このような感じです。
 S = UserName & ":" & Password
 Headers = "Authorization: Basic " & _
     & CreateObject("BASP21").BASE64(S, 0)
 IE.Navigate2 URL, , , , Headers


BASIC認証については、下記のサイトのサンプルをご覧ください。
http://www.ken3.org/vba/backno/vba159.html

Dim IE1, IE2, IE3

MsgBox "《Pattern 1》" & vbCrLf & "Authorizationヘッダを指定した場合です。", vbInformation Or vbSystemModal, "Pattern 1"
Set IE1 = CreateObject("InternetExplorer.Application")
IE1.Visible = True
IE1.Navigate2 "http://www.kurokiya.sake-ten.jp/zzz/", , , , "Authorization: Basic bWFpbG1hZ2E6Z3Vlc3Q=" & vbCrLf
MsgBox "《Pattern 1》" & vbCrLf & "正常に表示されましたか?(USER=mailmaga/PASS=guest)", vbSystemModal, "Pattern 1"

MsgBox "《Pattern 2》" & vbCrLf & "URLに埋め込みで指定してみます。", vbSystemModal Or vbInformation, "Pattern 2"
Set IE2 = CreateObject("InternetExplorer.Application")
IE2.Visible = True
IE2.Navigate2 "http://mailmaga:guest@www.kurokiya.sake-ten.jp/zzz/"
MsgBox "《Pattern 2》" & vbCrLf & "これが使えるかどうかは環境依存です。", vbSystemModal, "Pattern 2"

MsgBox "《Pattern 3》" & vbCrLf & "ユーザを指定しない場合です。", vbSystemModal Or vbInformation, "Pattern 3"
Set IE3 = CreateObject("InternetExplorer.Application")
IE3.Visible = True
IE3.Navigate2 "http://www.kurokiya.sake-ten.jp/zzz/"
MsgBox "《Pattern 3》" & vbCrLf & "この場合は、認証を求められます。", vbSystemModal, "Pattern 3"

管理人により削除 さん 2005年 03月 16日 14時 09分 50秒
URL:管理人により削除

管理人により削除

チャベス さん 2005年 03月 16日 12時 35分 54秒

WSHを使用してIEを自動操縦しています。

以下が実現可能か、そしてその実現方法を教えて下さい。

1.TYPE=fileで指定したファイル名の参照ボタンとファイル名フィールドがあり、
 入力されたファイルのUPLOADを行うUPLOADボタンもあります。
 ここで、ファイル名は既に分かっているので、自動で、ファイル名を指定して、
 UPLOADボタンを自動押下することはできますでしょうか?
 セキュリティ上無理なのでしょうか?

2.Basic認証を自動ログインしパスしたいのですが、
 https://ユーザID:パスワード@***.html
 としても、構文エラーとなってしまいます。
 自動パスは、可能でしょうか?


 

sei さん 2005年 03月 16日 00時 51分 39秒

Excelを持ってないので完全な実験は出来ませんでしたが
x1.VBSとx2.VBSの件の部分は当方の環境では
動作しました(IE5.5 Win98)。
全く時流に役立たない情報です。

>ばんのしゃーによかばんた さん 2005年 03月 12日 15時 56分 56秒
>ie.StatusText="pipe"
>If ie.StatusText="pipe" Then
>は決してTrueになりません。

いりや さん 2005年 03月 14日 23時 47分 28秒

> ' ※ pattern は文法上誤りの表現であることが事前条件

誤りのない表現、が正しいですねw

なおき さん (nm_yamawaki@msn.com) 2005年 03月 14日 20時 06分 35秒
URL:null

はじめまして。
今VBSのリモートシェルを利用して,リモートでスクリプトを実行しています。

 OS Win2K 同士であれば問題なかったのですが、XpSp2がクライアント,とサーバーのどちらかに入ると

set objRemote = objController.CreateScript(strScript,strComputer)

実行時に「書き込めません」とエラーが出ます。

どなたか回避策をご存知の方がいらっしゃたら教えてほしく。
よろしくお願いいたします。



1つ目のVBS
' リモートアクセス権の開放 ---------------------------------------------------
Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "TargetName"
Set objRegProv = GetObject("winmgmts:{impersonationLevel=Impersonate}!\\" & strComputer & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows Script Host\Settings"
objRegProv.SetStringValue HKEY_LOCAL_MACHINE,strKeyPath,"Remote","1"


実行時スクリプト
// ==============
strComputer = "TargetName"
strScript = "実行したいスクリプト.vbs"

set objController = WScript.CreateObject("WshController")
set objRemote = objController.CreateScript(strScript, strComputer)
WScript.Echo "リモートでスクリプトを実行します。"
objRemote.Execute
Do Until objRemote.Status = 2
WScript.Sleep 100
Loop
WScript.Echo "リモートでの実行は終了しました。"

籐六 さん (halbal103@hotmail.com) 2005年 03月 14日 19時 49分 19秒

御知恵を御貸し下さい。

WSHからEXECLのSORTを実行したいのですが上手く行きません。

下記のスクリプトを実行すると、
「RangeクラスのSortメソッドが失敗しました。」
というエラーが帰ってきます。
何卒、良い方法を御教え下さい。

スクリプト
Const xlAscending = 1
Const xlGuess = 0
Const xlTopToBottom = 1
Const xlPinYin = 1

'ファイルのオープン
objXL.Workbooks.Open(DiffFile)

objXL.Range("A8").Select
objXL.ActiveCell.CurrentRegion.Select
EndRow = objXL.Selection.Rows.Count + objXL.Selection.Row - 1
objXL.Range("A8:AA" & EndRow).Select
objXL.Selection.Sort objXL.Range("E8"), xlAscending, _
           objXL.Range("H8"), xlAscending, _
           objXL.Range("B8"), xlAscending, _
           xlGuess, 1, False, xlTopToBottom, xlPinYin

objXL.ActiveWorkbook.Save

いりや さん 2005年 03月 14日 19時 02分 05秒

ひよこさん、

> yymmdd部分も変則的なため、残念ながら固定にすることは出来ません

なるほど。
ではファイル名の特徴や数に注目して、たぶんこれだと抜き出すや
り方が適当でしょうか。

以下の Check(), Find() 関数はそうした特徴をあてにして動作す
る関数です。Check() は pattern に適合するファイルが 1 個かど
うかを応えます。(1 個しか存在しないことが保証されるならば必
ず Check() は true を返す)

Find() は pattern に適合する最初の File オブジェクトを返しま
す。Check() や Find() はほとんど繰り返しの構造は一緒ですので
一つにまとめれば、ひよこさんの環境の特徴にあわせたものができ
るんじゃないかな。

Dim fso
Dim directory
Dim pattern
Dim file

Set fso = CreateObject("Scripting.FileSystemObject")

directory = "c:\"
pattern = "東部社員売上\d\d\d\d\d\d.csv"

' 例1

If Check(directory, pattern) Then
    ' 存在する時の処理
End If

' 例2

Set file = Find(directory, pattern)
If Not isEmpty(file) Then
    ' file 変数には File オブジェクトがバインドされている。
    ' file 変数を使った処理
else
    ' pattern に適合するファイルが存在しなかった場合の例外処理
End If

' directory 配下のファイルでファイル名が pattern に合致したもの
' の個数が 1 個ならば true を、それ以外ならば false を返す。
'
' ※ directory が存在することが事前条件
' ※ pattern は文法上誤りの表現であることが事前条件

Function Check(directory, pattern)
    Dim regexp
    Dim count
    Set regexp = New RegExp
    regexp.pattern = pattern '' Assume given pattern is valid.
    count = 0
    For Each file In fso.getFolder(directory).files
        If regexp.test(file.name) Then
            count = count + 1
        End If
    Next
    If count = 1 Then
        Check = true
    Else
        Check = false
    End If
End Function

' directory 配下のファイルでファイル名が pattern に最初に合致した
' ものを返す。(File オブジェクトを返す)

Function Find(directory, pattern)
    Dim regexp
    Set regexp = New RegExp
    regexp.pattern = pattern '' Assume given pattern is valid.
    For Each file In fso.getFolder(directory).files
        If regexp.test(file.name) Then
            Set Find = file
            Exit Function
        End If
    Next
End Function


ひよこ さん 2005年 03月 14日 17時 06分 33秒

>いりや さん 2005年 03月 11日 17時 42分 20秒
>対象のファイルは、一日前であることが分かる場合は、こ
のようなスクリプトになるでしょうか。n日前であれば DateAdd
() 関数の第二引数を -n に変更すれば OK です。

DateADD関数を使用したスクリプトコードをわざわざご提案いただき、
大変有難うございます。
yymmdd部分も変則的なため、残念ながら固定にすることは出来ません(T_T)

LeftやRight関数は、ファイル名には適用されないみたいですし、
処理実行前に、事前にファイル名を変更しておくしかないのでしょうかね・・・。
拡張子での識別判断というのも無理なんですよね?

ばんのしゃーによかばんた さん 2005年 03月 14日 14時 13分 15秒

エクスプローラのフォルダビューで、
ファイル名に、先頭とは限らない特定の文字列を含むものを探すとき、
どうします?

例えば、ファイル名の途中に「ほげ」が含まれているものを探すとき、

>ばんのしゃーによかばんた さん 2005年 03月 02日 16時 16分 25秒
>ShellFolderViewとそのDefaultVerbInvoked()の応用例です。
>フォルダビューで条件を指定して、複数ファイルを選択します。
>FileSelector.VBS

で、「N=*ほげ*」を指定すると、
いくつあるかが選択数で分かります。
それらは薄い色で選択されているので、目で見てすぐ分かります。

さらに、以下のFileFinder.VBSは、
現カーソル(選択)位置から下方向に検索して、マッチしたところで止まります。

FileFinder.VBS
――――――――――――――――――――――――――――――――――――――
Option Explicit
Dim wShell
Dim fv
Dim Shell
Dim Document
Dim FolderItem
Dim cond
Dim N
Dim OP
Dim Value
Dim Error
Dim re
Dim SelectionChanged

Set re=New RegExp
re.IgnoreCase=True

Set wShell=CreateObject("WScript.Shell")
Set fv=WScript.CreateObject("Shell.FolderView.1","FV_")
Set Shell=CreateObject("Shell.Application")
Set Document=Shell.Windows.Item.Document
Call fv.SetFolderView(Document)
Do
 cond=InputBox("Enter Condition To Select." & vbCrLf & _
        "N[ame]=*.*" & vbCrLf & _
        "S[ize]{< > =}n" & vbCrLf & _
        "D[ate]{< > =}[yy/]mm/dd" & vbCrLf & _
        "T[ime]{< > =}[[yy/]mm/dd] hh:mm" & vbCrLf & _
         vbCrLf & _
         N & OP & Value &vbCrLf & _
         Error & vbCrLf _
        ,WScript.ScriptName,cond,0,0)
 If IsEmpty(cond) Then Exit Do
 If Parse(cond) Then
  Do
   WScript.Sleep 200
   SelectionChanged=0
   wShell.SendKeys("{Down}")
   WScript.Sleep 200
   If SelectionChanged=0 Then Exit Do
   If Test(Document.SelectedItems.Item(0)) Then Exit Do
  Loop
 End If
Loop
WScript.Quit

Function Parse(ByVal cond)
OP=""
Value=""
Error=""

Select Case Mid(cond,2,1)
Case "<","=",">"
 N=UCase(Left(cond,1))
 cond=Mid(cond,2)
Case Else
 N=UCase(Left(cond,4))
 cond=Mid(cond,5)
End Select

Select Case N
Case "NAME","SIZE","DATE","TIME","N","S","D","T"
Case Else
 Error="Invalid Name"
 Exit Function
End Select

Select Case Mid(cond,2,1)
Case "=",">"
 OP=Left(cond,2)
 cond=Mid(cond,3)
Case Else
 OP=Left(cond,1)
 cond=Mid(cond,2)
End Select

Select Case OP
Case "<","=",">","<=","<>",">="
Case Else
 Error="Invalid Operation"
 Exit Function
End Select

Select Case N
Case "NAME","N"
 If OP="=" Then
  cond=Replace(cond,".","\.")
  cond=Replace(cond,"?",".")
  cond=Replace(cond,"*","[^.]*")
  Value=cond
  re.Pattern="^"&cond&"$"
 Else
  Error="Invalid Operation"
  Exit Function
 End If
Case "SIZE","S"
 If IsNumeric(cond) Then
  Value=CLng(cond)
 Else
  Error="Invalid Number"
  Exit Function
 End If
Case "DATE","D","TIME","T"
 If IsDate(cond) Then
  Select Case N
  Case "DATE","D"
   Value=DateValue(cond)
  Case "TIME","T"
   Value=CDate(cond)
   If DateValue(Value)=0 Then
    Value=Date + Value
   End If
  End Select
 Else
  Error="Invalid Date"
  Exit Function
 End If
End Select

Parse=True
End Function

Function Test(FolderItem)
Dim ModifyDate
Dim Size

Select Case N
Case "NAME","N"
 Test=re.Test(FolderItem.Name)
Case "SIZE","S"
 Size=(FolderItem.Size+1023) \ 1024
 Select Case OP
 Case "<" Test=CBool(Size<Value)
 Case "=" Test=CBool(Size=Value)
 Case ">" Test=CBool(Size>Value)
 Case "<=" Test=CBool(Size<=Value)
 Case "<>" Test=CBool(Size<>Value)
 Case ">=" Test=CBool(Size>=Value)
 End Select
Case "DATE","D","TIME","T"
 Select Case N
 Case "DATE","D"
  ModifyDate=DateValue(FolderItem.ModifyDate)
 Case "TIME","T"
  ModifyDate=FolderItem.ModifyDate
  ModifyDate=DateValue(ModifyDate)+TimeSerial(Hour(ModifyDate),Minute(ModifyDate),0)
 End Select

 Select Case OP
 Case "<" Test=CBool(ModifyDate<Value)
 Case "=" Test=CBool(ModifyDate=Value)
 Case ">" Test=CBool(ModifyDate>Value)
 Case "<=" Test=CBool(ModifyDate<=Value)
 Case "<>" Test=CBool(ModifyDate<>Value)
 Case ">=" Test=CBool(ModifyDate>=Value)
 End Select
End Select

End Function

Function FV_DefaultVerbInvoked()
' WScript.Echo "DefaultVerbInvoked"
 FV_DefaultVerbInvoked=False
End Function

Function FV_SelectionChanged()
' WScript.Echo "SelectionChanged"
 SelectionChanged=SelectionChanged+1
End Function



管理人により削除 さん (管理人により削除) 2005年 03月 14日 09時 43分 27秒
URL:管理人により削除

管理人により削除

ばんのしゃーによかばんた さん 2005年 03月 12日 15時 57分 24秒

>ばんのしゃーによかばんた さん 2005年 03月 11日 16時 29分 32秒
>Excelを複数起動しないようにすればよいと思います。

ちょっと補足します。

普通に考えると、
On Error Resume Next
=====================
Set xl=GetObject(,"Excel.Application")
On Error GoTo 0
If IsEmpty(xl) Then
 Set xl=CreateObject("Excel.Application")
=====================
End If
のようにしがちですが、
これは、===の区間をロックシリアライズしないと、多重処理で破綻します。

実際、関連付けのDDE起動が破綻しているのはこのせい(同じ理由)です。

これを、
Set x2=CreateObject("Excel.Application")
Set xl=GetObject(,"Excel.Application")
If Not xl Is x2 Then x2.Quit
とすると、性能が若干冗長ですが、ロックシリアライズなしに多重処理に耐えます。

さらに、
On Error Resume Next
Set xl=GetObject(,"Excel.Application")
On Error GoTo 0
If IsEmpty(xl) Then
 Set x2=CreateObject("Excel.Application")
 Set xl=GetObject(,"Excel.Application")
 If Not xl Is x2 Then x2.Quit
End If
とすれば、コードは長くなりますが、性能は軽くなります。

こういうやり方は、
ロックシリアライズが必要なとき、ロックシリアライズなしに済ます、
定番だと思います。
もしもロックシリアライズが欲しくなったときは思い出してください。


Return