OSDN Git Service

Fix bugs of transfer routine.
[ffftp/ffftp.git] / Package / make_zip_file_routine.vbs
1 If WScript.Arguments.Count > 0 Then\r
2         Set fso = CreateObject("Scripting.FileSystemObject")\r
3         Set sh = CreateObject("Shell.Application")\r
4         src = WScript.Arguments(0)\r
5         If WScript.Arguments.Count > 1 Then\r
6                 zip = WScript.Arguments(1)\r
7         Else\r
8                 zip = fso.BuildPath(fso.GetParentFolderName(src), fso.GetBaseName(src)) & ".zip"\r
9         End If\r
10         tmp = zip & ".temp"\r
11         fso.CreateTextFile(zip, True).Write Chr(&H50) & Chr(&H4b) & Chr(&H05) & Chr(&H06) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00) & Chr(&H00)\r
12         If fso.FolderExists(tmp) Then\r
13                 fso.DeleteFolder tmp, True\r
14         End If\r
15         fso.CreateFolder tmp\r
16         If fso.FolderExists(src) Then\r
17                 fso.CopyFolder src, fso.BuildPath(tmp, fso.GetFileName(src))\r
18         Else\r
19                 fso.CopyFile src, fso.BuildPath(tmp, fso.GetFileName(src))\r
20         End If\r
21         sh.NameSpace(zip).MoveHere sh.NameSpace(tmp).Items\r
22         Do While sh.NameSpace(tmp).Items.Count > 0\r
23                 WScript.Sleep(1000)\r
24         Loop\r
25         fso.DeleteFolder tmp, True\r
26 End if\r