<%
main()
Sub main()
If Not(InternetCheck()) Then
Exit Sub
End If
' If Not(VisitorCheck()) Then
' Exit Sub
' End If
If Not(SchoolAdminCheck()) Then
Exit Sub
End If
'Response.Write(GB_ShopAdmin)
'Exit Sub
Dim Query
Dim Content
Dim Content2
'画像ファイルの最大サイズ
Dim MaxFileSize
MaxFileSize = 512 'KByte
MaxFileSize = 51200 'KByte（50MB）
'画像フォルダ作成
Dim fso
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Dim ImageFolder
ImageFolder = "" & HomeAliasSL & SchoolTopicFolderSL
If Not(fso.FolderExists(Server.MapPath(ImageFolder))) Then
fso.CreateFolder(Server.MapPath(ImageFolder))
End If
ImageFolder = ImageFolder & GB_SchoolAdmin & "/"
If Not(fso.FolderExists(Server.MapPath(ImageFolder))) Then
fso.CreateFolder(Server.MapPath(ImageFolder))
End If
Dim BASPObj
Dim Bytes, BinData, FileName1, FileName2, FileSize, l1, FileExt
Bytes = Request.TotalBytes
On Error Resume Next
Err.Clear()
BinData = Request.BinaryRead(Bytes)
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 BASPObj = Server.CreateObject("basp21")
Dim Topic
Topic = BASPObj.Form(BinData, "Topic")
Dim KokaiDate
KokaiDate = BASPObj.Form(BinData, "KokaiYear") & "/" & BASPObj.Form(BinData, "KokaiMonth") & "/" & BASPObj.Form(BinData, "KokaiDay")
If Not(IsDate(KokaiDate)) Then
KokaiDate = Now
End If
Dim TopicHeight
TopicHeight = BASPObj.Form(BinData, "TopicHeight")
Dim TopicTitle
TopicTitle = ConvProhiStr(BASPObj.Form(BinData, "TopicTitle"))
Dim Honbun1
Honbun1 = ConvProhiStr(BASPObj.Form(BinData, "Honbun1"))
Dim Honbun2
Honbun2 = ConvProhiStr(BASPObj.Form(BinData, "Honbun2"))
Dim Honbun3
Honbun3 = ConvProhiStr(BASPObj.Form(BinData, "Honbun3"))
Dim LinkLabel
LinkLabel = ConvProhiStr(BASPObj.Form(BinData, "LinkLabel"))
Dim LinkURL
LinkURL = ConvProhiStr(BASPObj.Form(BinData, "LinkURL"))
Dim Publish
Publish = BASPObj.Form(BinData, "Publish")
Dim MotoImageFile1
MotoImageFile1 = BASPObj.Form(BinData, "MotoImageFile1")
Dim MotoImageFile2
MotoImageFile2 = BASPObj.Form(BinData, "MotoImageFile2")
Dim ImageDelete1
ImageDelete1 = BASPObj.Form(BinData, "ImageDelete1")
Dim ImageDelete2
ImageDelete2 = BASPObj.Form(BinData, "ImageDelete2")
Dim ImageFile1Mode
ImageFile1Mode = BASPObj.Form(BinData, "ImageFile1Mode")
Dim ImageFile2Mode
ImageFile2Mode = BASPObj.Form(BinData, "ImageFile2Mode")
Dim Delete
Delete = BASPObj.Form(BinData, "Delete")
Dim ActSchoolCD
ActSchoolCD = BASPObj.Form(BinData, "ActSchoolCD")
If LCase(ActSchoolCD) <> LCase(GB_SchoolAdmin) Then
Response.Write("別のウィンドウまたは別のタブページで現在と異なるIDでログインしました。
" & vbCrLf)
Response.Write("同一PC上で複数のIDでログインすることはできません。
" & vbCrLf)
Response.Write("
" & vbCrLf)
Response.Write("戻る" & vbCrLf)
Exit Sub
End If
'削除
If Delete <> "" Then
Query = " DELETE FROM TFトピック WHERE 学校CD = '" & GB_SchoolAdmin & "' AND トピック番号 = " & Delete & " "
Set Content = SQLQuery(Query, SQLServer, DatabaseName, DatabaseUser, DatabasePass)
Response.Redirect(HomeAliasSL & "schooltopic.asp?ActSchoolCD=" & ActSchoolCD) '一覧に戻る
End If
Dim ItemReturn
ItemReturn = True '詳細に戻るフラグ
'キャンセル用に元画像を退避（コピー）
If MotoImageFile1 <> "" Then
On Error Resume Next
Call fso.CopyFile(Server.MapPath(ImageFolder) & "\" & MotoImageFile1, Server.MapPath(ImageFolder) & "\Temp1.img", True)
On Error Goto 0
End If
If MotoImageFile2 <> "" Then
On Error Resume Next
Call fso.CopyFile(Server.MapPath(ImageFolder) & "\" & MotoImageFile2, Server.MapPath(ImageFolder) & "\Temp2.img", True)
On Error Goto 0
End If
If Topic <> "" Then
If Not(IsNumeric(Topic)) Then
'新規採番
Topic = 0
Query = ""
Query = Query & " SELECT * "
Query = Query & " FROM TFトピック "
Query = Query & " WHERE 学校CD = '" & GB_SchoolAdmin & "' "
Set Content = SQLQuery(Query, SQLServer, DatabaseName, DatabaseUser, DatabasePass)
Do While Not(Content.BOF Or Content.EOF)
If Content.Fields("トピック番号") > Topic Then
Topic = Content.Fields("トピック番号")
End If
Content.MoveNext
Loop
Topic = "" & (Topic + 1)
End If
'元画像を削除する場合
If ImageDelete1 = "1" Then
MotoImageFile1 = ""
End If
If ImageDelete2 = "1" Then
MotoImageFile2 = ""
End If
'ファイル名変更
FileSize = BASPObj.FormFileSize(BinData, "ImageFile1")
If FileSize > 0 Then
On Error Resume Next
Call fso.DeleteFile(Server.MapPath(ImageFolder) & "\Topic" & Topic & "-1.*", True) '同一IDのファイルを全削除
On Error Goto 0
FileName1 = BASPObj.FormFileName(BinData,"ImageFile1")
FileName1 = Mid(FileName1, InStrRev(FileName1, "\") + 1) 'パスからファイル名を取り出す
FileExt = Mid(FileName1, InStrRev(FileName1, ".") + 1) 'ファイル名から拡張子を取り出す
FileName1 = "Topic" & Topic & "-1." & FileExt 'ファイル名をIDに変換
l1 = BASPObj.FormSaveAs(BinData, "ImageFile1", Server.MapPath(ImageFolder) & "\" & FileName1)
'Response.Write(Server.MapPath(ImageFolder) & "\" & FileName1)
'Exit Sub
Else
FileName1 = ""
End If
FileSize = BASPObj.FormFileSize(BinData, "ImageFile2")
If FileSize > 0 Then
On Error Resume Next
Call fso.DeleteFile(Server.MapPath(ImageFolder) & "\Topic" & Topic & "-2.*", True) '同一IDのファイルを全削除
On Error Goto 0
FileName2 = BASPObj.FormFileName(BinData,"ImageFile2")
FileName2 = Mid(FileName2, InStrRev(FileName2, "\") + 1) 'パスからファイル名を取り出す
FileExt = Mid(FileName2, InStrRev(FileName2, ".") + 1) 'ファイル名から拡張子を取り出す
FileName2 = "Topic" & Topic & "-2." & FileExt 'ファイル名をIDに変換
l1 = BASPObj.FormSaveAs(BinData, "ImageFile2", Server.MapPath(ImageFolder) & "\" & FileName2)
'Response.Write(Server.MapPath(ImageFolder) & "\" & FileName2)
'Exit Sub
Else
FileName2 = ""
End If
'ビットマップはJPEG変換
Dim Result
Dim NewFileName
If FileName1 <> "" Then
If LCase(Right(FileName1, 4)) = ".bmp" Or LCase(Right(FileName1, 4)) = ".png" Then
Result = LeadObj.Load(Server.MapPath(ImageFolder) & "\" & FileName1, 0, 0, 1)
If Result = 0 Then
NewFileName = Left(FileName1, Len(FileName1) - 4) & ".jpg"
Result = LeadObj.Save(Server.MapPath(ImageFolder) & "\" & NewFileName, 10, 24, 24, 0) '第4引数が圧縮率
If Result = 0 Then
On Error Resume Next
Call fso.DeleteFile(Server.MapPath(ImageFolder) & "\" & FileName1, True)
On Error Goto 0
FileName1 = NewFileName
End If
End If
End If
End If
If FileName2 <> "" Then
If LCase(Right(FileName2, 4)) = ".bmp" Or LCase(Right(FileName2, 4)) = ".png" Then
Result = LeadObj.Load(Server.MapPath(ImageFolder) & "\" & FileName2, 0, 0, 1)
If Result = 0 Then
NewFileName = Left(FileName2, Len(FileName2) - 4) & ".jpg"
Result = LeadObj.Save(Server.MapPath(ImageFolder) & "\" & NewFileName, 10, 24, 24, 0) '第4引数が圧縮率
If Result = 0 Then
On Error Resume Next
Call fso.DeleteFile(Server.MapPath(ImageFolder) & "\" & FileName2, True)
On Error Goto 0
FileName2 = NewFileName
End If
End If
End If
End If
'ファイルサイズ判定
If FileName1 <> "" Then
If fso.GetFile(Server.MapPath(ImageFolder) & "\" & FileName1).Size > MaxFileSize * 1024 Then
On Error Resume Next
Call fso.DeleteFile(Server.MapPath(ImageFolder) & "\" & FileName1, True)
If MotoImageFile <> "" Then
'元画像を書き戻す
Call fso.CopyFile(Server.MapPath(ImageFolder) & "\Temp1.img", Server.MapPath(ImageFolder) & "\" & MotoImageFile, True)
End If
On Error Goto 0
Response.Write("ファイルサイズが大きすぎます。
")
Response.Write("受付可能なファイルサイズは" & MaxFileSize & "KByteまでです。
")
Response.Write("戻る")
Exit Sub
End If
End If
If FileName2 <> "" Then
If fso.GetFile(Server.MapPath(ImageFolder) & "\" & FileName2).Size > MaxFileSize * 1024 Then
On Error Resume Next
Call fso.DeleteFile(Server.MapPath(ImageFolder) & "\" & FileName2, True)
If MotoImageFile <> "" Then
'元画像を書き戻す
Call fso.CopyFile(Server.MapPath(ImageFolder) & "\Temp2.img", Server.MapPath(ImageFolder) & "\" & MotoImageFile, True)
End If
On Error Goto 0
Response.Write("ファイルサイズが大きすぎます。
")
Response.Write("受付可能なファイルサイズは" & MaxFileSize & "KByteまでです。
")
Response.Write("戻る")
Exit Sub
End If
End If
Query = "exec SPFトピック更新 '" & GB_SchoolAdmin & "', " & Topic & ""
Query = Query & ", '" & TopicHeight & "'"
Query = Query & ", '" & KokaiDate & "'"
Query = Query & ", '" & TopicTitle & "'"
Query = Query & ", '" & Honbun1 & "'"
Query = Query & ", '" & Honbun2 & "'"
Query = Query & ", '" & Honbun3 & "'"
If FileName1 <> "" Then
Query = Query & ", '" & FileName1 & "' "
Else
Query = Query & ", '" & MotoImageFile1 & "' "
End If
If FileName2 <> "" Then
Query = Query & ", '" & FileName2 & "' "
Else
Query = Query & ", '" & MotoImageFile2 & "' "
End If
Query = Query & ", '" & ImageFile1Mode & "'"
Query = Query & ", '" & ImageFile2Mode & "'"
Query = Query & ", '" & LinkLabel & "' "
Query = Query & ", '" & LinkURL & "' "
Query = Query & ", '" & Publish & "' "
'Response.Write(Query)
'Exit Sub
Set Content = SQLQuery(Query, SQLServer, DatabaseName, DatabaseUser, DatabasePass)
End If
'If ItemReturn Then
Response.Redirect(HomeAliasSL & "schooltopic.asp?Topic=" & Topic & "&" & TimeUniq() & "&ActSchoolCD=" & ActSchoolCD) '単一トピックに戻る
'Else
' Response.Redirect(HomeAliasSL & "shopshelf.asp?Order=" & Order)
'End If
End Sub
%>