書き込み遅くなりました(汗
皆さんいろいろ意見をありがとうございます(^^
■むたぐち さんへ
> 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月 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年 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画面にタスク情報を表示します。
コンソールを立ち上げて、いろいろ入力する手間要らずで、とても快適です。
管理人様へ
そうですか、それなら以前作ったスクリプトを
見直さなくてもよさそうです。ご回答ありがとう
ございました。
でもなんで今まで気づかなかったんだろう?
と思って試したら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です。
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月 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月 25日 01時 28分 09秒
>Doodle2(http://www.vector.co.jp/soft/winnt/prog/se219120.html)を使ったお遊びスクリプトを一つ。
これ(Doodle2)を使うと、
無地(無字)のフォルダアイコンにフォルダ名(英字先頭3文字程度)を重ねたアイコンを
自動的に作ってフォルダのアイコンに指定するってことが出来ますでしょうか。
昔、アイコンエディタで手作りしたことがありますが面倒なのでやめました。
そういうツールが既に有りそうな気もしますが。。。
追記。
>あさじゃけん さん 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()の処理が
スクリプトの空間終了に巻き込まれて、派手なこけ方をするかも。
To: sei さん
その挙動は昔からそうでしたよー。
MsgBox wscript Is wsh
結果はTrueです。
'Dim wsh
MsgBox TypeName(wsh) 'Object(えっ!?)
MsgBox wsh.version ' 5.6(…)
wshってオブジェクトでしたっけ?
最近になってWSH5.6を導入したんでこれのせい
なんでしょうか?
REMをはずすと型はEmptyになるんですが
以前はそうじゃなかったような…
ちょっと、読み違えていましたね。
>> 今はエラーが出たらそのつどエラートラップすることで
>> 問題を回避していますが、根本的な解決方法があれば私も知りたいですね。
> それが、回避策なんかではなく、正しい解決方法だと思いますよ。
ですね。Lockされているか否かは、その処理を行う際、
内部で行っているはずなので、わざわざ2度も行う必要は
ないと思います。
あと、Lockされている以外にも移動や削除ができないCaseは
いっぱいありますし…
NTFS Access権ではじかれてるとか…
PathがそのMethodで扱える範囲を超えているなんてのも…
いちいち、条件分岐させていたら大変です。
WSHでErrorになった場合、その時点でOSがStopするわけではないのですから
むしろ、積極的にError Trapを使用すべきだと思ってます。
>管理人むたぐち さん 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で出来ません?
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
To: ハンマー77 さん
すみません、私はC#でCGIを作ろうとして挫折してしまったのです…。
VBS on WSHではCGI化に成功したんですけどね。
(その成果が「ダウンロード」のページに公開している「WSHBBS」です)
ですが、標準入出力が扱える言語ならば、原理的には何でもCGIに
できるはずなので、C#でも問題ないはずですよ。
AnHTTPDの設定などに問題はありませんか?
とりあえずVBSあたりでも動くかどうか、チェックしてみるのはいかがでしょうか。
To: つちやさん、あさじゃけんさん
お久しぶりです。
MVP認定を受けたのに、あまり仕事をしてなくて恐縮です。
これからもよろしくお願いします。
あさじゃけんさんの質問の件ですが、私も同様の問題を抱えて
困っていたりします。
今はエラーが出たらそのつどエラートラップすることで
問題を回避していますが、根本的な解決方法があれば私も知りたいですね。
To あさじゃけん さん 2005年 03月 24日 19時 26分 13秒
> 共有フォルダで、ユーザがそのファイルを開いてる可能性が高いファイル> を操作するため、移動やコピー、削除といった操作をする前に、
> 「ファイルがロックされているかどうか判断したい」のです。
Network越しのAccessということであれば、ADSIのIADsResource
あたりを利用してやる手は使えませんでしょうか?
非常に不効率ですが…
むたぐちさん、いりやさん、つちやさん、ものすごくご無沙汰しております(汗
覚えてもらえてないかも知れませんが、以前、「あさ」とか「じゃけん」とか名乗ってた、あさじゃけんです(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へコピーできないです。(ローカルのみ、もしくはリモートのみなら可能ですが・・・)
うまいこと回避する方法が見つからなかったので、助言いただけると助かります(^^;
よろしくお願いします。
管理人により削除
みなさん、ども。ごぶさたしております。
話の流れをまったくトレースせずに(すみません)、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
'============================================================================
管理人により削除
先日、真夜中に、電話機の番号メモリが勝手に作動して、名前の音声が鳴動する、
という怪現象が数回続けて発生しました。
有名な某メーカの故障タイマが作動したのかと思ってメモリを消したのですが、
今から思えば今回の地震の予兆現象だったのですね。
こういうのはどこかに報告したほうがよいのでしょうか?
でもまぁ、折角だから、もう一度メモリを入れ直して、今後の地震予報機として
活用しようと思います。
こんにちは
hta(html+VBS)にリンク集画面を作りました。
そのhtaファイルを共有サーバーに置き
ショートカットで複数のPCからアクセスするような仕組みになっています。
しかし、最近共有サーバー内のhtaが壊れるという現象がおきています。
ファイルの更新日時もかわり、ソースも文字化け(文字コード化?)
してしまいます。
これって、ウィルスとかウィルス駆除ソフトが悪さをしてる可能性は
ありますでしょうか?
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でアクセスできなくて困っているというレベルです。
どうか宜しくお願い致します。
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月 14日 19時 02分 05秒
いりやさん、ファイル検索のお返事有難うございました〜〜。
お休みしていたので、お返事遅くなってしまい申し訳ございませんm(__)m
正規表現、ふむふむふむ・・・
理解には時間がかかるかも・・・^^;
これから、試してみますね。
取り急ぎ、お礼まで。報告は、来週になってしまいそうですが・・・^^;;
管理人により削除
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
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月 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()で自分探しをしなくて済むのはいいですね。
ひょっとして、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をそれと分かるように書いとけば、ドロップは判別できますね。
例えばフォルダバーが表示されているか、どうかの判定方法は不明ですが、
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日 11時29分35秒
> こちらの環境のユーザー名:パスワードで設定した所、
> ダイアログが出てしまいます。
すみません。最後は \n ではなく、\r\n ですね。
\r\nでも駄目なようなら、"User:Pass" をBASE64変換する部分で
間違えていないか、確認してみてください。
管理人により削除
いりや さん
返信ありがとうございます。
色々ありそうですね。
調べてみます。
魔界の仮面弁士さん。
教えて頂いた、
-------------------------------------------------------------
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 」前後のスペースの数とかが
サーバの環境によって違ったりするのではないかと思いましたが
いかがでしょうか?
チャベスさん、
いりや さん 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/
でググってみると一杯ヒットしますよ :)
魔界の仮面弁士さん、早速の返信本当に有難うございます。
Jscriptの件は、正常に起動しました。
以前の質問ですが、
-------------------------------------------------------------------
1.FORMにTYPE=fileで指定したファイルの参照ボタンとファイル名フィールドがあり、入力されたファイルのUPLOADを行うUPLOADボタンもあります。
ここで、ファイル名は既に分かっているので、自動で、ファイル名を指定して、UPLOADボタンを自動押下することはできますでしょうか?
セキュリティ上無理なのでしょうか
-------------------------------------------------------------------
ファイル数が多くて自動化したい時、みなさんは、どのような手法で
自動化されているのでしょうか?
》チャベス さん 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");
返信ありがとうございます。
ご指摘のとおりでできました。
ただ、scriptのjsファイルで実行すると、エラーが発生してしまいます。
navigate2の使い方に問題がありそうなのですが、分かりませんでした。
------------------------------------------------------------------
var IE = WScript.CreateObject("InternetExplorer.Application");
var url = "https://****.html";
IE.Visible = true;
IE.Navigate2 url , , , , "Authorization:Basic ****";
------------------------------------------------------------------
エラー「;」がありません。
となります。
分かりますでしょうか?
》チャベスさん 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"
管理人により削除
WSHを使用してIEを自動操縦しています。
以下が実現可能か、そしてその実現方法を教えて下さい。
1.TYPE=fileで指定したファイル名の参照ボタンとファイル名フィールドがあり、
入力されたファイルのUPLOADを行うUPLOADボタンもあります。
ここで、ファイル名は既に分かっているので、自動で、ファイル名を指定して、
UPLOADボタンを自動押下することはできますでしょうか?
セキュリティ上無理なのでしょうか?
2.Basic認証を自動ログインしパスしたいのですが、
https://ユーザID:パスワード@***.html
としても、構文エラーとなってしまいます。
自動パスは、可能でしょうか?
Excelを持ってないので完全な実験は出来ませんでしたが
x1.VBSとx2.VBSの件の部分は当方の環境では
動作しました(IE5.5 Win98)。
全く時流に役立たない情報です。
>ばんのしゃーによかばんた さん 2005年 03月 12日 15時 56分 56秒
>ie.StatusText="pipe"
>If ie.StatusText="pipe" Then
>は決してTrueになりません。
> ' ※ pattern は文法上誤りの表現であることが事前条件
誤りのない表現、が正しいですねw
はじめまして。
今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 "リモートでの実行は終了しました。"
御知恵を御貸し下さい。
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
ひよこさん、
> 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月 11日 17時 42分 20秒
>対象のファイルは、一日前であることが分かる場合は、こ
のようなスクリプトになるでしょうか。n日前であれば DateAdd
() 関数の第二引数を -n に変更すれば OK です。
DateADD関数を使用したスクリプトコードをわざわざご提案いただき、
大変有難うございます。
yymmdd部分も変則的なため、残念ながら固定にすることは出来ません(T_T)
LeftやRight関数は、ファイル名には適用されないみたいですし、
処理実行前に、事前にファイル名を変更しておくしかないのでしょうかね・・・。
拡張子での識別判断というのも無理なんですよね?
エクスプローラのフォルダビューで、
ファイル名に、先頭とは限らない特定の文字列を含むものを探すとき、
どうします?
例えば、ファイル名の途中に「ほげ」が含まれているものを探すとき、
>ばんのしゃーによかばんた さん 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月 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
とすれば、コードは長くなりますが、性能は軽くなります。
こういうやり方は、
ロックシリアライズが必要なとき、ロックシリアライズなしに済ます、
定番だと思います。
もしもロックシリアライズが欲しくなったときは思い出してください。