Googleドライブにある画像の直リンクをクリップボードにコピーする

前回の、Googleドライブにある画像の直リンク取得だが、
使用回数重ねるうちに思ったのは、いちいちダイアログからコピーするのが
億劫だってこと。

修正自体はリザルト先を入力ダイアログからクリップボード
変えるだけだし一先ず直してみる。
とは言え、これで使い易くなるのかどうかピンと来ないんだけども…。

尚、VBSでクリップボードへのコピーはここを参考にした。

clipコマンドを利用してクリップボードに文字列をコピーするVBScript | 初心者備忘録

動作はclipコマンドを使い実現しているので、
扱う文字列にコマンドプロンプトのエスケープ文字「 "|<>&」が
入り込まないことが約束されている場合のみ取り入れると良さ気。

仮にエスケープ文字を含む文字列をクリップボードにコピーしたいなら、
InternetExplorerオブジェクトを使ったこちらの解説が役立つだろう
(ソース見ると分かるが、力技なアプローチ。)。

クリップボードに文字列をコピーする | 初心者備忘録


●操作手順

1.Googleドライブにある画像を右クリック
2.「共有可能なリンクを取得」から表示されるリンクを選択してCtrl+Cでコピー
3.VBSを実行して直リンクをクリップボードへセット
4.クリップボードにコピーされた直リンクを貼り付ける等して使用


GoogleDriveCreatePermalink.vbs

Option Explicit

Const TITLE = "Googleドライブ画像、直リンク生成"
Const VERSION = "Ver1.10"
Const RELEASE = #2017/04/30#
Const AUTHOR = "REGEKATSU"

'元URL
Const SEARCH_TEXT = "https://drive.google.com/open?id="
'加工URL
Const REPLACE_TEXT = "https://drive.google.com/uc?id="
'完了メッセージ表示時間(秒)
Const WAIT_TIME = 5

Dim clipText
Dim putText

'クリップボードのテキストデータを確認する
clipText = GetClipboardText()

'クリップボードが空なら終了する
If IsNull(clipText) Then
    WScript.Echo "貼り付けるデータがありません。" & vbCrLf & _
        "とりあえず、何かコピーしてください。。。"
    WScript.Quit
    
'クリップボードに共有リンクが含まれていなければ終了する
ElseIf InStr(clipText, SEARCH_TEXT) <= 0 Then
    WScript.Echo "貼り付けるデータが正しくありません。" & vbCrLf & _
        "共有可能なリンクを取得からコピーしてください。。。"
    WScript.Quit
    
End If

'Googleドライブ内画像の共有可能なリンクから直リンクを生成する
putText = Replace(clipText, SEARCH_TEXT, REPLACE_TEXT)

'クリップボードへテキストデータをセットする
SetClipboardText putText

'完了メッセージを一定時間表示する
CreateObject("WScript.Shell").Run _
    "cmd /c echo " & TITLE & " " & VERSION & " & " & _
    "echo 共有可能なリンクから直リンクを生成しました。 & " & _
    "echo 直リンク: " & putText & " & " & _
    "echo; & " & _
    "echo ※この画面は " & WAIT_TIME & " 秒後に閉じます... & " & _
    "ping -n " & WAIT_TIME & " localhost > nul", 1

WScript.Quit


'サブルーチン

'クリップボードのテキストデータを取得する。なければNullを返す。
Function GetClipboardText()
    Dim objHTML
    Set objHTML = CreateObject("htmlfile")
    GetClipboardText = Trim(objHTML.ParentWindow.ClipboardData.GetData("text"))
    Set objHTML = Nothing
End Function

'クリップボードへテキストデータをセットする。
Sub SetClipboardText(ByVal str)
    Dim cmd
    cmd = "cmd /c ""echo " & str & "| clip"""
    CreateObject("WScript.Shell").Run cmd, 0, True
End Sub