Notes

Notes - notes.io

----------------------------------------------------------------------------------
RecentFolders.HTA V1.01 (C) [email protected] 2005-08-26

「最近使ったフォルダ」に追加するHTAとVBScript

1. 目的、用途

ファイルについては、「履歴」や「最近使ったファイル」がありますが、
フォルダについては、相当のものがなく、ちょっと不便です。
そこで、「リンク」の下にサブフォルダ「最近使ったフォルダ」を作り、
フォルダのインターネットショートカットを追加します。

2. 使用方法

使用前に、「リンク」の下に、サブフォルダ「最近使ったフォルダ」を
作成しておいてください。■注意！ V1.00と場所を変えました。

(1) AddRecentFolders.VBS

フォルダをドロップします。
或いは、「SendTo」に登録して、フォルダを送ります。
そのフォルダを「最近使ったフォルダ」に追加します。

或いは、「お気に入り」に追加し、「お気に入り」から起動します。
そのエクスプローラで開いているフォルダを「最近使ったフォルダ」に
追加します。

'AddToRecentFolders.VBS V1.01 (C) [email protected] 2005-08-26

Option Explicit
Dim URL
Dim FileName
Dim wShell
Dim FolderName
Dim Link

If WScript.Arguments.Count Then
URL=WScript.Arguments.Item(0)
Else
URL=CreateObject("Shell.Application").Windows().Item.LocationURL
End If
FileName=Replace(URL,"file:///","")
FileName=Replace(FileName,":","-")
FileName=Replace(FileName,"/","-")
FileName=Replace(FileName,"","-")
FileName=Replace(FileName,"%20"," ")

Set wShell=CreateObject("WScript.Shell")
FolderName=wShell.SpecialFolders("Favorites")
Set Link=wShell.CreateShortcut(FolderName & "リンク最近使ったフォルダ" & FileName & ".url")
Link.TargetPath=URL
Link.Save

(2) RecentFolders.HTA

起動すると、左上に表示窓を開き、5秒毎にそのとき開かれているフォルダを
「最近使ったフォルダ」に追加します。

ただし、初期値では最小化で起動しています。適宜変更してください。
<hta:... windowstate=minimize />の部分をnormalに。

<html>
<head>
<meta http-equiv=Content-Type content="text/html; charset=shift_jis">
<title>「最近使ったフォルダ」の監視中...</title>
<script language=vbscript>
'RecentFolders.HTA V1.01 (C) [email protected] 2005-08-26
Option Explicit
moveTo 0,0
resizeTo 200,100

Dim FolderName

Sub window_onload()
FolderName=wShell.SpecialFolders("Favorites")
Call Patrol()
setInterval "Patrol",5000
End Sub

Sub Patrol()
Dim ie
Dim URL
For Each ie In ShellWindows
URL=ie.LocationURL
If dic.Exists(URL) Then
Else
dic.Add URL,1
If Left(URL,8)<>"file:///" Then
ElseIf ie.Busy Then
ElseIf ie.ReadyState<>4 Then
ElseIf InStr(TypeName(ie.Document),"IShellFolderView") Then
Call AddHistory(URL)
End If
End If
Next
If document.parentWindow.screenLeft>0 Then
If document.body.scrollwidth<>document.body.clientwidth Then
resizeBy document.body.scrollwidth-document.body.clientwidth,0
End If
End If
End Sub

Sub AddHistory(URL)
Dim Link
Dim FileName
Dim Title
Dim HTML

FileName=Mid(URL,9)
FileName=Replace(FileName,":","-")
FileName=Replace(FileName,"/","-")
FileName=Replace(FileName,"","-")
FileName=Replace(FileName,"%20"," ")

Set Link=wShell.CreateShortcut(FolderName & "リンク最近使ったフォルダ" & FileName & ".url")
Link.TargetPath=URL
Link.Save

Title=Mid(URL,9)
Title=Replace(Title,"/","")
Title=Replace(Title,"%20"," ")
HTML=" <a href="&URL&">"&Title&"</a><br>"
document.body.insertAdjacentHTML "AfterBegin",HTML
End Sub

</script>
<hta:application innerborder=none windowstate=minimize />
</head>
<body style="background:menu;margin:0" nowrap >
<object id=ShellWindows classid=clsid:9BA05972-F6A8-11CF-A442-00A0C90A8F39></object>
<object id=wShell classid=clsid:72C24DD5-D70A-438B-8A42-98424B88AFB8></object>
<object id=fso classid=clsid:0D43FE01-F093-11CF-8940-00A0C9054228></object>
<object id=dic classid=clsid:EE09B103-97E0-11CF-978F-00A02463E06F></object><br>
</body>
</html>

(3) RecentFolders.VBS

起動すると、常駐します。GUIを持たないので、
RecentFolders.HTAの窓が不要の場合は、こちらを使用します。

終了インタフェースを持たないため、終了するには、
タスクマネジャでプロセスを終了させます。

'RecentFolders.VBS V1.01 (C) [email protected] 2005-08-26

Option Explicit
Dim wShell
Dim FolderName
Dim dic
Dim Shell
Dim ie
Dim URL

Set wShell=CreateObject("WScript.Shell")
FolderName=wShell.SpecialFolders("Favorites")
Set dic=CreateObject("Scripting.Dictionary")

Set Shell=CreateObject("Shell.Application")
Do
For Each ie In Shell.Windows()
URL=ie.LocationURL
If dic.Exists(URL) Then
Else
dic.Add URL,1
If Left(URL,8)<>"file:///" Then
ElseIf ie.Busy Then
ElseIf ie.ReadyState<>4 Then
ElseIf InStr(TypeName(ie.Document),"IShellFolderView") Then
Call AddHistory(URL)
End If
End If
Next
WScript.Sleep 5000
Loop

Sub AddHistory(URL)
Dim Link
Dim FileName

FileName=Mid(URL,9)
FileName=Replace(FileName,":","-")
FileName=Replace(FileName,"/","-")
FileName=Replace(FileName,"","-")
FileName=Replace(FileName,"%20"," ")

Set Link=wShell.CreateShortcut(FolderName & "リンク最近使ったフォルダ" & FileName & ".url")
Link.TargetPath=URL
Link.Save
End Sub

(4) フォルダの参照

エクスプローラの「お気に入り」メニューや「お気に入り」バーの
「最近使ったフォルダ」、或いは、HTAの表示窓、から選択します。

(5) CleanRecentFolders.VBS

「最近使ったフォルダ」内の無効なショートカットを削除します。

'CleanRecentFolders.VBS V1.01 (C) [email protected] 2005-08-26

Option Explicit
Dim wShell
Dim Shell
Const ssfBITBUCKET=10
Dim RecycleBinFolder
Dim FolderName
Dim Folder
Dim k
Dim FolderItem
Dim Link
Dim ok:ok=0
Dim ng:ng=0
Dim etc:etc=0
Dim FolderItems:FolderItems=Array()
Dim Rows:Rows=Array()
Dim FileName
Dim Ans
Dim fso
Dim Path

Set wShell=CreateObject("WScript.Shell")
Set Shell=CreateObject("Shell.Application")
Set RecycleBinFolder=Shell.NameSpace(ssfBITBUCKET)
FolderName=wShell.SpecialFolders("Favorites") & "リンク最近使ったフォルダ"
Set Folder=Shell.NameSpace(FolderName)
For k=Folder.Items.Count To 1 Step -1
Set FolderItem=Folder.Items.Item(k-1)
If FolderItem.IsLink Then
Set Link=FolderItem.GetLink
If Target(Link) Then
ok=ok+1
Else
ReDim Preserve FolderItems(UBound(FolderItems)+1)
Set FolderItems(UBound(FolderItems))=FolderItem
FileName=Mid(FolderItem.Path,InStrRev(FolderItem.Path,"")+1)
ReDim Preserve Rows(UBound(Rows)+1)
Path=Mid(Link.Path,9)
Path=Replace(Path,"/","")
Path=Replace(Path,"%20"," ")
Rows(UBound(Rows))=Join(Array(FileName,Path),vbTab)
ng=ng+1
End If
Else
etc=etc+1
End If
Next
If UBound(Rows)=-1 Then
MsgBox "正常"&vbTab&ok&vbLf&"エラー"&vbTab&ng&vbLf&"その他"&vbTab&etc,vbInformation,_
"「最近使ったフォルダ」の無効なショートカット"
Else
Ans=MsgBox("正常"&vbTab&ok&vbLf&"エラー"&vbTab&ng&vbLf&"その他"&vbTab&etc&vbLf&Join(Rows,vbLf),_
vbQuestion+vbYesNoCancel,_
"「最近使ったフォルダ」の無効なショートカット？ Yes(ごみ箱) No(削除) Cancel(中止)")
If Ans=vbYes Then
For Each FolderItem In FolderItems
Call Delete(FolderItem)
Next
ElseIf Ans=vbNo Then
Set fso=CreateObject("Scripting.FileSystemObject")
For Each FolderItem In FolderItems
fso.DeleteFile FolderItem.Path
Next
End If
End If
WScript.Quit

Sub Delete(FolderItem)
Dim FileName
FileName=Mid(FolderItem.Path,InStrRev(FolderItem.Path,"")+1)
RecycleBinFolder.MoveHere FolderItem
Do
Set FolderItem=ParseName(Folder,FileName)
If FolderItem Is Nothing Then Exit Do
WScript.Sleep 100
Loop
End Sub

Function Target(Link)
On Error Resume Next
Target=InStr(TypeName(Link.Target),"FolderItem")
End Function

Function ParseName(Folder,FileName) 'For Windows98
Set ParseName=Nothing
On Error Resume Next
Set ParseName=Folder.ParseName(FileName)
End Function
------------------------------------------------------------------------
FCdiff.VBS V1.02 (C) [email protected] 2006-07-30

新旧ソースを左右2列に並べ変更箇所を枠で囲む差分リストのHTMを作るVBScript

1. 目的、用途

ソフトウェア開発の要は品質です。
品質確保の要はソースレビューです。
ソースレビューの要は差分リストです。
もし、障害多発、品質不良でお困りなら、レビュー方法をチェックしましょう。
FC.EXEの生出力とソースリストを見比べて、なんてことをしてませんか。
それでは、修正箇所を突き合わせたり、修正前後をイメージすることに
無駄に脳力が消費され、肝心のレビューに脳力を集中できません。
障害多発、品質不良は当然の帰結です。差分リストを使いましょう。
比較そのものはWindowsのFC.EXEを利用します。
差分リストの表現はHTMLの<table>を利用します。
差分リストの表示と印刷はIEを利用します。

2. 使用方法

GUIでは、比較する二つのファイルをFCdiff.VBSにドロップします。
FCdiff.VBSを「SentTo」に登録して、比較する二つのファイルを
右クリックで送ってもよいでしょう。
ドラッグ開始にマウスの置かれたほう、また、右クリックしたほうが、
左側になります。

コマンドラインでは、比較する二つのファイルを引数に指定します。
Start FCdiff.VBS file1 file2

差分リストがテンポラリファイルに作成されて、IEで表示されます。
必要なら、IEから「名前を付けて保存」したり、「印刷」します。
印刷時はページ設定でレイアウトを横にするとよいでしょう。
テンポラリファイルはIE終了時に削除されます。

コマンドラインで、CScript.EXEを使って実行すると、標準出力に
差分リストが出力されます。
ファイルにリダイレクトするなりしてください。

CScript.EXE //NoLogo FCdiff.VBS file1 file2 >htmlfile

IEで差分リストを表示して、印刷プレビューで確認しながら、
必要ページだけを印刷します。

印刷前に、印刷プレビューで確認して、
ページ設定で、用紙サイズ、印刷の向き、左右の余白などを調節してください。

プリンタドライバにも依存しますが、実際に印刷するときに、詳細設定で、
B4(横)->A4(横)縮小などにするとよいでしょう。

' FCdiff.VBS V1.02 (C) [email protected] 2006-07-30
' FCdiff.VBS generates differential list in HTML.
' Usage: Start FCdiff.VBS file1 file2
' Usage: CScript.EXE //NoLogo FCdiff.VBS file1 file2 >htmlfile

Option Explicit
Dim wShell
Dim fso
Dim ie
Dim FileName1
Dim FileName2
Dim FileName3
Dim FileName4
Dim StdOut

Set wShell=CreateObject("WScript.Shell")
Set fso=CreateObject("Scripting.FileSystemObject")
FileName1=WScript.Arguments.Item(0)
FileName2=WScript.Arguments.Item(1)
FileName3=fso.BuildPath(fso.GetSpecialFolder(2).Path,fso.GetTempName())
If UCase(fso.GetBaseName(WScript.FullName))="WSCRIPT" Then
FileName4=fso.BuildPath(fso.GetSpecialFolder(2).Path,fso.GetBaseName(fso.GetTempName()) & ".HTM")
End If
wShell.Run "CMD.EXE /CFC.EXE /N """&FileName1&""" """&FileName2&""" >"""&FileName3&"""",0,True
If IsEmpty(FileName4) Then
Set StdOut=WScript.StdOut
Else
Set StdOut=fso.CreateTextFile(FileName4)
End If
Call diff(FileName3)
fso.DeleteFile FileName3

If Not IsEmpty(FileName4) Then
StdOut.Close
Set ie=CreateObject("InternetExplorer.Application")
ie.Visible=True
ie.Navigate FileName4
Do While TypeName(ie)="IWebBrowser2"
WScript.Sleep 1000
Loop
fso.DeleteFile FileName4
End If

WScript.Quit

Sub diff(FileName3)
Dim FileName
Dim FileName1
Dim FileName2
Dim File1
Dim File3
Dim Line1
Dim Line3
Dim Matches
Dim LineNum1:LineNum1=0
Dim LineNum2:LineNum2=0
Dim LineNum3
Dim LineNum1x
Dim LineNum2x
Dim Lines1:Lines1=Array()
Dim Lines2:Lines2=Array()
Dim k,m
Dim border
Dim width
'width="125mm" 'A4横
'width="190mm" 'A3横
width="50%"

Dim re1
Set re1=New RegExp
re1.Pattern="^ファイル (.*) と (.*) を比較しています$"
Rem FileName1 FileName2

Dim re2
Set re2=New RegExp
re2.Pattern="^x2ax2ax2ax2ax2a (.*)$"

Dim re3
Set re3=New RegExp
re3.Pattern="^([ 0-9][ 0-9][ 0-9][ 0-9][0-9]): (.*)$"

Set File3=fso.OpenTextFile(FileName3)

StdOut.WriteLine "<html><head>"
StdOut.WriteLine "<meta http-equiv=Content-Type content=""text/html; charset=shift_jis"">"
StdOut.WriteLine "<style></style></head><body><table border>"

Line3=File3.ReadLine
Set Matches=re1.Execute(Line3)
FileName1=Matches.Item(0).SubMatches.Item(0)
FileName2=Matches.Item(0).SubMatches.Item(1)
'MsgBox FileName1
'MsgBox FileName2
StdOut.WriteLine "<tr bordercolor=black><td></td><td class=border_both_2>"&FileName1&"</td><td></td><td class=border_both_2>"&FileName2&"</td></tr>"

Set File1=fso.OpenTextFile(FileName1)

Do While Not File3.AtEndOfStream
Line3=File3.ReadLine
If re3.Test(Line3) Then
Set Matches=re3.Execute(Line3)
LineNum3=Matches.Item(0).SubMatches.Item(0)
Line1=Matches.Item(0).SubMatches.Item(1)
LineNum3=CLng(Trim(LineNum3))
If FileName=FileName1 Then
Push Lines1,Line1
If UBound(Lines1)=0 Then
' MsgBox LineNum3
LineNum1x=LineNum3
End If
ElseIf FileName=FileName2 Then
Push Lines2,Line1
If UBound(Lines2)=0 Then
' MsgBox LineNum3
LineNum2x=LineNum3
End If
Else
MsgBox Escape(FileName)
End If
ElseIf re2.Test(Line3) Then
Set Matches=re2.Execute(Line3)
FileName=Matches.Item(0).SubMatches.Item(0)
' MsgBox FileName
ElseIf Line3="*****" Then
FileName=""
' MsgBox Line3
If LineNum1x Then
If LineNum2x Then
If Lines1(UBound(Lines1))=Lines2(UBound(Lines2)) Then
ReDim Preserve Lines1(UBound(Lines1)-1)
ReDim Preserve Lines2(UBound(Lines2)-1)
End If
If Lines1(0)=Lines2(0) Then
For k=0 To UBound(Lines1)-1
Lines1(k)=Lines1(k+1)
Next
For k=0 To UBound(Lines2)-1
Lines2(k)=Lines2(k+1)
Next
ReDim Preserve Lines1(UBound(Lines1)-1)
ReDim Preserve Lines2(UBound(Lines2)-1)
LineNum1x=LineNum1x+1
LineNum2x=LineNum2x+1
End If
End If
End If
If LineNum1x Then
For k=LineNum1+1 To LineNum1x-1
LineNum1=LineNum1+1
LineNum2=LineNum2+1
Line1=File1.ReadLine
border="class=border_none"
StdOut.WriteLine "<tr><td "&border&">"&LineNum1&"</td><td "&border&"_2>"&HTMLEncode(Line1)&"</td><td "&border&">"&LineNum2&"</td><td "&border&"_2>"&HTMLEncode(Line1)&"</td></tr>"
Next
Else
For k=LineNum1+1 To LineNum2x-1
LineNum1=LineNum1+1
LineNum2=LineNum2+1
Line1=File1.ReadLine
border="class=border_none"
StdOut.WriteLine "<tr><td "&border&">"&LineNum1&"</td><td "&border&"_2>"&HTMLEncode(Line1)&"</td><td "&border&">"&LineNum2&"</td><td "&border&"_2>"&HTMLEncode(Line1)&"</td></tr>"
Next
End If
m=UBound(Lines1)
If m<UBound(Lines2) Then m=UBound(Lines2)
For k=0 To m
If k=0 Then
If k=m Then
border="class=border_both"
Else
border="class=border_top"
End If
Else
If k=m Then
border="class=border_bottom"
Else
border="class=border_middle"
End If
End If
If k<=UBound(Lines1) And k<=UBound(Lines2) Then
LineNum1=LineNum1+1
Line1=File1.ReadLine
LineNum2=LineNum2+1
StdOut.WriteLine "<tr><td "&border&">"&LineNum1&"</td><td "&border&"_2>"&HTMLEncode(Lines1(k))&"</td><td "&border&">"&LineNum2&"</td><td "&border&"_2>"&HTMLEncode(Lines2(k))&"</td></tr>"
ElseIf k<=UBound(Lines1) Then
LineNum1=LineNum1+1
Line1=File1.ReadLine
StdOut.WriteLine "<tr><td "&border&">"&LineNum1&"</td><td "&border&"_2>"&HTMLEncode(Lines1(k))&"</td><td "&border&"> </td><td "&border&"_2> </td></tr>"
Else
LineNum2=LineNum2+1
StdOut.WriteLine "<tr><td "&border&"> </td><td "&border&"_2> </td><td "&border&">"&LineNum2&"</td><td "&border&"_2>"&HTMLEncode(Lines2(k))&"</td></tr>"
End If
Next
Lines1=Array()
Lines2=Array()
LineNum1x=0
LineNum2x=0
ElseIf Line3="" Then
Else
MsgBox "? " & Line3
End If
Loop
Do While Not File1.AtEndOfStream
LineNum1=LineNum1+1
LineNum2=LineNum2+1
Line1=File1.ReadLine
border="class=border_none"
StdOut.WriteLine "<tr><td "&border&">"&LineNum1&"</td><td "&border&"_2>"&HTMLEncode(Line1)&"</td><td "&border&">"&LineNum2&"</td><td "&border&"_2>"&HTMLEncode(Line1)&"</td></tr>"
Loop

StdOut.WriteLine "</table></body></html>"
End Sub

Function HTMLEncode(ByVal Text)
Text=Replace(Text,"&","&")
Text=Replace(Text,">",">")
Text=Replace(Text,"<","<")
Text=Replace(Text,"""",""")
Text=Replace(Text,"'","'")
Text=Replace(Text," "," ")
If Text="" Then Text=" "
HTMLEncode=Text
End Function

Sub Push(Items,Item)
ReDim Preserve Items(UBound(Items)+1)
Items(UBound(Items))=Item
End Sub

Notes.io is a web-based application for taking notes. You can take your notes and share with others people. If you like taking long notes, notes.io is designed for you. To date, over 8,000,000,000 notes created and continuing...

With notes.io;

* You can take a note from anywhere and any device with internet connection.
* You can share the notes in social platforms (YouTube, Facebook, Twitter, instagram etc.).
* You can quickly share your contents without website, blog and e-mail.
* You don't need to create any Account to share a note. As you wish you can use quick, easy and best shortened notes with sms, websites, e-mail, or messaging services (WhatsApp, iMessage, Telegram, Signal).
* Notes.io has fabulous infrastructure design for a short link and allows you to share the note as an easy and understandable link.

Fast: Notes.io is built for speed and performance. You can take a notes quickly and browse your archive.

Easy: Notes.io doesn’t require installation. Just write and share note!

Short: Notes.io’s url just 8 character. You’ll get shorten link of your note when you want to share. (Ex: notes.io/q )

Free: Notes.io works for 12 years and has been free since the day it was started.

You immediately create your first note and start sharing with the ones you wish. If you want to contact us, you can use the following communication channels;

Email: [email protected]

Twitter: http://twitter.com/notesio

Instagram: http://instagram.com/notes.io

Facebook: http://facebook.com/notesio

Regards;
Notes.io Team

Notes

Notes - notes.io

Shortened Note Link

Long File

Notes