<% ' ' ' %> <% 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 '############################################### 4.更新データをビューで表示 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 %>