<%
'
'
'
%>
<%
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
%>