【调度系统】广东民航医疗快线调度系统源代码
hzj
2025-07-09 4418374d26a16ec759e06059c2b1fedabe1827e6
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
<%
Dim UploadFilePath,UploadLimitSize,NotAllowfileext,BrowerFilePath
'UploadFilePath =  year(now)&"_"&month(now)&"_"&day(now)&"/"
UploadFilePath = "API/OA_img"
'文件上传路径
 
BrowerFilePath =  "/"
 
UploadLimitSize = 1024*50    '50M
'最大上传文件大小,单位为K
 
NotAllowfileext = "asp|cer|cdx|asa|htw|ida|idq|shtm|shtml|stm|printer|cgi|php|php4|cfm|aspx"
'不可以上传的文件类型
 
function CanUpload(Fileurl)
    Fileurl = lcase("|"& Mid(Fileurl, InstrRev(Fileurl, ".") + 1)& "|")
    NotAllowfileextstr = "|"&NotAllowfileext&"|"
    if instr(NotAllowfileextstr,Fileurl)>0 then
        CanUpload = false
    else
        CanUpload = true
    end if
end function
 
Function CreateFolder(Filepath)
    Dim fso, f
    on error resume next
    Set fso = CreateObject("Scripting.FileSystemObject")
    if not fso.FolderExists(Filepath) then
        Set f = fso.CreateFolder(Filepath)
        set f = Nothing
    end if
    set fso = Nothing
End Function
 
'================================如有朋友继续完善此程序,请发原作者一份
'BuildSmallPic 1.0
'Author1:laifangsong QQ:25313644
'开发日期:不知
'BuildSmallPic 2.0
'Author2:shuangren QQ:80677452
'开发日期:2011-6-10
'要求:ASPJPEG组件2.1及以上版本!!!
'BuildSmallPic 2.0增加了以下功能:
'1.自动判断jpg、gif、png格式图片,成比例产生缩略图
'2.生成gif动画文件的缩略图功能,缩略图可动
'3.生成png文件的缩略图功能
'4.增加了缩略图质量参数
 
'功能:按照指定图片生成缩略图
'注意:以下提到的“路径”都是值相对于调用本函数的文件的相对路径
'参数:
'    m_path1:        原图片路径 例:images/image1.gif
'    m_path2:        生成图片的基路径,不论是否以“/”结尾均可 例:images或images/
'    n_MaxWidth:         生成图片最大宽度
'    n_MaxHeight:        生成图片最大高度
'    n_Quality:          缩略图质量0-100
'返回值:
'    返回生成后的缩略图的路径
'错误处理:
'    如果函数执行过程中出现错误,将返回错误代码,错误代码以 “Error”开头
'        Error_01:创建AspJpeg组件失败,没有正确安装注册该组件
'        Error_02:原图片不存在,检查s_OriginalPath参数传入值
'        Error_03:缩略图存盘失败.可能原因:缩略图保存基地址不存在,检查s_OriginalPath参数传入值;对目录没有写权限;磁盘空间不足
'        Error_Other:未知错误
'调用例子:
'    Dim sSmallPath '缩略图路径
'    sSmallPath = BuildSmallPic("images/image1.gif", "images", 100, 100, 90)    
'================================================================
Function BuildSmallPic(m_path1, m_path2, n_MaxWidth, n_MaxHeight, n_Quality)
    Err.Clear
    On Error Resume Next
 
     
    '检查组件是否已经注册
    Dim AspJpeg
    Set AspJpeg = Server.Createobject("Persits.Jpeg")
    If Err.Number <> 0 Then
        Err.Clear
        BuildSmallPic = "组件安装不正确!"
        Exit Function
    End If
    
     
    '按比例取得缩略图宽度和高度
    Dim n_picWidth, n_picHeight '原图片宽度、高度
    Dim n_newWidth, n_newHeight '缩略图宽度、高度
    Dim extn
     
    '判断不同扩展名
    extn = split(m_path1, ".")
    select case extn(ubound(extn))
        case "jpg"
            AspJpeg.Open m_path1
            n_picWidth = AspJpeg.Width
            n_picHeight = AspJpeg.Height
             
            if n_picWidth > n_MaxWidth or n_picHeight > n_MaxHeight then
                if n_picWidth/n_picHeight >= n_MaxWidth/n_MaxHeight then
                    AspJpeg.Width = n_MaxWidth
                       AspJpeg.Height = n_MaxWidth/(n_picWidth/n_picHeight)
                else
                    AspJpeg.Width = n_picWidth/n_picHeight*n_MaxHeight
                    AspJpeg.Height = n_MaxHeight
                end if
            else
                AspJpeg.Width = n_picWidth
                AspJpeg.Height = n_picHeight
            end if
            AspJpeg.Quality = n_Quality
             
            AspJpeg.Save m_path2 '保存
            If Err.Number <> 0 Then
                Err.Clear
                BuildSmallPic = "Error_03"
                Exit Function
            End If
         
            Set AspJpeg = Nothing
        case "gif"
            Set Gif = AspJpeg.Gif
             
            Gif.Open m_path1
            n_picWidth = Gif.Width
            n_picHeight = Gif.Height
             
            if n_picWidth > n_MaxWidth or n_picHeight > n_MaxHeight then
                if n_picWidth/n_picHeight >= n_MaxWidth/n_MaxHeight then
                    Gif.Resize n_MaxWidth, n_MaxWidth/(n_picWidth/n_picHeight)
                else
                    Gif.Resize n_picWidth/n_picHeight*n_MaxHeight, n_MaxHeight
                end if
            else
                Gif.Resize n_picWidth, n_picHeight
            end if
             
            Gif.Save m_path2 '保存
            If Err.Number <> 0 Then
                Err.Clear
                BuildSmallPic = "Error_03"
                Exit Function
            End If
         
            Set AspJpeg = Nothing
            Set Gif = Nothing
        case "png"
            AspJpeg.Open m_path1
             
            n_picWidth = AspJpeg.Width
            n_picHeight = AspJpeg.Height
             
            AspJpeg.PreserveAspectRatio = True
             
            if n_picWidth > n_MaxWidth or n_picHeight > n_MaxHeight then
                if n_picWidth/n_picHeight >= n_MaxWidth/n_MaxHeight then
                    AspJpeg.Width = n_MaxWidth
                       AspJpeg.Height = n_MaxWidth/(n_picWidth/n_picHeight)
                else
                    AspJpeg.Width = n_picWidth/n_picHeight*n_MaxHeight
                       AspJpeg.Height = n_MaxHeight
                end if
            else
                AspJpeg.Width = n_picWidth
                AspJpeg.Height = n_picHeight
            end if
             
            AspJpeg.PNGOutput = True
            AspJpeg.Save m_path2
        case else
    end select
     
     
    If Err.Number <> 0 Then
        BuildSmallPic = "Error_Other"
        Err.Clear
    End If
    BuildSmallPic = s_BuildBasePath & s_BuildFileName
End Function
%>