削除フォト一括管理(vbs)：遊ぶ大人の非常識 by きのこ組：SSブログ

	ブログをはじめるログイン

削除フォト一括管理(vbs)　[スクリプト言語など] [編集]

「フォトフォルダ」を、このVBSファイルへ「ドラッグ&ドロップ」すると、以下３階層までのサブ領域を検索し、「指定拡張子のイメージ」かつ　「指定サイズ以下」のファイルのみ、リンクアップするという優れものっす。　

なおページからは、イメージをクリックして選択した後、DELボタンで、フォルダからの永久削除が可能。

右クリックでは、フォルダを開きますが、現在、エラーが良く出てまして機能しない事が多発。m(_ _;;)m

VBSファイルの作り方は、例によって下のエリアのソースを「新規テキストファイル」へ丸ごとコピーし、「○○○.VBS」と変名保存するだけです。

Dim objArgs,fso,PH,PFF,exn,f,f1,fc,s,n,nx,Ex,P,G,ZZ,B,C,FFF,D,R,GPyURL,X,stream1,MF2,MyST,stm,ie,IGSZ
    P=64          '// １枚のHTMLに表示する枚数
    IGSZ=153600   '// 検索対象イメージの最大サイズ  ※153600は、150KBです。

Set Shell = CreateObject("WScript.Shell")
    Dtp = Shell.SpecialFolders("Desktop")
 Set fso = CreateObject("Scripting.FileSystemObject")

Set objArgs = WScript.Arguments
     For I = 0 to objArgs.Count - 1
         PH = objArgs(I)
     Next
     Set f = fso.GetFolder( PH )

n = 0  
 nx = 0
Ex="jpg"

Set fc = f.Files
         For Each f1 in fc
             exn = fso.GetExtensionName(f1)
             if Ex= Lcase(exn) And f1.size < IGSZ then
             PF = InstrRev(f1.ParentFolder,"\")
             PFF = Mid(f1.ParentFolder, PF+1)
             n = n + 1
             nx = nx + 1
             if nx > P then nx = 1 end if  
f1PF = Rep("\\", "/",f1.ParentFolder)
s=s&"<img id=C" &nx& " onError=At('C" &nx& "') onmousedown=OpenIMG('"&f1PF&"') onclick=sGy('C" &nx& "') ondblclick=sGx('C" &nx& "') src='" &f1.path& "'><input id='cx' Name='CiX' type='checkbox' value='" &f1.path& "'>" & VbCrLf
             End if
         Next
     Set fc = f.SubFolders
         For Each f1 in fc
             Set f1s = fso.GetFolder(f1.Path)
                 Set fcs = f1s.Files
                     For Each f2 in fcs
                         exn = fso.GetExtensionName(f2)
                         if Ex= Lcase(exn) And f2.size < IGSZ then
                         PF = InstrRev(f2.ParentFolder,"\")
                         PFF = Mid(f2.ParentFolder, PF+1)
                         n = n + 1
                         nx = nx + 1
                         if nx > P then nx = 1 end if 
f2PF = Rep("\\", "/",f2.ParentFolder)
s=s&"<img id=C" &nx& " onError=At('C" &nx& "') onmousedown=OpenIMG('"&f2PF&"') onclick=sGy('C" &nx& "') ondblclick=sGx('C" &nx& "') src='" &f2.path& "'><input id='cx' Name='CiX' type='checkbox' value='" &f2.path& "'>" & VbCrLf
                         End if 
                     Next

Set fcs = f1s.SubFolders
                     For Each f2 in fcs
                         Set f2s = fso.GetFolder(f2.Path)
                             Set fcc = f2s.Files
                                 For Each f3 in fcc
                                     exn = fso.GetExtensionName(f3)
                                     if Ex= Lcase(exn) And f3.size < IGSZ then
                                     PF = InstrRev(f3.ParentFolder,"\")
                                     PFF = Mid(f3.ParentFolder, PF+1)
                                     n = n + 1
                                     nx = nx + 1
                                     if nx > P then nx = 1  end if 
f3PF = Rep("\\", "/",f3.ParentFolder)
s=s&"<img id=C" &nx& " onError=At('C" &nx& "') onmousedown=OpenIMG('"&f3PF&"') onclick=sGy('C" &nx& "') ondblclick=sGx('C" &nx& "') src='" &f3.path& "'><input id='cx' Name='CiX' type='checkbox' value='" &f3.path& "'>" & VbCrLf
                                     End if
                                  Next
                     Next
         Next

if(fso.FolderExists( Dtp & "\DROPv" )) then 
    Set MyF = fso.GetFolder( Dtp & "\DROPv" )
        MyF.Delete(True)
    fso.CreateFolder(Dtp & "\DROPv")
  else
    fso.CreateFolder(Dtp & "\DROPv")
 End if
 
   Set MF = fso.CreateTextFile(Dtp & "\DROPv\GpyLIST.txt", True)
       MF.WriteLine( s )
       MF.Close

G = n/P
    ZZ = Int(G)
    B = n - P*ZZ
    FFF = Dtp & "\DROPv"
    Const ForReading=1, ForWriting=2, ForAppending=8
    Set fu = fso.OpenTextFile(FFF & "\GPyLIST.txt", ForReading)

For C = 0 To ZZ
   Set stream = fso.CreateTextFile(FFF & "\PhotoStage(" & (100+c) & ").htm", True)
   stream.Close

Set stream1 = fso.OpenTextFile(FFF & "\PhotoStage(" & (100+C) & ").htm", ForAppending)
     stream1.WriteLine( "<!DOCTYPE HTML PUBLIC '-//W3C//DTD HTML 4.0 Transitional//EN'>" )
     stream1.WriteLine( "<html><head><title>PhotoStage(" & (100+C) & ")_byGUPPY.^<^</title></head>" )
     stream1.WriteLine( "<link rel='stylesheet' href='./_MySTYLE.css' type='text/css'>" )
     stream1.WriteLine("<BODY bgcolor='#111111' topmargin='0' leftmargin='0'>" )
     stream1.WriteLine( "<script language='JavaScript'>" )
     stream1.WriteLine("function At(idx) { //alert(idx); " )
     stream1.WriteLine("document.images[idx].style.width='0'; document.images[idx].style.height='0'; }" )
     stream1.WriteLine( "</script>" )
     stream1.WriteLine("<FORM Name='GPyFM'>" )
 
     if C = ZZ then 
        D = B 
        For X = 1 To D
            R = fu.ReadLine
            stream1.WriteLine( R )
        Next
        GPyURL=GPyURL&"document.write( "&CHR(34)&"<tr><td><a class='GPymeu' href='PhotoStage("&(100+C)&").htm'>PhotoStage("&(100+C)&")</a></td></tr>" & CHR(34) &" );" & vbCrLf
        stream1.WriteLine( "<span id='x'><input type='button' id='db' value='▲ ImgDELTE ▼' Name=DELIMG title='選択したイメージを削除する。'></span></FORM>" )
        stream1.WriteLine( "<Script Language='VBScript' src='_imgDELTE.VBS'></Script>" )
        stream1.WriteLine( "<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 id='GPyLink'>" )
        stream1.WriteLine( "<script language='JavaScript' src='_GPyURL.js'></Script>" )
        stream1.WriteLine( "</TABLE></body></html>" )
        stream1.Close
     else 
        D = P
        For X = 1 To D
            R = fu.ReadLine
            stream1.WriteLine( R )
        Next
        GPyURL=GPyURL&"document.write( "&CHR(34)&"<tr><td><a class='GPymeu' href='PhotoStage("&(100+C)&").htm'>PhotoStage("&(100+C)&")</a></td></tr>" & CHR(34) &" );" & vbCrLf
        stream1.WriteLine( "<span id='x'><input type='button' id='db' value='▲ ImgDELTE ▼' Name=DELIMG title='選択したイメージを削除する。'></span></FORM>" )
        stream1.WriteLine( "<Script Language='VBScript' src='_imgDELTE.VBS'></Script>" )
        stream1.WriteLine( "<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 id='GPyLink'>" )
        stream1.WriteLine( "<Script Language='JavaScript' src='_GPyURL.js'></Script>" )
        stream1.WriteLine( "</TABLE></body></html>" )
        stream1.Close
     End if
Next
fu.Close

Set MF2 = fso.CreateTextFile(Dtp & "\DROPv\_GPyURL.js", True)
    MF2.WriteLine( GPyURL )
    MF2.WriteLine( "if(document.GPyFM.elements[0].value !== '▲ ImgDELTE ▼'){" )
    MF2.WriteLine( "v='';" )
    MF2.WriteLine( "for(a=0; a < document.GPyFM.CiX.length; a++) { v= v+','+document.GPyFM.elements[a].checked;" )
    MF2.WriteLine( "if(!document.GPyFM.elements[a].checked) document.GPyFM.elements[a].checked=true; status= v; } }" )
    MF2.WriteLine( "else { status='OVER RAN : DROPv内のリストを確認してみてくださいませ。!!'; }" )
    MF2.WriteLine("function xLAY(){ obj='GPyLink'; obx='x'; Lef= parseInt('0'); Tp= parseInt('4');" )
    MF2.WriteLine("if(document.all) { document.all(obx).style.pixelTop = parseInt(document.body.scrollTop + Tp);" )
    MF2.WriteLine("                   document.all(obj).style.pixelTop = parseInt(document.body.scrollTop + Tp); } }" )
    MF2.WriteLine("window.onresize=xLAY;window.onload=xLAY;window.onscroll=xLAY;" )
    MF2.WriteLine("function sGy(s){ i = s.slice(1,(s.lenght)); status=i" )
    MF2.WriteLine("document.GPyFM.elements[i-1].checked = false;" )
    MF2.WriteLine("if(document.all){ document.all(s).style.border='2 solid #FF20A6'; } }" )
    MF2.WriteLine("function sGx(s){ i = s.slice(1,(s.lenght)); status=i" )
    MF2.WriteLine("document.GPyFM.elements[i-1].checked = true;" )
    MF2.WriteLine("if(document.all){ document.all(s).style.border='2 solid #000000'; } }" )
    MF2.WriteLine("function OpenIMG(ev)" )
    MF2.WriteLine("{ if(event.button==2) { " )
    MF2.WriteLine("webA=window.open(ev,'','width=500,height=300,scrollbars=yes,resizable=yes,menubar=no,toolbar=no,status=yes');" )
    MF2.WriteLine("/*webA.location.href = document.all[ev].src;*/ } }" )
    MF2.WriteLine("function ctmenuOff()" )
    MF2.WriteLine("{ event.cancelBubble=true;" )
    MF2.WriteLine("  event.returnValue =false; return false; } document.oncontextmenu = ctmenuOff;" )
    MF2.Close

Set  MyST = fso.CreateTextFile(Dtp & "\DROPv\_MySTYLE.css", True)
     MyST.WriteLine( "img { /*width:100%;*/ border:2 solid #000000; }" )
     MyST.WriteLine( "#GPyLink { position:absolute; top:3; Right:0; }" )
     MyST.WriteLine( "#x { position:absolute; top:1; left:3;  }" )
     MyST.WriteLine( "#db { width:125; height:28; border:1 solid #ffffff; font-size:15; background-color:transparent;" )
     MyST.WriteLine( "      color:#ff0000; border-color:#ffffff #FF408C #FF408C #ffffff; font-weight:900; }" )
     MyST.WriteLine( " #cx { display:none; }" )
     MyST.WriteLine( "A.GPymeu       { text-align:center; width:110; padding:0 5 0 5; background-color:transparent; color:#f0f0f0; font-size:13px;}" )
     MyST.WriteLine( "A.GPymeu:hover { text-align:center; width:110; padding:0 5 0 5; background-color:#ffdab9; color:#FF0066; }" )
     MyST.WriteLine( "A.GPymeu:active{ text-align:center; width:110; padding:0 5 0 5; background-color:#f0f0f0; color:#999999; }" )
     MyST.Close

Set  stm = fso.CreateTextFile(Dtp & "\DROPv\_imgDELTE.VBS", True)
    'stm.WriteLine("<Script Language='VBScript'></Script>" )
     stm.Close

Set ie= WScript.CreateObject("InternetExplorer.Application")
    ie.Navigate(FFF & "\PhotoStage(100).htm")
    ie.Width = 400
    ie.Height= 300
    ie.AddressBar = False 
    ie.MenuBar = True  
    ie.ToolBar = True
    ie.StatusBar = True 
    ie.Visible = True

Function Rep(patrn, St,st1)
Dim A
 Set A = New RegExp
     A.Pattern = patrn 
     A.IgnoreCase = True
     A.Global = True
 Set C = A.Execute(st1)
     For Each B in C 
         Rep = A.Replace(st1, St)
     Next
End Function

一応、XP-SP3 で動作確認済みですが、エラー対策などしていません。そんな関係で、取り扱いに関しては、責任負いかねますので、自己責任でお願い致します。

PS : このスクリプトは、ディスクトップ上に作業用領域を少し使用しますので、ご注意くださいませ。^_^;

2008-05-31 03:00 nice!(1) コメント(1) トラックバック(0)
共通テーマ：日記・雑感