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 hidden or 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
槽点多，没空写。你还是让肖楠来点评吧。我不明白为什么要写这个GUI包装程序，如果网站没问题的话，只需要把文件往浏览器里一拖就可以了。