<%
'
'
'
%>
<%
main()
Sub main()
Dim MailCD
Dim AtesakiCD
Dim Query, Content
Dim a,b
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
Dim ObjBASP
Dim ObjFS
Set ObjBASP = Server.CreateObject("basp21")
Set ObjFS = CreateObject("Scripting.FileSystemObject")
Dim TenpuDir
TenpuDir = "/" & HomeAlias & "/data/tenpu"
If Not(ObjFS.FolderExists(Server.MapPath(TenpuDir))) Then
ObjFS.CreateFolder(Server.MapPath(TenpuDir))
End If
TenpuDir = TenpuDir & "/" & EnshuCD
If Not(ObjFS.FolderExists(Server.MapPath(TenpuDir))) Then
ObjFS.CreateFolder(Server.MapPath(TenpuDir))
End If
TenpuDir = TenpuDir & "/" & KaisyaCD
If Not(ObjFS.FolderExists(Server.MapPath(TenpuDir))) Then
ObjFS.CreateFolder(Server.MapPath(TenpuDir))
End If
Dim Mode
Dim ShitagakiCD
Dim FileName
Dim FileExt
Dim RouteType
Dim TorihikisakiCD
Dim Sakuseibi
Dim Kenmei
Dim Naiyo
Mode = ObjBASP.Form(b,"Mode") '下書きモード設定フラグ
ShitagakiCD = ObjBASP.Form(b,"ShitagakiCD") '下書き送信モードのメールCD
FileName = ObjBASP.FormFileName(b,"UpFile")
FileName = Mid(FileName, InStrRev(FileName, "\") + 1) 'ファイル名を取り出す
FileName = ConvProhiStr(FileName) '特殊文字が代替文字に変換されている場合、元の特殊文字に戻さないようにする。
FileExt = Mid(FileName, InStrRev(FileName, ".") + 1) '拡張子を取り出す
RouteType = ObjBASP.Form(b,"RouteType")
TorihikisakiCD = ObjBASP.Form(b,"TorihikisakiCD")
TorihikisakiCD = Replace(TorihikisakiCD, ", ", ",")
TorihikisakiCD = Replace(TorihikisakiCD, vbTab, ",") 'multipart/form-dataで送信された場合はTAB区切りなのでカンマに変換
Sakuseibi = ObjBASP.Form(b,"Sakuseibi")
Kenmei = ObjBASP.Form(b,"Kenmei")
Naiyo = ObjBASP.Form(b,"Naiyo")
Naiyo = Replace(Naiyo, vbCrLf, "
")
'Response.Write(Replace(TorihikisakiCD, vbTab, ","))
'Exit Sub
If Mode <> "Shitagaki" Then
If FileName <> "" Then
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
'ファイル保存
' FileName = EnshuCD & "_~_" & KaisyaCD & "_~_" & MailCD & "." & FileExt '演習CD+作成会社CD+MailCD
Dim l1
l1 = ObjBASP.FormSaveAs(b,"UpFile",Server.MapPath(TenpuDir) & "\" & FileName)
End If
End If
Response.Write(TorihikisakiCD)
'Exit Sub
'送信元メール作成・更新
Query = "exec SPNメール作成 "
Query = Query & " '" & GB_SystemCD & "', '" & EnshuCD & "'" '演習CD
Query = Query & ", '" & KaisyaCD & "'" '会社CD
If ShitagakiCD <> "" Then
Query = Query & ", " & ShitagakiCD
Else
Query = Query & ", null "
End If
If Sakuseibi <> "" Then
Query = Query & ", '" & Sakuseibi & "'" '作成日
Else
Query = Query & ", null "
End If
Query = Query & ", 'S'" '送受信フラグ
Query = Query & ", '" & KaisyaCD & "'" '作成会社CD
Query = Query & ", '" & TorihikisakiCD & "'" '表示用宛先CD
Query = Query & ", '" & Kenmei & "'" '件名
Query = Query & ", '" & Naiyo & "'" '内容
If Mode <> "Shitagaki" Then
Query = Query & ", '" & FileName & "'" 'ファイル名
Else
Query = Query & ", ''" 'ファイル名
End If
Query = Query & ", '" & GakuseiNo & "'" '学生番号
Set Content = OpenQuery(Query)
If Not(Content.BOF Or Content.EOF) Then
MailCD = Content.Fields(0) '送信元メールCDを取得する（開封通知のためのリレーション情報）（090706小野）
End If
If Mode <> "Shitagaki" Then
If "" & MailCD <> "" Then
'送信フラグを更新
Query = "exec SPNメール送信 "
Query = Query & " '" & GB_SystemCD & "', '" & EnshuCD & "'" '演習CD
Query = Query & ", '" & KaisyaCD & "'" '会社CD
Query = Query & ", " & MailCD
Set Content = OpenQuery(Query)
End If
'受信先メール作成
Dim tmps
tmps = Split(TorihikisakiCD, ",")
Dim i
For i = 0 To UBound(tmps)
AtesakiCD = tmps(i)
Query = "exec SPNメール作成2 "
Query = Query & " '" & GB_SystemCD & "', '" & EnshuCD & "'" '演習CD
Query = Query & ", '" & AtesakiCD & "'" '会社CD
Query = Query & ", ''"
Query = Query & ", " & MailCD '送信元メールCD（開封通知のためのリレーション情報）（090706小野）
Query = Query & ", '" & Sakuseibi & "'" '作成日
Query = Query & ", 'R'" '送受信フラグ
Query = Query & ", '" & KaisyaCD & "'" '作成会社CD
Query = Query & ", '" & TorihikisakiCD & "'" '表示用宛先CD
Query = Query & ", '" & Kenmei & "'" '件名
Query = Query & ", '" & Naiyo & "'" '内容
Query = Query & ", '" & FileName & "'" 'ファイル名
'Query = Query & ",'" & GakuseiNo & "'" '学生番号
'061106
Query = Query & ",'" & AtesakiCD & "'" '学生番号
Set Content = OpenQuery(Query)
Next
End If
' While Not Content Is Nothing
' If Content.Fields.Count > 0 Then
' MailCD = Content.Fields(0)
' End If
' Set Content = Content.NextRecordset
' Wend
'############################################### ４．更新データをビューで表示
If Mode <> "Shitagaki" Then
Response.Redirect("fn_mailsakusei_view.asp?mailCD=" & MailCD & "&RouteType=" & RouteType)
Else
Response.Redirect("fn_mailsakusei_ichiran.asp?PageType=SendMail&Mode=Shitagaki&RouteType=" & RouteType)
End If
Response.Write(Query)
End Sub
%>