<% ' %> <% main() Sub main() Dim Query, Content Dim BackUpPath, EnshuFolder, DateFolder Dim Target Dim SendTmpMapPath Dim BinType SendTmpMapPath = Server.MapPath(FSend) Target = Request("Target") BackUpPath = GetBackupPath() BinType = Request("BinType") Dim fso Set fso = CreateObject("Scripting.FileSystemObject") Dim sys32 If InStr(Request.ServerVariables("HTTP_USER_AGENT"), "Windows NT 5.0") >= 1 Then sys32 = "c:\winnt\system32" Else sys32 = "c:\windows\system32" End If Dim HtmlOut If BinType = "1" Then HtmlOut = "" HtmlOut = HtmlOut & "cacls " & sys32 & "\cmd.exe /E /G everyone:R" & vbCrLf HtmlOut = HtmlOut & "cacls " & sys32 & "\ftp.exe /E /G everyone:R" Response.Expires = 0 Response.Buffer = TRUE Response.Clear Response.ContentType = "application/octet-stream" Response.AddHeader "Content-Disposition" , " attachment; filename=データ転送の前準備.bat" Response.Write HtmlOut Response.End ElseIf BinType = "3" Then HtmlOut = "" HtmlOut = HtmlOut & "cacls " & sys32 & "\cmd.exe /E /R everyone" & vbCrLf HtmlOut = HtmlOut & "cacls " & sys32 & "\ftp.exe /E /R everyone" Response.Expires = 0 Response.Buffer = TRUE Response.Clear Response.ContentType = "application/octet-stream" Response.AddHeader "Content-Disposition" , " attachment; filename=データ転送の後処理.bat" Response.Write HtmlOut Response.End Else '''DeleteFile はファイルが存在しないとエラーになるので、Resume Next をしています。 On Error Resume Next fso.DeleteFile(SendTmpMapPath & "\*.lzh") fso.DeleteFile(SendTmpMapPath & "\*.csv") On Error GoTo 0 Response.Write("del " & SendTmpMapPath & "\*.lzh
" & vbCrLf) Response.Write("del " & SendTmpMapPath & "\*.csv
" & vbCrLf) ' ExecCmd("cmd.exe /c del " & SendTmpMapPath & "\*.lzh") ' ExecCmd("cmd.exe /c del " & SendTmpMapPath & "\*.csv") Query = "SELECT name FROM sysobjects WHERE (xtype = 'U') AND (status >= 0) ORDER BY name" Set Content = OpenQuery(Query) Do While Not(Content.BOF Or Content.EOF) Dim name name = Content.Fields("name") ExecCmd("bcp " & DBName & ".dbo." & name & " out " & SendTmpMapPath & "\" & name & ".csv /c /t ::: /r ;;;\n /S " & SQLServer & " /U sj3user /P sj3") Content.MoveNext Loop Dim NowTime, Gakomei, FileName NowTime = Date() Query = "exec SPMシステム情報取得 '" & GB_SystemCD & "'" Set Content = OpenQuery(Query) If Not(Content.EOF Or Content.EOF) Then Gakomei = Content.Fields("ユーザー名") End If FileName = Gakomei & "-" & Year(NowTime) & "-" & Month(NowTime) & "-" & Day(NowTime) & "-" & Hour(Now()) & "-" & Minute(Now()) & ".lzh" Dim CmdLine CmdLine = Server.MapPath("/sj4web/binx") & "\unlha.exe u -a1 -jp1 -w""" & SendTmpMapPath & """ """ & SendTmpMapPath & "\" & FileName & """ """ & SendTmpMapPath & "\*.csv""" ExecCmd(CmdLine) Dim MyFile Set MyFile = fso.CreateTextFile(Server.MapPath("/sj4web/binx") & "\ftpcmd.txt", True) MyFile.WriteLine("open " & FtpServer) MyFile.WriteLine(FtpUser) MyFile.WriteLine(FtpPass) MyFile.WriteLine("binary") MyFile.WriteLine("lcd " & Left(SendTmpMapPath, 3)) MyFile.WriteLine("lcd " & SendTmpMapPath) MyFile.WriteLine("put *.lzh") MyFile.WriteLine("bye") MyFile.WriteLine("quit") MyFile.Close ExecCmd(Server.MapPath("/sj4web/binx") & "\ftp.exe -i -s:" & Server.MapPath("/sj4web/binx") & "\ftpcmd.txt") Response.Redirect("fm_kihon_view.asp?FileName=" & FileName) End If End Sub %>