A transmission class

xiaoxiao2021-03-06  104

<% @ Language = "vbscript" CODEPAGE = "936"%> <% Option Explicit

Class BoxInfoImg 'Transfer Class How to Use' Image Upload and Upload Information Get Class

'Usage:' DIM IMGUP'SET IMGUP = New BoxInfoImg

'Attribute:' imgup.width 'wide' imgup.height 'high' image 'image' image 'IMGUP.IMGTYPE' type 'IMGUP.IMGNAME' file name 'image name: "&' imgup.filename" File Name "& 'Imgup.extName' Extension" 'Imgup.diskPath' Save Position "'Imgup.xupath' Virtual Path" 'Imgup.Newurl' Save URL "'IMGUP.SAVEMODE' Save URL"

'Method:' imgup.saveimg (fullpath) 'Save Image file

Dim AdosDim Width, Height, Imgsize, Imgtype, Imgname, FilenaMedim PRENAME, EXTNAMEDIM Savepath, Savename, Savemodedim Diskpath, XuPath, Newurldim TextStrdim i

Private sub class_initializset adoS = server.createObject ("adodb.stream") ads.type = 1 ads.mode = 3 ADOS.Open GetImageSizeEnd Sub

Private sub class_terminateados.closset adoS = nothingend sub

Public function getImagesize ()

DIM RET (3), BFLAG, FDATA, FSIZE

FDATA = getWebData (getStrurl) 'gets XMLHTTP data fsize = clng (leNB (fdata))' acquired data size

If fsize = 0 THEN EXIT FUNCTION R_WRITE "No Control Data Save", 0nd IF

ADOS.WRITE FDATA ADOS.PSITION = 0

Savename = isavenamesavepath = isavepathavemode = isavemode

'Write text object read image long width and type

ADOS.PSITION = 0 'Reset Data Start Position Bflag = Ados.Read (3)

If isnull (bflag) dam, = 0HEight = 0imgsize = 0imgtype = "unknow" RET (0) = imgType: Ret (1) = width: Ret (2) = height: RET (3) = "" getimagesize = retexit functionend IF

'Take a file type and long width Select Case Hex (binval (bflag)) Case "4E5089": ads.read (15) RET (0) = "PNG" RET (1) = binval2 (ADOS.READ (2)) ADOS .read (2) RET (2) = binval2 (ads.read (2)) Case "464947": ads.read (3) RET (0) = "gif" Ret (1) = binval (adoS.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 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 ife (bin2str (bflag ), 2) = "bm" THENADOS.READ (15) RET (0) = "bmp" RET (1) = binval (adoS.read (4)) RET (2) = binval (4)) elseret (0) = "" end ifend select'dim tempStrdim nameStrdim defaultNamedim lntempStr = split (GetStrUrl, "/") nameStr = tempStr (ubound (tempStr)) if nameStr = "" thenr_write "wrong URL, enter accessible URL ", 0EXIT functionEND IFILENAME = Split (NameStr,"? ") (0) ln = INSTRREV (FileName,". ") IF ln> 0 Then PRENAME = Left (filename, INSTRREV (FileName,". ") - 1) Elseprena ME = filenamend if'r_write filename, 1'R_Write Instrrev (FileName, "."), 1'R_Write FileName, 0exTName = Right (FileName, Len (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 SELECT

if 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) xupath = replace (Replace ("/"), ""), "/", "/") newURL = "http: //" & request.serverVariables ("server_name") & XuPathGetImagesize = Retend Function

Public 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, 2TEXTSTSTSTR = ads.readtext () Elseados.savetofile Fullpath, 2nd ifsaveimg = trueEnd Function

Private function bin2str (bin) DIM I, STR, CLOWFOR I = 1 to lenb (bin) CLOW = MIDB (BIN, I, 1) IF ASCB (CLOW) <128 TENSTR = STR & CHR (ASCB (CLOW) ELSEI = I 1IF I <= lenb (bin) THEN STR = Str & CHR (ASCW (MIDB (BIN, I, 1) & CLOW) end ifnext bin2str = streven function

Private function Num2Str (NUM, BASE, LENS) DIM RET: RET = "" While (NUM Mod Base) & Retnum = (Num - Num MOD BASE) / BASEWENDNUM2STR = Right (String (Lens, "0") & number Function str2num (str, base) DIM RET: RET = 0for i = 1 to Len (STR) RET = RET * BASE CINT (MID (STR, I, 1) NextStr2Num = Retend Function

Private function binval (bin) Dim Ret: Ret = 0for i = lenb (bin) to 1 step -1ret = RET * 256 ASCB (MIDB (BIN, I, 1)) Nextbinval = Retend Function

Private function binval2 (bin) DIM RET: RET = 0for i = 1 to lenb (bin) RET = RET * 256 ASCB (MIDB (BIN, I, 1)) Nextbinval2 = Retend Function

Private Function GetWebData (byval StrUrl) if StrUrl = "" then r_write "invalid", 1exit functionend ifdim tempStrtempStr = split (GetStrUrl, "/") if tempStr (ubound (tempStr)) = "" or inStr (StrUrl, "/" ) = 0 thenR_Write "does not specify a valid URL", 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 Chkinfo

If geturl = "" The central tform () r_write "
Transfer File Bar is not filled!", 0nd IF

Set imgup = new boxinfoimg

if Mode = "1" and Imgup.Imgname = "unknow" theENCALL TFORM () set imgup = nothingr_write "
Transfer File Bar Not fill in the valid image URL!", 0nd if

Chkinfo = "" DIM I, Teststr, Showstr 'Limited SELECT CASE IMGUP.IMGTYPECASE "PNG", "JPG", "BMP", "GIF" if imgup.width = 0 or imgup.Height = 0 or imgup.imgsize = 0 THEN CHKINFO = "

  • " "Transfer image data does not exist, make sure that your URL is correct" End ifcase else chkinfo = "
  • invalid transmission format, allowing image data format" "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, 1

    If Mode = "1" "and chkinfo <>" "Check after the upload image data is passed, save TForm () r_write chkinfo, 0lServer.Scripttimeout = 5000Imgup.saveImgup.diskpath end if '-------- ------ 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 file 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 "----------------------
    Transmission is complete, 0nd Sub

    Sub TForm ()%>

    Get URL:
    Save Path:
    Save File Name: > Web image > Text file > binary data Run this code ", 1R_Write"