UpdateDescriptIonFile.VBS

Option Explicit

Const AppPath = "AJPapps - Update Descript.ion file"

Const URL_PREFIX_DB = "http://dl.dropboxusercontent.com/u/!!!!!!!/"

Const vbNormal = 0
Const vbReadOnly = 1
Const vbHidden = 2
Const vbSystem = 4
Const vbVolume = 8
Const vbDirectory = 16
Const vbArchive = 32
Const vbAlias = 64
Const vbCompressed = 128

Dim FSO
Dim Folder
Dim File
Dim LinksText
Dim TXT
Dim Stream
Dim PathPrefix

Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(".")

For Each File In Folder.Files
  If Not IsExcludedFile(File.Name) Then
    StripPathPrefix File.Path, TXT
    If TXT = "" Then
      WScript.Echo "Can't strip Dropbox path."
      WScript.Echo "Press Enter to continue..."
      WScript.Stdin.ReadLine
      WScript.Quit
    End If

    TXT = Replace(TXT, "\", "/")
    TXT = Replace(TXT, "%", "%25")
    TXT = Replace(TXT, "#", "%23")
    TXT = Replace(TXT, " ", "%20")

    TXT = Replace(TXT, "(", "%28")
    TXT = Replace(TXT, ")", "%29")
    TXT = Replace(TXT, "[", "%5B")
    TXT = Replace(TXT, "]", "%5D")

    TXT = URL_PREFIX_DB & TXT

    LinksText = LinksText & """" & File.Name & """   " & TXT & vbCrLf
  End If
Next

On Error Resume Next

If FSO.FileExists("Descript.ion") Then
  FSO.GetFile("Descript.ion").Attributes = vbNormal

  If Err.Number <> 0 Then
    WScript.Echo "Can't set attributes for Descript.ion file."
    WScript.Echo "Press Enter to continue..."
    WScript.Stdin.ReadLine
    WScript.Quit
  End If
End If

Set Stream = FSO.CreateTextFile("Descript.ion", True, False)
Stream.Write CharToOem(LinksText)
Stream.Close

If Err.Number <> 0 Then
  WScript.Echo "Can't write Descript.ion file."
  WScript.Echo "Press Enter to continue..."
  WScript.Stdin.ReadLine
  WScript.Quit
End If

FSO.GetFile("Descript.ion").Attributes = vbHidden Or vbArchive

If Err.Number <> 0 Then
  MsgBox Err.Description
  WScript.Echo "Can't set attributes for Descript.ion file."
  WScript.Echo "Press Enter to continue..."
  WScript.Stdin.ReadLine
  WScript.Quit
End If

'====================================================================
Private Sub StripPathPrefix(ByVal FileName, _
                            ByRef PathText)
  Dim RC

  Const SEARCH_STR_1 = "\DROPBOX\PUBLIC\"
  Const SEARCH_STR_2 = "\MY DROPBOX\PUBLIC\"

  RC = Instr(UCase(FileName), SEARCH_STR_1)
  If RC > 0 Then
    PathText = Mid(FileName, RC + Len(SEARCH_STR_1))
    Exit Sub
  End If

  RC = Instr(UCase(FileName), SEARCH_STR_2)
  If RC > 0 Then
    PathText = Mid(FileName, RC + Len(SEARCH_STR_2))
    Exit Sub
  End If

  PathText = ""
End Sub

'====================================================================
Private Function IsExcludedFile(ByVal FileName)
  Select Case UCase(FileName)
    Case "DESCRIPT.ION"
      IsExcludedFile = True
    Case Else
      IsExcludedFile = False
  End Select
End Function

'====================================================================
' Перекодировка с использованием встроенного объекта.
' Найдено тут: http://forum.script-coding.com/viewtopic.php?id=1179
'====================================================================
Private Function CharToOem(ByVal Text)
  CharToOem = CharTranslate(Text, "windows-1251", "cp866")
End Function

Private Function OemToChar(ByVal Text)
  OemToChar = CharTranslate(Text, "cp866", "windows-1251")
End Function

Private Function CharToUtf8(ByVal Text)
  CharToUtf8 = CharTranslate(Text, "windows-1251", "utf-8")
End Function

Private Function Utf8ToChar(ByVal Text)
  Utf8ToChar = CharTranslate(Text, "utf-8", "windows-1251")
End Function

'====================================================================
' Общая функция перекодировки из чего угодно во что угодно.
'====================================================================
Function CharTranslate(ByVal Text, _
                       ByVal SourceCharset, _
                       ByVal DestCharset)
  Dim Stream

  Set Stream = CreateObject("ADODB.Stream")
  Stream.Type = 2
  Stream.Mode = 3
  Stream.Open
  Stream.Charset = DestCharset
  Stream.WriteText Text
  Stream.Position = 0
  Stream.Charset = SourceCharset
  CharTranslate = Stream.ReadText
End Function