<% ' ' ' %> <% main() Sub main() Dim fs, obj Dim FaxDir Dim a, b, f1, fsize1, l1, FileName, FileExt Dim TorihikisakiCD, Sakuseibi, Kenmei, Naiyo Dim RouteType Dim Query, Content Dim FAXCD a=Request.TotalBytes On Error Resume Next Err.Clear() b=Request.BinaryRead(a) If Err.Description <> "" Then Response.Write("エラーが発生しました。
ファイルサイズが大きすぎる可能性があります。

") Response.Write("エラーコード:") Response.Write(Err.Description) Response.Write("

") Response.Write("戻る") Exit Sub End If On Error Goto 0 set obj=server.createobject("basp21") fsize1=obj.FormFileSize(b,"UpFile") Set fs = CreateObject("Scripting.FileSystemObject") FaxDir = "/" & HomeAlias & "/data/fax" If Not(fs.FolderExists(Server.MapPath(FaxDir))) Then fs.CreateFolder(Server.MapPath(FaxDir)) End If f1=obj.FormFileName(b,"UpFile") TorihikisakiCD = obj.Form(b,"TorihikisakiCD") Sakuseibi = obj.Form(b,"Sakuseibi") Kenmei = obj.Form(b,"Kenmei") Naiyo = obj.Form(b,"Naiyo") RouteType = obj.Form(b,"RouteType") FileExt = Mid(f1,InStrRev(f1,".")+1) '拡張子を取り出す Dim ii Dim bCheck Dim ExtArray Dim ExtArrays bCheck = 0 Query = "exec SPMシステム情報取得 '" & GB_SystemCD & "'" Set Content = OpenQuery(Query) If Not(Content.BOF Or Content.EOF) Then ExtArrays = Content.Fields("FAX利用可能拡張子") End If ExtArray = Split(ExtArrays,",") For ii = 0 To UBound(ExtArray) If UCase(FileExt) = UCase(ExtArray(ii)) Then bCheck = 1 End If Next If bCheck = 0 Then Response.Write(UCase(FileExt) & "形式ファイルの送信は許可されておりません。
") %> 戻る <% Exit Sub End If Naiyo = Replace(Naiyo, vbCrLf, "
") Query = "exec SPNFAX作成" Query = Query & " '" & GB_SystemCD & "'" Query = Query & ", '" & EnshuCD & "'" '演習CD Query = Query & ", '" & KaisyaCD & "'" '会社CD Query = Query & ", '" & KaisyaCD & "'" '作成会社CD Query = Query & ", null " Query = Query & ", 'S'" '送受信区分 Query = Query & ", '" & TorihikisakiCD & "'" '宛先CD Query = Query & ", '" & Sakuseibi & "'" '作成日 Query = Query & ", '" & Kenmei & "'" '件名 Query = Query & ", '" & Naiyo & "'" '送付状 Query = Query & ", '" & FileExt & "'" '拡張子 Query = Query & ", '" & GakuseiNo & "'" '学生番号 Set Content = OpenQuery(Query) While Not Content Is Nothing If Content.Fields.Count > 0 Then FAXCD = Content.Fields(0) 'FAXCDを取得 End If Set Content = Content.NextRecordset Wend Query = "exec SPNFAX作成" Query = Query & " '" & GB_SystemCD & "'" Query = Query & ", '" & EnshuCD & "'" '演習CD Query = Query & ", '" & TorihikisakiCD & "'" '会社CD Query = Query & ", '" & KaisyaCD & "'" '作成会社CD Query = Query & ", " & FAXCD '送信側レコード作成時に採番したFAXCDを代入 Query = Query & ", 'R'" '送受信区分 Query = Query & ", '" & TorihikisakiCD & "'" '宛先CD Query = Query & ", '" & Sakuseibi & "'" '作成日 Query = Query & ", '" & Kenmei & "'" '件名 Query = Query & ", '" & Naiyo & "'" '送付状 Query = Query & ", '" & FileExt & "'" '拡張子 Query = Query & ", '" & GakuseiNo & "'" '学生番号 Set Content = OpenQuery(Query) While Not Content Is Nothing If Content.Fields.Count > 0 Then FAXCD = Content.Fields(0) 'FAXCDを取得 End If Set Content = Content.NextRecordset Wend 'ファイル保存 FileName = EnshuCD & "_~_" & KaisyaCD & "_~_" & FAXCD & "." & FileExt '演習CD+作成会社CD+FAXCD l1=obj.FormSaveAs(b,"UpFile",Server.MapPath(FaxDir) & "\" & FileName) Response.Redirect("fn_fax_view.asp?FAXCD=" & FAXCD & "&RouteType=" & RouteType) Response.Write(Query) End Sub %>