Option Explicit
On Error Resume Next
Dim WS, FS, SH, NS, File, Name, Path, TrueName, Ret
Dim KiriVer, KiriPath, KiriExe, KiriArg, KiriTitle, Desktop, Link
Set WS = WScript.CreateObject("WScript.Shell")
Set FS = WScript.CreateObject("Scripting.FileSystemObject")
Set SH = WScript.CreateObject("Shell.Application")

File = "STARTUP.CMD"
KiriTitle = "○○システム"
call FileCheck()
call MakeLink()

Ret = WS.Popup( "○○○○システムの" & vbCrLf & _
                "ショートカットを作成しました！" & vbCrLf _
              , 0 _
              , "○○○○システム" _
              , 0)


Set NS   = Nothing
Set SH   = Nothing
Set FS   = Nothing
Set Link = Nothing
Set WS   = Nothing
WScript.Quit

'----------------------------
Sub FileCheck()
  If FS.FileExists(File) Then
    Name = FS.GetFileName(File)
    Path = FS.GetParentFolderName(File)
    If IsNull(Path) Or Path = "" Then Path = FS.GetAbsolutePathName(".\")
    Set NS = SH.NameSpace(Path)
    TrueName = NS.ParseName(Name)
    Name = FS.GetAbsolutePathName(TrueName)
  Else
    Ret = WS.Popup( "必要なファイルがありません！" _
                   , 3 _
                   , "確認" _
                   , 0)
    Set NS = Nothing
    Set SH = Nothing
    Set FS = Nothing
    Set WS = Nothing
    WScript.Quit
  End If
End Sub
'----------------------------
Sub MakeLink()
  KiriPath = WS.RegRead("HKLM\SOFTWARE\K3\KIRI\9.0\Path")
  KiriExe = KiriPath & "\System\kiri9.exe"
  If IsNull(KiriExe) Or KiriExe = "" Then
    Ret = WS.Popup( "桐ver.9 がインストールされておりません！" _
                  , 0 _
                  , "桐のインストール確認" _
                  , 0)
    Set NS = Nothing
    Set SH = Nothing
    Set FS = Nothing
    Set WS = Nothing
    WScript.Quit
  End If
  If Right(Path,1) = "\" Then Path = Path & "\" '桐のバグ対策
  KiriPath = KiriPath & "\System"
  KiriArg = "-DP " &  _
            """" & _
            Path & _
            """" & _
            " -R " & _
            """" & _
            Name & _
            """"
  Desktop = WS.SpecialFolders("Desktop")
  Set Link = WS.CreateShortcut(Desktop & "\" & KiriTitle & ".lnk")
  Link.TargetPath = KiriExe
  Link.Arguments = KiriArg
  Link.WindowStyle = 3
  Link.Hotkey = ""
  Link.IconLocation = KiriExe & ", 0"
  Link.Description = KiriTitle
  Link.WorkingDirectory = KiriPath
  Link.Save
End Sub
'----------------------------