Created
October 17, 2012 08:14
-
-
Save yanping/3904334 to your computer and use it in GitHub Desktop.
upload image file to imgur.com
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
require(utils) | |
require(tcltk) | |
require(RCurl) | |
img.upload <- function(){ | |
if(any(ls(envir=.GlobalEnv)=="fileName")) { | |
rm(fileName,envir=.GlobalEnv) | |
} | |
if(any(ls(envir=.GlobalEnv)=="uploadInfo")) { | |
rm(uploadInfo,envir=.GlobalEnv) | |
} | |
ttMain <- tktoplevel() | |
tkwm.title(ttMain,"imgur uploader") | |
select.file <- function(){ | |
Filters <- matrix(c("图片", ".jpg", "图片", ".jpeg", | |
"图片", ".bmp","图片", ".png","图片", ".tiff", "All files", "*"), | |
6, 2, byrow = TRUE) | |
if(interactive()) fileName <- tk_choose.files(filter = Filters) | |
if (!length(fileName)) { | |
tkmessageBox(message="没有选择文件,请选择!") | |
return | |
}else{ | |
assign("fileName",fileName,envir=.GlobalEnv) | |
tkmessageBox(message="选择完毕") | |
} | |
} | |
imgur_uploader <- function(fileName) { | |
key = '60e9e47cff8483c6dc289a1cd674b40f' | |
if(!any(ls(envir=.GlobalEnv)=="fileName")) { | |
tkmessageBox(message="请先选择文件") | |
stop('请先选择文件') | |
} | |
params = list(key = key, image = RCurl::fileUpload(fileName)) | |
res = XML::xmlToList(RCurl::postForm("http://api.imgur.com/2/upload.xml", .params = params)) | |
if (is.null(res$links$original)) { | |
tkmessageBox(message="failed to upload") | |
stop('failed to upload ', fileName) | |
} | |
uploadInfo <- structure(res$links$original, XML = res) | |
assign("uploadInfo",uploadInfo,envir=.GlobalEnv) | |
tkmessageBox(message="上传完毕") | |
} | |
showHTML <-function(){ | |
if(!any(ls(envir=.GlobalEnv)=="uploadInfo")) { | |
tkmessageBox(message="请先上传图片") | |
stop('请先上传图片') | |
} | |
ttImage <- tktoplevel() | |
tkwm.title(ttImage,"图片HTML代码") | |
tkfocus(ttImage) | |
uri.original <- attr(uploadInfo,"XML")$links$original | |
imageHtml.original <- tclVar(paste("<img src=\"",uri.original,"\" />",sep="")) | |
label.original <- tklabel(ttImage,text="图片HTML") | |
entryHtml.original <-tkentry(ttImage,width = 80,textvariable = imageHtml.original) | |
tkgrid(label.original,entryHtml.original) | |
uri.small_square <- attr(uploadInfo,"XML")$links$small_square | |
imageHtml.small_square <- tclVar(paste("<img src=\"",uri.small_square,"\" />",sep="")) | |
label.small_square <- tklabel(ttImage,text="小方图HTML") | |
entryHtml.small_square <-tkentry(ttImage,width = 80,textvariable = imageHtml.small_square) | |
tkgrid(label.small_square,entryHtml.small_square) | |
uri.large_thumbnail <- attr(uploadInfo,"XML")$links$large_thumbnail | |
imageHtml.large_thumbnail <- tclVar(paste("<img src=\"",uri.large_thumbnail,"\" />",sep="")) | |
label.large_thumbnail <- tklabel(ttImage,text="大缩略图HTML") | |
entryHtml.large_thumbnail <-tkentry(ttImage,width = 80,textvariable = imageHtml.large_thumbnail) | |
tkgrid(label.large_thumbnail,entryHtml.large_thumbnail) | |
btn.quit1 <- tkbutton(ttImage,text="退出",command = function()tkdestroy(ttImage)) | |
tkgrid(btn.quit1) | |
} | |
btn.select <- tkbutton(ttMain,text="选择文件",command = select.file) | |
btn.upload <- tkbutton(ttMain,text="上传图片",command = function() imgur_uploader(fileName)) | |
btn.showHTML <- tkbutton(ttMain,text="显示HTML",command = showHTML ) | |
btn.showInfo <- tkbutton(ttMain,text="显示信息",command = function() print(uploadInfo)) | |
btn.quit2 <- tkbutton(ttMain,text="退出",command = function()tkdestroy(ttMain)) | |
tkgrid(btn.select,btn.upload,btn.showHTML,btn.showInfo,btn.quit2) | |
} | |
winMenuAdd("上传图片") | |
winMenuAddItem("上传图片", "载入程序", "img.upload()") |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
firefox还有imgur的插件 网站在国内还经常有问题