<% main() Sub main() If Not(InternetCheck()) Then Exit Sub End If If Not(VisitorCheck()) Then Exit Sub End If If Not(SysAdminCheck()) Then Exit Sub End If 'Response.Write(GB_ShopAdmin) 'Exit Sub Dim Query Dim Content Dim Content2 '画像ファイルの最大サイズ Dim MaxFileSize MaxFileSize = 512 'KByte '画像フォルダ作成 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 & "hsnsadmin" & "/" 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 Kubun Kubun = BASPObj.Form(BinData, "Kubun") 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 Delete Delete = BASPObj.Form(BinData, "Delete") '削除 If Delete <> "" Then Query = " DELETE FROM TFトピック WHERE 学校CD = '" & "hsnsadmin" & "' AND トピック番号 = " & Delete & " " Set Content = SQLQuery(Query, SQLServer, DatabaseName, DatabaseUser, DatabasePass) Response.Redirect(HomeAliasSL & "sysnotice.asp") '一覧に戻る 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 = '" & "hsnsadmin" & "' " 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トピック更新 '" & "hsnsadmin" & "', " & 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 & ", '" & LinkLabel & "' " Query = Query & ", '" & LinkURL & "' " Query = Query & ", '" & Publish & "' " 'Response.Write(Query) 'Exit Sub Set Content = SQLQuery(Query, SQLServer, DatabaseName, DatabaseUser, DatabasePass) Query = "" Query = Query & " UPDATE TFトピック " Query = Query & " SET 管理者区分 = '" & Kubun & "' " Query = Query & " WHERE 学校CD = 'hsnsadmin' " Query = Query & " AND トピック番号 = " & Topic & " " Set Content = SQLQuery(Query, SQLServer, DatabaseName, DatabaseUser, DatabasePass) End If 'If ItemReturn Then Response.Redirect(HomeAliasSL & "sysnotice.asp?Topic=" & Topic & "&" & TimeUniq()) '単一トピックに戻る 'Else ' Response.Redirect(HomeAliasSL & "shopshelf.asp?Order=" & Order) 'End If End Sub %>