<% ' %> <% main() Sub main() If Not(SessionCheck()) Then Exit Sub End If 'INP_DATA Dim EnshuKubun Dim SaveStatus 'CHK_DATA Dim F_CHK Dim F_ERR Dim S_MSG Dim SysPath Dim FilePath Dim FileCheck Dim Action Dim Checkall Dim Checksitei Dim RouteType Dim Ng , ErrMSG , rsts, tmp Dim Target Dim Query Dim Content Dim TableName '保存処理 F_CHK = "" F_ERR = "NG" Dim Rireki Rireki = Replace(Request("Rireki"), " ", "") '削除する履歴 'Response.Write(Rireki) 'Exit Sub Dim Mode Mode = Request("Mode") '演習削除時の自動バックアップ用フラグ Target = Request("Target") EnshuKubun = Request("EnshuKubun") Server.ScriptTimeout = 1200 Dim BackUpPath, EnshuFolder, DateFolder BackUpPath = GetBackupPath() EnshuFolder = Target DateFolder = SetTimeYYMMDDHHMM2(Now()) '演習CDフォルダの作成 Dim fso, fnm , fid , sid , tnm , dnm Set fso = Server.CreateObject("Scripting.FileSystemObject") If Not(fso.FolderExists(BackUpPath & "\" & EnshuFolder)) Then Set fid = fso.GetFolder(BackUpPath) Set sid = fid.SubFolders sid.Add EnshuFolder End If If Mode = "Rireki" And Rireki <> "" Then '履歴の削除 Dim TmpRireki TmpRireki = Split(Rireki, ",") Dim Cnt For Cnt = 0 To UBound(TmpRireki) DateFolder = TmpRireki(Cnt) '年月日フォルダの存在チェック If fso.FolderExists(BackUpPath & "\" & EnshuFolder & "\" & DateFolder) Then Dim ts Set ts = fso.OpenTextFile(BackUpPath & "\" & EnshuFolder & "\" & DateFolder & "\DELETE.txt", 2, True) '削除扱いを示すテキストファイル作成 ts.write DateFolder & vbCrLf ts.Close End If Next Else 'バックアップ '年月日フォルダの作成 If Not(fso.FolderExists( BackUpPath & "\" & EnshuFolder & "\" & DateFolder)) Then Set fid = fso.GetFolder( BackUpPath & "\" & EnshuFolder) Set sid = fid.SubFolders sid.Add DateFolder End If FilePath = BackUpPath & "\" & EnshuFolder & "\" & DateFolder Response.Write(FilePath & "
" & vbCrLf) If Not(fso.FolderExists(FilePath)) Then S_MSG = S_MSG & chr(13) & " 保存するフォルダが作成できませんでした。　処理を中止します。" & SysPath & "/" & FilePath F_CHK = F_ERR Exit Sub End If ''''''''''フォルダの作成ここまで ''''''''''データのバックアップここから Query = "select * from dbo.sysobjects where xtype = 'U' and left(name,1)='T' order by name" Set Content = OpenQuery2(Query) Do While not Content.EOF TableName = Content.Fields("name").value tmp = s_csv_save(FilePath, Target, TableName) If (F_CHK = F_ERR) Then Exit Do End If Content.MoveNext Loop ''''''''''データのバックアップここまで End If If Mode = "EnshuDelete" Then '演習削除時の自動バックアップの場合（071001小野） Response.Redirect("/" & HomeAlias & "/admin/enshu/fm_enshu1_bin.asp?Action=4&EnshuCD=" & Target) ElseIf Mode = "Rireki" Then '履歴削除時 Response.Redirect("fm_enshu_save.asp?RouteType=&Target=" & Target & "&ErrMSG=履歴を削除しました") ElseIf S_MSG <> "" Then Response.Redirect("fm_enshu_save_view.asp?DateFolder=" & DateFolder & "&Target=" & Target & "&ErrMSG=" & S_MSG) Else Response.Redirect("fm_enshu_save_view.asp?DateFolder=" & DateFolder & "&Target=" & Target & "&ErrMSG=処理終了しました") End If End Sub '*------------------------------------------* '*抽出＆セーブ '*------------------------------------------* Function s_csv_save(FilePath, Target, TableName) 'On Error Resume Next Dim ii Dim CsvNm Dim Query Dim Content1 Dim ContentSub Dim fso Dim csv Dim wjyoken Dim w_cnt , w_val , w_rec , x 'ＣＳＶファイルの削除 CsvNm = FilePath & "\" & TableName & ".CSV" Set fso = Server.CreateObject("Scripting.FileSystemObject") If (fso.FileExists(CsvNm)) Then fso.DeleteFile CsvNm, true End If '対象データ抽出 If Target = "all" Then Query = "SELECT * " Query = Query & " FROM [" & TableName & "] " Query = Query & " Where システムCD ='" & GB_SystemCD & "'" '（080407追加：小野） Else If TableName = "TC1システムM" Then Query = "SELECT * " Query = Query & " FROM [" & TableName & "] " Query = Query & " Where システムCD ='" & GB_SystemCD & "'" ElseIf left(TableName,2) = "TG" OR left(TableName,3) = "TKH" OR left(TableName,3) = "TSA" OR left(TableName,3) = "TSB" OR left(TableName,3) = "TSC" OR left(TableName,3) = "TSK" OR left(TableName,2) = "TT" Then Query = "SELECT * " Query = Query & " FROM [" & TableName & "] " Query = Query & " Where システムCD ='" & GB_SystemCD & "' And 演習CD ='" & Target & "'" ElseIf left(TableName,3) = "TC2" OR left(TableName,3) = "TC4" OR left(TableName,3) = "TC6" OR left(TableName,3) = "TDA" Then Query = "SELECT * " Query = Query & " FROM [" & TableName & "] " Query = Query & " Where システムCD ='" & GB_SystemCD & "' And 演習CD ='" & Target & "'" 'TC4演習許可学生Mで参加許可されている学生のグループが必要なので大幅に改修（090617小野） ElseIf TableName = "TC3学生グループM" Then Dim GroupAry ReDim GroupAry(0) 'TC4演習許可学生Mの参加許可学生からグループを逆引きし配列に取得 Query = " SELECT TC5学生M.学生グループCD " Query = Query & " FROM TC5学生M " Query = Query & " INNER JOIN TC4演習許可学生M " Query = Query & " ON TC4演習許可学生M.システムCD = TC5学生M.システムCD " Query = Query & " AND TC4演習許可学生M.学生番号 = TC5学生M.学生番号 " Query = Query & " WHERE TC4演習許可学生M.システムCD ='" & GB_SystemCD & "' " Query = Query & " AND TC4演習許可学生M.演習CD = '" & Target & "' " Query = Query & " GROUP BY TC5学生M.学生グループCD " Set Content1 = OpenQuery2(Query) Do While Not(Content1.EOF OR Content1.BOF) Redim PreServe GroupAry(UBound(GroupAry) + 1) GroupAry(UBound(GroupAry)) = "" & Content1.Fields("学生グループCD") Content1.MoveNext Loop 'TC4演習許可学生グループMから参加許可グループを配列に取得 Query = " SELECT TC4演習許可学生グループM.学生グループCD " Query = Query & " FROM TC4演習許可学生グループM " Query = Query & " WHERE TC4演習許可学生グループM.システムCD ='" & GB_SystemCD & "' " Query = Query & " AND TC4演習許可学生グループM.演習CD = '" & Target & "' " Query = Query & " GROUP BY TC4演習許可学生グループM.学生グループCD " Set Content1 = OpenQuery2(Query) Do While Not(Content1.EOF OR Content1.BOF) Redim PreServe GroupAry(UBound(GroupAry) + 1) GroupAry(UBound(GroupAry)) = "" & Content1.Fields("学生グループCD") Content1.MoveNext Loop 'グループCD配列を抽出条件にする If UBound(GroupAry) > 0 Then Query = "SELECT TC3学生グループM.* " Query = Query & " FROM TC3学生グループM " Query = Query & " WHERE TC3学生グループM.システムCD ='" & GB_SystemCD & "' " Query = Query & " AND TC3学生グループM.学生グループCD IN ( " For ii = 1 To UBound(GroupAry) If ii > 1 Then Query = Query & " , " End If Query = Query & " '" & GroupAry(ii) & "' " Next Query = Query & " ) " Query = Query & " ORDER BY TC3学生グループM.学生グループCD " Else '参加グループ無しの場合の例外対策 Query = "SELECT TC3学生グループM.*" Query = Query & " FROM TC3学生グループM" Query = Query & " INNER JOIN TC4演習許可学生グループM ON " Query = Query & " TC3学生グループM.学生グループCD = TC4演習許可学生グループM.学生グループCD" Query = Query & " WHERE TC4演習許可学生グループM.システムCD ='" & GB_SystemCD & "' And TC4演習許可学生グループM.演習CD = '" & Target & "'" End If 'TC4演習許可学生Mで参加許可されている学生が必要なので大幅に改修（090617小野） ElseIf TableName = "TC5学生M" Then Dim SeitoAry ReDim SeitoAry(0) 'TC4演習許可学生Mの参加許可学生を配列に取得 Query = " SELECT TC4演習許可学生M.学生番号 " Query = Query & " FROM TC4演習許可学生M " Query = Query & " WHERE TC4演習許可学生M.システムCD ='" & GB_SystemCD & "' " Query = Query & " AND TC4演習許可学生M.演習CD = '" & Target & "' " Query = Query & " GROUP BY TC4演習許可学生M.学生番号 " Set Content1 = OpenQuery2(Query) Do While Not(Content1.EOF OR Content1.BOF) Redim PreServe SeitoAry(UBound(SeitoAry) + 1) SeitoAry(UBound(SeitoAry)) = "" & Content1.Fields("学生番号") Content1.MoveNext Loop 'TC4演習許可学生グループMの参加許可グループから学生を配列に取得 Query = " SELECT TC5学生M.学生番号 " Query = Query & " FROM TC5学生M " Query = Query & " INNER JOIN TC4演習許可学生グループM " Query = Query & " ON TC4演習許可学生グループM.システムCD = TC5学生M.システムCD " Query = Query & " AND TC4演習許可学生グループM.学生グループCD = TC5学生M.学生グループCD " Query = Query & " WHERE TC4演習許可学生グループM.システムCD ='" & GB_SystemCD & "' " Query = Query & " AND TC4演習許可学生グループM.演習CD = '" & Target & "' " Query = Query & " GROUP BY TC5学生M.学生番号 " Set Content1 = OpenQuery2(Query) Do While Not(Content1.EOF OR Content1.BOF) Redim PreServe SeitoAry(UBound(SeitoAry) + 1) SeitoAry(UBound(SeitoAry)) = "" & Content1.Fields("学生番号") Content1.MoveNext Loop '学生番号配列を抽出条件にする If UBound(SeitoAry) > 0 Then Query = "SELECT TC5学生M.* " Query = Query & " FROM TC5学生M " Query = Query & " WHERE TC5学生M.システムCD ='" & GB_SystemCD & "' " Query = Query & " AND TC5学生M.学生番号 IN ( " For ii = 1 To UBound(SeitoAry) If ii > 1 Then Query = Query & " , " End If Query = Query & " '" & SeitoAry(ii) & "' " Next Query = Query & " ) " Query = Query & " ORDER BY TC5学生M.学生番号 " Else '参加学生無しの場合の例外対策 Query = "SELECT TC5学生M.*" Query = Query & " FROM TC5学生M" Query = Query & " INNER JOIN TC3学生グループM" Query = Query & " ON TC5学生M.学生グループCD = TC3学生グループM.学生グループCD" Query = Query & " INNER JOIN TC4演習許可学生グループM" Query = Query & " ON TC3学生グループM.学生グループCD = TC4演習許可学生グループM.学生グループCD" Query = Query & " WHERE TC4演習許可学生グループM.システムCD ='" & GB_SystemCD & "' And TC4演習許可学生グループM.演習CD = '" & Target & "'" End If Else ' Query = "SELECT * " ' Query = Query & " FROM [" & TableName & "] " ' Query = Query & " Where システムCD ='" & GB_SystemCD & "'" Response.Write("例外：" & TableName & "
") End If End If If Query <> "" Then Response.Write("") DebugQuery(Query) Response.Write("
" & vbCrLf) Set Content1 = OpenQuery2(Query) Set csv = fso.OpenTextFile(CsvNm, 8, True, 0) w_cnt = 0 Do While not Content1.EOF w_cnt = w_cnt + 1 w_rec = "" for x = 0 to Content1.Fields.count-1 w_val = Content1.Fields(x).value If VarType(w_val) = 1 Then w_val = "null" ElseIf VarType(w_val) = 2 Or VarType(w_val) = 3 Or VarType(w_val) = 4 Or VarType(w_val) = 5 Or VarType(w_val) = 6 Then Else w_val = "'" & Replace("" & w_val, vbCrLf, "") & "'" End If If w_rec <> "" Then w_rec = w_rec & "," End If w_rec = w_rec & w_val Next err = 0 csv.WriteLine(w_rec) If (err) Then S_MSG = S_MSG & chr(13) & TableName & " が保存できませんでした。　処理を中止します。 cnt=" & w_cnt & " " & w_rec F_CHK = F_ERR Exit Function End If Content1.MoveNext Loop Content1.close csv.close Set csv = Nothing End If End Function %>