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

xiaoxiao2021-03-06  190

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"