Get partial format image as long as VBScript and AdoDb.Steam

Function Bytes2bStr (vin) if lenb (vin) = 0 thenBytes2bStr = "" exit functionend if '' is converted to a binary string Dim BytesStream, StringReturnSet BytesStream = Server.CreateObject ( "ADODB.Stream") BytesStream.Type = 2 BytesStream.OpenBytesStream .WriteText vinBytesStream.Position = 0BytesStream.Charset = "gb2312" BytesStream.Position = 2StringReturn = BytesStream.ReadTextBytesStream.closeSet BytesStream = NothingBytes2bStr = StringReturnEnd FunctionFunction binVal (bin) Dim iDim ret: ret = 0for i = lenb (bin) to 1 step -1ret = RET * 256 ASCB (MIDB (BIN, I, 1)) NEXTBINVAL = REND FUNCTIONFUNCTION BINVAL2 (BIN) DIM IDIM RET: RET = 0for i = 1 to lenb (bin) RET = RET * 256 ASCB (MIDB (bin, i, 1)) Nextbinval2 = RETEND FUNCTIONFUNCTION GETIMAGEWH (fdata) 'A streptimeter fdata, binary image data (as for how to read the binary data of the image, don't say it --_-!)' Return value is An array, 3 elements, in the picture format. Long. Wide DIM RET (2), BFLAG, FSIZE, ADOSFSIZE = ClNG (lenb (fdata)) 'acquired data size if fsize = 0 THEN EXIT FUNCTIONSET ADOS = Server.createObject ("AdoDb.Stream") ads.type = 1 ads.mode = 3 ads.openados.write fdataados.position = 0 'Write text object read image length and type AdoS.position = 0 'Reset Data Start Position Bflag = Ados.Read (3) IF ISNULL (BFLAG) THEN RET (0) = "Unknow" Ret (1) = 0 Ret (2) = 0GetImageWh = Retexit FunctionEnd IF' File type and long width Select Case HEX (binval (bflag)) Case "4E5089": ads.read (15) RET (0) = "PNG" RET (1) = binval2 (ADOS.READ (2)) ads.read (2) RET (2) = binval2 (ads.read (2)) Case "464947": ads.read (3) RET (0) = "gif" ret (1) = binval (ads.read (2)) RET (2) = binval (ads.read (2)) Case "FFD8FF": DIM P1DO Do: P1 = binval (ADOS.READ (1)): loop while p1 =

255 and not ads.eosif P1> 191 and P1 <196 Then Exit do else ads.read (binval2 (ads.read (2)) - 2) DO: P1 = binval (ads.read (1)): loop while p1 <255 and not ads.EOSLOOP while Trueados.read (3) RET (0) = "jpg" RET (2) = binval2 (adoS.read (2)) RET (1) = binval2 (ads.read (2)) Case Else: if Left (Bytes2bstr (Bflag), 2) = "BM" THENADOS.READ (15) RET (0) = "BMP" RET (1) = binval (adoS.read (4)) RET (2) = BINVAL (ADOS.READ (4)) Elseret (0) = "" END iFADOS.Closset Ados = Nothingend SelectSelect Case Ret (0) Case "PNG", "JPG", "BMP", "GIF" RET (1) = RET (1) RET (2) = RET (2) RET (0) = RET (0) Case Elseret (1) = 0RET (2) = 0RET (0) = "unknow" end selectgetimagewh = retend functionfunction getWebdata (StrURL) 'get the picture binary data on Error on the INTERNET Resume Nextif strUrl = "" thenGetWebData = "" exit functionend ifdim tempStrtempStr = split (strUrl, "/") if tempStr (ubound (tempStr)) = "" or inStr (strUrl, " / ") = 0 THENGETWEBDATA =" "EXIT functionend ifdim retrievalset retrieval = server.createObject (" Microsoft.xmlhttp ") with retrieval.open" get ", strurl, false,", "" ".send GetWebdata = .responsebodynd withset retrieval = Nothingif err.Number <> 0 Then Err.clerend Function

<% @Language = "vbscript" CODEPAGE = "936"%> <% OPTION EXPLICITCLASS boxinfoimg 'Transfer class "Image Upload and Upload Information Get Class' Usage: 'DIM IMGUP'SET IMGUP = New BoxInfoImg' Properties: 'imgup.width' wide 'imgup.height' high 'image' IMGUP.IMGTYPE 'Type' IMGUP.IMGNAME 'File name' imgup.imgname 'image file name: "&' imgup.filename 'file name" & 'imgup.extname' extension "'image"' image "'image"' image "'image"' imgup.newur 'After saving URL "' IMGUP.SAVEMODE 'Save URL":' Imgup.saveImg (fullpath) 'save the image file dim ADOSdim width, height, imgSize, imgType, imgName, fileNamedim preName, extNamedim SavePath, SaveName, SaveModedim diskPath, XuPath, NewUrldim textStrdim iPrivate Sub Class_Initializeset ADOS = Server.CreateObject ( "Adodb.Stream") ADOS .Type = 1 ADOS.Mode = 3 ADOS.Open getImageSizeEnd SubPrivate Sub Class_TerminateADOS.closeset ADOS = nothingEnd SubPublic Function getImageSize () dim ret (3), bFlag, fdata, fsizefdata = GetWebData (GetStrUrl) 'data acquired XmlHttp fsize = clng ( LeNB (fdata)) 'gets data size if fsize = 0 THEN EXIT FUNCTION R_WRITE "No Control Data Save", 0nd iFADOS.WRITE FDATA ADOS.POSITION = 0sAVename = IsAVenameSavePath = ISA VEPATHSAVEMODE = ISAVEMODE 'Write text object read image long width and type adoS.position = 0' Reset data start position bflag = ads.read (3) if isnull (bflag) Then width = 0HEight = 0imgsize = 0imgType = "unknow" RET (0) = imgtype: RET (1) = width: RET (2) = height: ret (3) = "" GetImagesize = Retexit FunctionEnd IF 'Take the file type and long width Select Case HEX (binval (bflag)) Case "4E5089": ads.read (15) RET (0) = "png" RET (1) = binval2 (ads.read (2)) ads.read (2) RET (2) =

Binval2 (ADOS.READ (2)) Case "464947": ads.read (3) RET (0) = "gif" Ret (1) = binval (ads.read (2)) RET (2) = bint (ADOS .read (2)) Case "FFD8FF": DIM P1DO DO: P1 = binval (ads.read (1)): loop while p1 = 255 and not ads.eosif p1> 191 and P1 <196 Then Exit do else adoS. Read (BINVAL2) - 2) DO: P1 = binval (ads.read (1)): loop while p1 <255 and not ads.EOSLOOP While Trueados.Read (3) Ret (0) = "JPG" RET (2) = binval2 (ads.read (2)) RET (1) = binval2 (ADOS.READ (2)) Case ELSE: if LEFT (Bin2Str (BFLLAG), 2) = "BM" THENADOS. READ (15) RET (0) = "BMP" RET (1) = binval (ads.read (4)) RET (2) = binval (adoS.read (4)) Elseret (0) = "" End Gend Select 'dim tempStrdim nameStrdim defaultNamedim lntempStr = split (GetStrUrl, "/") nameStr = tempStr (ubound (tempStr)) if nameStr = "" thenr_write "wrong URL, enter accessible URL", 0exit functionend iffileName = split (nameStr , "?") (0) ln = INSTRREV (FileName, ".") IF ln> 0 Then PRENAME = Left (filename, INSTRRRRREV (FileName, ".") - 1) ElsePrename = filenamend if'r_write filename, 1 ' R_Write Instrrev (filename, "."), 1'R_Write FileName, 0exTName = Right (FileName, Len (FileName) - INSTRRREV (Filename, ")) Select Case Ret (0) Case" PNG "," JPG "," BMP "," GIF ", ****" Width = RET (1) Height = RET (2) Imgsize = fsizeimgType = ret (0) imgName = preName & "." & ret (0) case elsewidth = 0height = 0imgSize = fsizeimgName = "unknow" imgType = ". unknow" end selectif SaveMode = "1" thendefaultName = imgNameif SaveName = "" then Savename = DefaultNameElseif Lcase (Right (Savename, 4)) <> "&

imgType thenSaveName = SaveName & "." & imgTypeend ifend ifelsedefaultName = filenameend ifif SaveName = "" then SaveName = defaultNameSavePath = replace (SavePath, "//", "/") if right (SavePath, 1) <> "/" then SavePath = SavePath & "/" if SavePath = "" "DiskPath =" = Server.mappath (SavePath & Savename) xipath = Replace (Replace (DiskPath, Server.mAppath ("/"), ""), "/", " /")NewUrl="http://";&Request.ServerVariables("SERVER_NAME")&XuPathgetimagesize=retEnd FunctionPublic function SaveImg (fullPath) SaveImg = falseif SaveMode = "1" thenif trim (fullpath) = "" or _width = 0 or _ height = 0 or _imgSize = 0 or _imgType = ". unknow" then exit function end ifend ifADOS.Position = 0if SaveMode = "2" thenADOS.Type = 2ADOS.Charset = "gb2312" ADOS.SaveToFile FullPath, 2textStr = ADOS. Readtext () Elseados.savetofile Fullpath, 21nd ifsaveimg = TrueEnd FunctionPrivate Function Bin2Str (BIN) DIM I, STR, CLOWFOR I = 1 to lenb (bin) CLOW = MIDB (BIN, I, 1) IF ASCB (CLOW) <128 Thestr = STR & CHR (ASCB (CLOW) ELSEI = I 1IF I <= lenb (bin) THEN STR = STR & CHR (ASCW (MIDB (BIN, I, 1) & CLOW) End ifnext bin2str = strend functionprivate function Num2str (NUM, BAS, LENS) DIM RET: RET = "" "RET = (NUM Mod Base) & Retnum = (Num - Num MOD BASE) / BaseWendNum2Str = Right (String (Lens, "0") & NUM & RET, LENS) End FunctionPrivate Function Str2Num (Str, Base) DIM RET: RET = 0for I = 1 To Len (Str) RET = RET * BASE CINT (MID (STR , i, 1)) NextStr2Num =

RETEND FUNCTIONPRIVATE FUNCTION BINVAL (BIN) DIM RET: RET = 0for i = lenb (bin) to 1 step -1ret = RET * 256 ASCB (MIDB (BIN, I, 1)) NEXTBINVAL = REND FUNCTIONPRIVATE FUNCTION BINVAL2 (BIN) DIM RET: RET = 0for i = 1 to lenb (bin) RET = RET * 256 ASCB (MIDB (BIN, I, 1)) Nextbinval2 = Retend FunctionPrivate function getWebdata (Byval Strurl) if strurl = "" "" "" "" "" "" , 1exit functionend ifdim tempStrtempStr = split (GetStrUrl, "/") if tempStr (ubound (tempStr)) = "" or inStr (strUrl, "/") = 0 thenR_Write "valid URL is not specified", 0exit functionend ifdim RetrievalSet Retrieval = Server.CreateObject ( "Microsoft.XMLHTTP") With Retrieval.Open "Get", strUrl, False, "", "" .SendGetWebData = .ResponseBodyEnd WithSet Retrieval = NothingEnd Function End Class%> <% SUB saveUpload (GetUrl, SavePath , Savename, MODE) DIM Chkinfoif getURL = "" The call tform () r_write "
"
"", 0nd ifset imgup = new boxinfoimgif mode = "1" and imgup.imgname = "unknow" thencall tform () set imgup = nothingr_write "
Transport File Bar Not fill in the valid image URL!", 0nd ifchkinfo = "" DIM I, TESTSTSTR, SHOWSTR 'Limited Format Select Case IMGUP.IMGTYPECASE "PNG", "JPG", "BMP", "GIF" if imgup.width = 0 or imgup.height = 0 or imgup.imgsize = 0 THEN CHKINFO = "

" "transmission Image data does not exist, please determine if your URL correct "end ifcase else chkinfo ="

invalid transmission format, allowing the image data format to be "" PNG "," JPG "," "BMP", "GIF" "End select'r_write savepath, 1'r_write mode, 1'r_write imgup.imgname, 1 '

R_Write Imgup.FileName, 1 'R_Write "Savename =" & Savename, 1IF Mode = "1" and chkinfo <> "" "" "THEN' After the upload image data is passed, the call tform () r_write chkinfo, 0ELSERVER.ScriptTimeout = 5000Imgup .saveimg imgup.diskpath endiff '------------- r_write " === Processing Results part of the information ===
", 1R_Write "wide:" & IMGUP.WIDTH & "PIX", 1R_Write "High:" & Imgup.Height & "PIX", 1R_Write "Size:" & FormatNumber (Imgup.imgsize / 1024, 2, -1) & "KB", 1R_WRITE "format:" & IMGup.Imgtype " , 1R_Write "Image Name:" & Imgup.Imgname, 1R_Write "file name:" & imgup.filename, 1R_write "extension:" & imgup.extName, 1R_Write "save location:" & imgup.diskpath, 1r_write "virtual path:" & imgup. XUPATH, 1R_WRITE "After saving URL:" & imgup.newurl, 1call tform () set imgup = Nothing r_write "----------------------
After transfer, 0nd subsub tform ()%>

Get URL:
Save Path:
Save File Name: > Web image

% if isavemode = "2" THEN Response.write "Checked" end if% >> Text file > binary data

---

<% if getStrURL <>" "Thenif isavemode =" 2 "THENR_WRITE" Run this code , 1r_write "" & server.htmlencode (imgup.textstr) & "</ textarea>", 1ELSER_WRITE "<img src =" "" "" "" "" "" "" "" "" "" "" "" "& imgup.xupath &"? "& Timer () & "" width = "& imgup.width &" height = "& imgup.height &" alt = "& imgup.imgname &"> ", 1END IFEND IF%> </ form> <hr size = 1> <br> For the image, do not add the presentation name, automatic identification, if the added extension is not returned to automatically add <br> Save file path to freeware Save in the current path <br> Save file name to use automatic identification The file name <br> Saved as other way, HTML <% end subsuB r_write (str, num) DIM ISTR: ISTR = STRDIM inum: ISTR = STRDIM inum: ISTR = strdim inum: ISTR = strdim inum: ISTR = STRDIRITE STR & "<br> "if inum = 0 Then Response.Endend Sub '================= Call process EXECUTE =================== =====%> <! Doctype html public "- // w3c // DTD H TML 4.0 Transitional // En "> <</p> <p>HTML> <head> <title> new document </ title> <meta name = "generator" content = "editplus"> <meta name = "author" content = "v37"> <meta name = "keywords" content = " "> <Meta name =" description "content ="> <script language = "javascript"> <! - / * function runcode () {var code = event.srcelement.parentelement.children [0] .value; var Newwin = *********** ('', '', '); newwin.document.close (); newwin.document.close ();} function setsmiley What) {document.postform.comment.Value = "" what; document.postform.comment.focus ();} * / function runcode (NUM) // Run code html {// var code = event.srcelement. Parentelement.children [0] .Value; if (num == 1) {var code = window.form2.code.innertext;} if (num == 0) {var code = window.form2.content.innerText;} var NEWIN = *********** ('', '', ''); newwin.document.close (); newwin.document.close ();} // > </ Script> </ head> <body> <% DIM IMGUP 'Transfer Object DIM GetStrull' To get the image or web page URLDIM IsaveName 'To save the name DIM IsavePath' To save the virtual path DIM IsaveMode 'Save mode 1 For image 0 is any file isavepath = trim (Request.form ("SAV EPATH ")) isavename = trim (Request.form (" Savename ")) GetStrURL = Trim (Request.form (" getStrurl ")) isavemode = trim (Request.form (" Savemode ") IF GetStrurl <>" "" SaveUpload (getStrurl, IsavePath, Isavename, Isavemode) Call TForm () elsecall tform () end if%> </ body> </ html> This upgrade is done by the rain 37 of the Net Builder Alliance. You can distinguish three kinds of download images / text files / binary data. The real type of the image can also be read for the image and the length width of the image.</p></div><div class="text-center mt-3 text-grey"> 转载请注明原文地址:https://www.9cbs.com/read-128692.html</div><div class="plugin d-flex justify-content-center mt-3"></div><hr><div class="row"><div class="col-lg-12 text-muted mt-2"><i class="icon-tags mr-2"></i><span class="badge border border-secondary mr-2"><h2 class="h6 mb-0 small"><a class="text-secondary" href="tag-2.html">9cbs</a></h2></span></div></div></div></div><div class="card card-postlist border-white shadow"><div class="card-body"><div class="card-title"><div class="d-flex justify-content-between"><div><b>New Post</b>(<span class="posts">0</span>) </div><div></div></div></div><ul class="postlist list-unstyled"> </ul></div></div><div class="d-none threadlist"><input type="checkbox" name="modtid" value="128692" checked /></div></div></div></div></div><footer class="text-muted small bg-dark py-4 mt-3" id="footer"><div class="container"><div class="row"><div class="col">CopyRight © 2020 All Rights Reserved </div><div class="col text-right">Processed: <b>0.040</b>, SQL: <b>9</b></div></div></div></footer><script src="./lang/en-us/lang.js?2.2.0"></script><script src="view/js/jquery.min.js?2.2.0"></script><script src="view/js/popper.min.js?2.2.0"></script><script src="view/js/bootstrap.min.js?2.2.0"></script><script src="view/js/xiuno.js?2.2.0"></script><script src="view/js/bootstrap-plugin.js?2.2.0"></script><script src="view/js/async.min.js?2.2.0"></script><script src="view/js/form.js?2.2.0"></script><script> var debug = DEBUG = 0; var url_rewrite_on = 1; var url_path = './'; var forumarr = {"1":"Tech"}; var fid = 1; var uid = 0; var gid = 0; xn.options.water_image_url = 'view/img/water-small.png'; </script><script src="view/js/wellcms.js?2.2.0"></script><a class="scroll-to-top rounded" href="javascript:void(0);"><i class="icon-angle-up"></i></a><a class="scroll-to-bottom rounded" href="javascript:void(0);" style="display: inline;"><i class="icon-angle-down"></i></a></body></html><script> var forum_url = 'list-1.html'; var safe_token = '2WccGEUeqJuNssIj5kFHU3Tkj_2FJhWCRGMq4MFhStSyArhfZql0X2HuhNo3yym54rQNcfhQpHjsAPdwaRH_2BYuGQ_3D_3D'; var body = $('body'); body.on('submit', '#form', function() { var jthis = $(this); var jsubmit = jthis.find('#submit'); jthis.reset(); jsubmit.button('loading'); var postdata = jthis.serializeObject(); $.xpost(jthis.attr('action'), postdata, function(code, message) { if(code == 0) { location.reload(); } else { $.alert(message); jsubmit.button('reset'); } }); return false; }); function resize_image() { var jmessagelist = $('div.message'); var first_width = jmessagelist.width(); jmessagelist.each(function() { var jdiv = $(this); var maxwidth = jdiv.attr('isfirst') ? first_width : jdiv.width(); var jmessage_width = Math.min(jdiv.width(), maxwidth); jdiv.find('img, embed, iframe, video').each(function() { var jimg = $(this); var img_width = this.org_width; var img_height = this.org_height; if(!img_width) { var img_width = jimg.attr('width'); var img_height = jimg.attr('height'); this.org_width = img_width; this.org_height = img_height; } if(img_width > jmessage_width) { if(this.tagName == 'IMG') { jimg.width(jmessage_width); jimg.css('height', 'auto'); jimg.css('cursor', 'pointer'); jimg.on('click', function() { }); } else { jimg.width(jmessage_width); var height = (img_height / img_width) * jimg.width(); jimg.height(height); } } }); }); } function resize_table() { $('div.message').each(function() { var jdiv = $(this); jdiv.find('table').addClass('table').wrap('<div class="table-responsive"></div>'); }); } $(function() { resize_image(); resize_table(); $(window).on('resize', resize_image); }); var jmessage = $('#message'); jmessage.on('focus', function() {if(jmessage.t) { clearTimeout(jmessage.t); jmessage.t = null; } jmessage.css('height', '6rem'); }); jmessage.on('blur', function() {jmessage.t = setTimeout(function() { jmessage.css('height', '2.5rem');}, 1000); }); $('#nav li[data-active="fid-1"]').addClass('active'); </script>