Спасибо.
Как записать в тектовый файл я осилил. Но дело в том что текстовый файл не совсем подходит, так как 37 00 и 14 00 - это байты. Как в VBScript писать в файл байты - не нашел. Можно потом HEX редактором воспользоваться, но это не то.

функция chr() возвращает символ с указанным ascii кодом. Т.е. str = str & chr(37) & chr(00) вместо str = str & "3700".

for i=0 to 65535
   msgbox f("A1" & DecToHex(i))
next

Function GetHexDigit(x)
   if x<10 then
      GetHexDigit = cStr(x)
   else
      GetHexDigit = Chr(Asc("A")+x-10)
   end if
End Function

Function DecToHex(ByVal x)
   dim i
   DecToHex = ""
   for i=1 to 4
      DecToHex = GetHexDigit(x mod 16) & DecToHex
	  x = x \ 16
   next
End Function

Function f(x)
   dim i, j, str, num
   num = array(cInt("&H" & Mid(x, 3, 2)), cInt("&H" & Mid(x, 5, 2)), cInt("&H" & Mid(x, 1, 2)))
   num(2) = num(0) xor num(1) xor num(2)
   str = ""
   for i=0 to 2
      num(i) = ((num(i) and 85)*2) or ((num(i)\2) and 85)
      num(i) = ((num(i) and 51)*4) or ((num(i)\4) and 51)
      num(i) = ((num(i) and 15)*16) or ((num(i)\16) and 15)
      for j=1 to 8
         if num(i) and 1 then
            str = str & "3700"
         else
            str = str & "1400"
         end if
         num(i) = num(i) \ 2
      next
   next
   f = str
End Function

Осталось только в файл записать.

Что из себя представляет задача? Ему есть реальное применение? Или это учебный материал?

Да, это для реального применения. Есть одна идея. От одного девайса был утерян пульт ДУ. Пульт ДУ можно собрать на микроконтроллере. Но вот прошивать его надо зная коды кнопок. Есть софт который может генерировать пакеты для ДУ и собирать прошивку для контроллера. Настройки пульта(коды) хранятся в файле, формат известен. Вот я хочу скриптом создать файл с кодами и опробовтаь их. Рабочие комбинации пойдут в прошивку. Диапазон довольно большой, вручную набирать слишком накладно. Так как от программирования довольно далек решил попробовать реализовать на VBScript, с которым иногда сталкиваюсь.

Насколько я понимаю вставить нужно в конец функции.

Все верно.

Только она здесь не нужна. Все делается циклом из примера коллеги Александр_

Что из себя представляет задача? Ему есть реальное применение? Или это учебный материал?

Спасибо.
Я не очень увлекаюсь скриптописанием. Редко что-то нужно. Поэтому и обращаюсь за помощью на форум к профи.

Насколько я понимаю вставить нужно в конец функции.

Function Dec2Bin(n)
Do Until n = 0
    If (n Mod 2) Then Dec2Bin = "1" & Dec2Bin Else Dec2Bin = "0" & Dec2Bin
    n = n \ 2
    Loop
    Dec2Bin = Right("00000000" & Dec2Bin, 8)
End Function

Буду собирать конечный вариант. Проблема будет в том как писать последовательность байт в файл...

это как ?

все-то вам разжевывать надо

Dec2Bin = Right("00000000" & Dec2Bin, 8)

Догадаетесь куда вставить?

2vv, добавьте к строке 8 нулей слева, затем отрежьте справа те же восемь символов.

Сорри, это как ?

Function Dec2Bin(n)
Do Until n = 0
    If (n Mod 2) Then Dec2Bin = "1" & Dec2Bin Else Dec2Bin = "0" & Dec2Bin
    n = n \ 2
Loop
End Function

Но есть одна проблема. Нас интересует все 8 бит. А эта функция не выводит старшие биты если в них 0. Например по числу 15 выход будет - 10101 , а нам нужен весь байт - 00010101.

Кодируемая последовательность - 153D89. Ваш скрит переводит эту последовательность как "000101010011110111111111" и это неверно.

Скрипт переводит в ту последовательность, которая указана в сообщении #3, откуда эта строка я не знаю.

Если добавить ведущие нули, то получится та строка, которую выдаёт скрипт.

8 итераций(по числу бит в байте), num2 and 1 возвращает значение младшего бита(он же правый бит, эквивалентно num2 mod 2) и num2 = num2 \ 2 "отрезает" младший бит(младшим становится тот, который был вторым справа).

На выходе должен получиться файл содержимое которого - последовательности типа "....37001400...." . Конечно в идеале было бы прогнать в цикле от A10000 до A1FFFF . И после кадого значение зяписывать его код. Просто дописывая файл.

Ну файл и цикл вы уж как-нибудь сами организуйте. Вариант функции, не использующий дополнительную строку:

MsgBox f("A1153D")

Function f(x)
   num = array(cInt("&H" & Mid(x, 3, 2)), cInt("&H" & Mid(x, 5, 2)), cInt("&H" & Mid(x, 1, 2)))
   num(2) = num(0) xor num(1) xor num(2)
   str = ""
   for i=0 to 2
      num(i) = ((num(i) and 85)*2) or ((num(i)\2) and 85)
      num(i) = ((num(i) and 51)*4) or ((num(i)\4) and 51)
      num(i) = ((num(i) and 15)*16) or ((num(i)\16) and 15)
      for j=1 to 8
	     if num(i) and 1 then
            str = str & "3700"
         else
            str = str & "1400"
         end if
	     num(i) = num(i) \ 2
	  next
   next
   f = str
End Function

Должна получиться строка из нулей и единиц?

На выходе должен получиться файл содержимое которого - последовательности типа "....37001400...." . Конечно в идеале было бы прогнать в цикле от A10000 до A1FFFF . И после кадого значение зяписывать его код. Просто дописывая файл.

Спасибо за ваш варинт, буду пробовать

Да, интересовался, в чистом видe функции нет. Но изловчиться можно.