[решено] Экспорт данных из одного txt файла в другой [Версия для КПК]

Показать полную графическую версию : [решено] Экспорт данных из одного txt файла в другой

Страниц : [1] 2

TRaMeLL

21-08-2012, 10:17

Добрый день!
Нужна помощь: есть файл Kl_to_1c.txt примерно такого содержания:
1CClientBankExchange
ВерсияФормата=1,01
Кодировка=Windows
Получатель=1Cv77
ДатаСоздания=21.08.2012
ВремяСоздания=15:03:30
ДатаНачала=20.08.2012
ДатаКонца=21.08.2012
РасчСчет=77777777777777777777
СекцияДокумент=Платежное поручение
Дата=20.08.2012
Номер=1339
Сумма=146
ПлательщикСчет=12345678901234567890
ПолучательСчет=09876543210987654321
ПлательщикИНН=1234567890
Плательщик1=Филиал ОАО "Иркутскэнерго"
ПлательщикБИК=042520607
ПлательщикБанк1=БАЙКАЛЬСКИЙ БАНК СБЕРБАНКА РОССИИ Г.ИРКУТСК
ПолучательИНН=0987654321
Получатель1=ИП Иванов Иван Иванович
ПолучательБИК=042520607
ПолучательБанк1=БАЙКАЛЬСКИЙ БАНК СБЕРБАНКА РОССИИ Г.ИРКУТСК
НазначениеПлатежа=Оплата счета №10 от 20.08.2012г. Без налога (НДС)
СтатусСоставителя=
ПлательщикКПП=222222222
ПолучательКПП=
ПоказательКБК=
ОКАТО=
ПоказательОснования=
ПоказательПериода=
ПоказательНомера=
ПоказательДаты=
ПоказательТипа=
ВидОплаты=1
ДатаПоступило=20.08.2012
КонецДокумента
Необходимо получить файл с таким содержимым:
20.08.2012 - 1339 - 146 - Филиал ОАО "Иркутскэнерго"
Т. е. формат типа: %Дата=% - %Номер=% - %Сумма=% - %Плательщик1=%
Спасайте. :)

Iska

21-08-2012, 17:33

Например, так:
Option Explicit

Dim lngErrCode

Dim strSourceFile
Dim strLine
Dim strResult

If WScript.Arguments.Count = 1 Then
strSourceFile = WScript.Arguments.Item(0)

With WScript.CreateObject("Scripting.FileSystemObject")
If .FileExists(strSourceFile) Then
With .OpenTextFile(strSourceFile)
strResult = ""

Do Until .AtEndOfStream
strLine = .ReadLine()

Select Case Split(strLine, "=")(0)
Case "Дата", "Номер", "Сумма", "Плательщик1"
strResult = strResult & Split(strLine, "=")(1) & " - "
End Select
Loop

strResult = Left(strResult, Len(strResult) - Len(" - "))

.Close
End With

WScript.StdOut.WriteLine strResult
lngErrCode = 0
Else
WScript.StdErr.WriteLine "File [" & strSourceFile & "] not found"
lngErrCode = 2
End If
End With
Else
WScript.StdErr.WriteLine "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ ""<Source file>"""
lngErrCode = 1
End If

WScript.Quit lngErrCode

Исполнять под «cscript.exe», указывая исходный файл аргументом скрипта, а результирующий — перенаправлением вывода, наподобие:
cscript.exe //nologo "C:\Песочница\0018\MyScript.vbs" "C:\Temp\Kl_to_1c.txt" 1>Out.txt 2>Errors.txt

TRaMeLL

21-08-2012, 19:58

Великолепно! Почти. Только нужно еще сделать так чтобы после:
%Дата=% - %Номер=% - %Сумма=% - %Плательщик1=%
Начиналась новая строка, сейчас идет сразу: %Дата=% - %Номер=% - %Сумма=% - %Плательщик1=% - %Дата=% - %Номер=% - %Сумма=% - %Плательщик1=% и т. д.
А надо:
%Дата=% - %Номер=% - %Сумма=% - %Плательщик1=%
%Дата=% - %Номер=% - %Сумма=% - %Плательщик1=%
%Дата=% - %Номер=% - %Сумма=% - %Плательщик1=%
%Дата=% - %Номер=% - %Сумма=% - %Плательщик1=%
....
и т. д. до конца

Iska

22-08-2012, 03:30

В реальном файле «Kl_to_1c.txt» несколько квитанций о платежах? В Вашем примере только одна квитанция, а я просто не успел взять реальный файл у себя, а так бы проверил на реальных данных.

Попробуйте тогда так:
Option Explicit

Dim lngErrCode

Dim strSourceFile
Dim strLine
Dim strResult

If WScript.Arguments.Count = 1 Then
strSourceFile = WScript.Arguments.Item(0)

With WScript.CreateObject("Scripting.FileSystemObject")
If .FileExists(strSourceFile) Then
With .OpenTextFile(strSourceFile)
strResult = ""

Do Until .AtEndOfStream
strLine = .ReadLine()

Select Case Split(strLine, "=")(0)
Case "Дата", "Номер", "Сумма"
strResult = strResult & Split(strLine, "=")(1) & " - "
Case "Плательщик1"
strResult = strResult & Split(strLine, "=")(1) & vbCrLf
End Select
Loop

.Close
End With

WScript.StdOut.Write strResult
lngErrCode = 0
Else
WScript.StdErr.WriteLine "File [" & strSourceFile & "] not found"
lngErrCode = 2
End If
End With
Else
WScript.StdErr.WriteLine "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ ""<Source file>"""
lngErrCode = 1
End If

WScript.Quit lngErrCode

TRaMeLL

22-08-2012, 05:00

Да, в реальном файле могут быть несколько квитанций. Теперь всё OK. Спасибо огромное!

TRaMeLL

22-08-2012, 05:58

В принципе и так нормально, но кое-что еще можно поправить:
Сейчас, если %Номер% одинаковое количество символов, то всё нормально, но если число разное, т. е. в одной строке, например 5 символов, а во второй - 3, то файл получается немного кривым. Можно как-то облагородить форматирование? Чтобы получались ровные колонки? Вот тогда счастью моему не было бы предела. :)

Iska

22-08-2012, 06:53

TRaMeLL, Вам нужен табличный, выровненный вид? Зачем тогда нужны разделители « - » в результирующем файле?

TRaMeLL

22-08-2012, 07:20

Да, нужен табличный вид. " - " это просто для примера, я вместо него vbTab поставил.

Iska

22-08-2012, 08:39

TRaMeLL, ясно. Попробуйте так:
Option Explicit

Const adInteger = 3
Const adCurrency = 6
Const adDate = 7
Const adVarChar = 200

Dim lngErrCode

Dim strSourceFile
Dim strLine

Dim objTS
Dim objRecordSet

Dim intNumberMaxLength
Dim intSummMaxLength
Dim intPlatMaxLength

If WScript.Arguments.Count = 1 Then
strSourceFile = WScript.Arguments.Item(0)

With WScript.CreateObject("Scripting.FileSystemObject")
If .FileExists(strSourceFile) Then
Set objTS = .OpenTextFile(strSourceFile)

With WScript.CreateObject("ADOR.Recordset")
With .Fields
.Append "Дата", adDate
.Append "Номер", adInteger
.Append "Сумма", adCurrency
.Append "Плательщик1", adVarChar, 2^15 - 1
.Append "ДлинаСтрокиПлательщик1", adInteger
End With

.Open

Do Until objTS.AtEndOfStream
strLine = objTS.ReadLine()

Select Case Split(strLine, "=")(0)
Case "Дата"
.AddNew
.Fields.Item("Дата").Value = CDate(Split(strLine, "=")(1))
Case "Номер"
.Fields.Item("Номер").Value = CLng(Split(strLine, "=")(1))
Case "Сумма"
.Fields.Item("Сумма").Value = CCur(Split(strLine, "=")(1))
Case "Плательщик1"
.Fields.Item("Плательщик1").Value = CStr(Split(strLine, "=")(1))
.Fields.Item("ДлинаСтрокиПлательщик1").Value = Len(CStr(Split(strLine, "=")(1)))
End Select
Loop

objTS.Close

.Sort = "Номер DESC" : .MoveFirst
intNumberMaxLength = Len(CStr(.Fields.Item("Номер").Value))

.Sort = "Сумма DESC" : .MoveFirst
intSummMaxLength = Len(CStr(.Fields.Item("Сумма").Value))

.Sort = "ДлинаСтрокиПлательщик1 DESC" : .MoveFirst
intPlatMaxLength = .Fields.Item("ДлинаСтрокиПлательщик1").Value

.Sort = "" : .MoveFirst

Do Until .EOF
With .Fields
WScript.StdOut.Write FormatString(.Item("Дата").Value, 10) & vbTab
WScript.StdOut.Write FormatString(.Item("Номер").Value, intNumberMaxLength) & vbTab
WScript.StdOut.Write FormatString(.Item("Сумма").Value, intSummMaxLength) & vbTab
WScript.StdOut.Write FormatString(.Item("Плательщик1").Value, intPlatMaxLength)
WScript.StdOut.WriteLine
End With

.MoveNext
Loop

.Close
End With

Set objTS = Nothing

lngErrCode = 0
Else
WScript.StdErr.WriteLine "File [" & strSourceFile & "] not found"
lngErrCode = 2
End If
End With
Else
WScript.StdErr.WriteLine "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ ""<Source file>"""
lngErrCode = 1
End If

WScript.Quit lngErrCode
'=============================================================================

'=============================================================================
Function FormatString(anyValue, intLength)
Select Case TypeName(anyValue)
Case "Date"
FormatString = Left(CStr(anyValue) & Space(intLength), intLength)
Case "String"
FormatString = Left(CStr(anyValue) & Space(intLength), intLength)
Case "Integer", "Long", "Currency"
FormatString = Right(Space(intLength) & CStr(anyValue), intLength)
Case Else
FormatString = "<unsupported type " & TypeName(anyValue) & ">"
End Select
End Function
'=============================================================================

На копейки не рассчитано. Если могут присутствовать — надо будет править код.

TRaMeLL

22-08-2012, 08:51

Этот что-то не запустился, в логе ссылается на 51-ю строку. И там копейки присутствуют еще.

Iska

22-08-2012, 11:17

Доберусь до реального файла — посмотрю. И, коль есть копейки — надо будет перестроить логику выравнивания Currency под десятичный разделитель. В Вашем файле, он, кстати, какой? Точка или запятая?

TRaMeLL

22-08-2012, 11:35

В моем файле - точка.

Iska

23-08-2012, 10:43

TRaMeLL, добрался, попробовал на своём файле. Теперь опробуйте Вы на своём:
Option Explicit

Const adInteger = 3
Const adCurrency = 6
Const adDate = 7
Const adVarChar = 200

Dim lngErrCode

Dim strSourceFile
Dim strLine

Dim objTS
Dim objRecordSet

Dim intNumberMaxLength
Dim intSummMaxLength
Dim intPlatMaxLength

If WScript.Arguments.Count = 1 Then
strSourceFile = WScript.Arguments.Item(0)

With WScript.CreateObject("Scripting.FileSystemObject")
If .FileExists(strSourceFile) Then
Set objTS = .OpenTextFile(strSourceFile)

With WScript.CreateObject("ADOR.Recordset")
With .Fields
.Append "Дата", adDate
.Append "Номер", adInteger
.Append "Сумма", adCurrency
.Append "ДлинаСтрокиСумма", adInteger
.Append "Плательщик1", adVarChar, 2^15 - 1
.Append "ДлинаСтрокиПлательщик1", adInteger
End With

.Open

Do Until objTS.AtEndOfStream
strLine = objTS.ReadLine()

Select Case Split(strLine, "=")(0)
Case "Дата"
.AddNew
.Fields.Item("Дата").Value = CDate(Split(strLine, "=")(1))
Case "Номер"
.Fields.Item("Номер").Value = CLng(Split(strLine, "=")(1))
Case "Сумма"
.Fields.Item("Сумма").Value = CCur(Split(strLine, "=")(1))
.Fields.Item("ДлинаСтрокиСумма").Value = Len(FormatCurrency(CCur(Split(strLine, "=")(1)), 2))
Case "Плательщик1"
.Fields.Item("Плательщик1").Value = CStr(Split(strLine, "=")(1))
.Fields.Item("ДлинаСтрокиПлательщик1").Value = Len(CStr(Split(strLine, "=")(1)))
End Select
Loop

objTS.Close

.Sort = "Номер DESC" : .MoveFirst
intNumberMaxLength = Len(CStr(.Fields.Item("Номер").Value))

.Sort = "ДлинаСтрокиСумма DESC" : .MoveFirst
intSummMaxLength = .Fields.Item("ДлинаСтрокиСумма").Value

.Sort = "ДлинаСтрокиПлательщик1 DESC" : .MoveFirst
intPlatMaxLength = .Fields.Item("ДлинаСтрокиПлательщик1").Value

.Sort = "" : .MoveFirst

Do Until .EOF
With .Fields
WScript.StdOut.Write FormatString(.Item("Дата").Value, 10) & vbTab
WScript.StdOut.Write FormatString(.Item("Номер").Value, intNumberMaxLength) & vbTab
WScript.StdOut.Write FormatString(.Item("Сумма").Value, intSummMaxLength) & vbTab
WScript.StdOut.Write FormatString(.Item("Плательщик1").Value, intPlatMaxLength)
WScript.StdOut.WriteLine
End With

.MoveNext
Loop

.Close
End With

Set objTS = Nothing

lngErrCode = 0
Else
WScript.StdErr.WriteLine "File [" & strSourceFile & "] not found"
lngErrCode = 2
End If
End With
Else
WScript.StdErr.WriteLine "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ ""<Source file>"""
lngErrCode = 1
End If

WScript.Quit lngErrCode
'=============================================================================

'=============================================================================
Function FormatString(anyValue, intLength)
Select Case TypeName(anyValue)
Case "Date"
FormatString = Left(CStr(anyValue) & Space(intLength), intLength)
Case "String"
FormatString = Left(CStr(anyValue) & Space(intLength), intLength)
Case "Integer", "Long"
FormatString = Right(Space(intLength) & CStr(anyValue), intLength)
Case "Currency"
FormatString = Right(Space(intLength) & FormatCurrency(anyValue, 2), intLength)
Case Else
FormatString = "<unsupported type " & TypeName(anyValue) & ">"
End Select
End Function
'=============================================================================

TRaMeLL

23-08-2012, 11:07

Неа, всё-равно не хочет выполняться, пишет:
"convert.vbs(52, 7) Ошибка выполнения Microsoft VBScript: Несоответствие типа: 'CCur'"
Вот мой файл - http://narod.ru/disk/59839075001.3973c425e86b9090bd2f0820e4391dd9/Kl_to_1c.zip.html

Iska

23-08-2012, 11:53

Хмм. У меня на Вашем файле отработало нормально. Результат исполнения отправил в личку.

Подозреваю, что дело может быть в региональных настройках. Выложите сюда файл «International.reg» — результат исполнения команды:
reg.exe export "HKEY_CURRENT_USER\Control Panel\International" "International.reg"
попробую смоделировать у себя.

TRaMeLL

23-08-2012, 12:49

Попробовал на Windows XP (RU) и на Windows 2000 SP4 (EN), тоже не запустился.
Вот ветка реестра от XP:
Windows Registry Editor Version 5.00

[HKEY_CURRENT_USER\Control Panel\International]
"iCountry"="7"
"iCurrDigits"="2"
"iCurrency"="1"
"iDate"="1"
"iDigits"="2"
"iLZero"="1"
"iMeasure"="0"
"iNegCurr"="5"
"iTime"="1"
"iTLZero"="1"
"Locale"="00000419"
"s1159"=""
"s2359"=""
"sCountry"="Россия"
"sCurrency"="р."
"sDate"="."
"sDecimal"=","
"sLanguage"="RUS"
"sList"=";"
"sLongDate"="d MMMM yyyy 'г.'"
"sShortDate"="dd.MM.yyyy"
"sThousand"="*"
"sTime"=":"
"sTimeFormat"="HH:mm:ss"
"iTimePrefix"="1"
"sMonDecimalSep"=","
"sMonThousandSep"="*"
"iNegNumber"="1"
"sNativeDigits"="0123456789"
"NumShape"="1"
"iCalendarType"="1"
"iFirstDayOfWeek"="0"
"iFirstWeekOfYear"="0"
"sGrouping"="3;0"
"sMonGrouping"="3;0"
"sPositiveSign"=""
"sNegativeSign"="-"

[HKEY_CURRENT_USER\Control Panel\International\Calendars]

[HKEY_CURRENT_USER\Control Panel\International\Calendars\TwoDigitYearMax]
"1"="2098"
"2"="2098"
"9"="2098"
"10"="2098"
"11"="2098"
"12"="2098"

[HKEY_CURRENT_USER\Control Panel\International\Geo]
"Nation"="203"
А это от 7 x64:
Windows Registry Editor Version 5.00

[HKEY_CURRENT_USER\Control Panel\International]
"Locale"="00000419"
"LocaleName"="ru-RU"
"s1159"=""
"s2359"=""
"sCountry"="Russia"
"sCurrency"="р."
"sDate"="."
"sDecimal"=","
"sGrouping"="3;0"
"sLanguage"="RUS"
"sList"=";"
"sLongDate"="d MMMM yyyy 'г.'"
"sMonDecimalSep"=","
"sMonGrouping"="3;0"
"sMonThousandSep"="*"
"sNativeDigits"="0123456789"
"sNegativeSign"="-"
"sPositiveSign"=""
"sShortDate"="dd.MM.yyyy"
"sThousand"="*"
"sTime"=":"
"sTimeFormat"="H:mm:ss"
"sShortTime"="H:mm"
"sYearMonth"="MMMM yyyy"
"iCalendarType"="1"
"iCountry"="7"
"iCurrDigits"="2"
"iCurrency"="1"
"iDate"="1"
"iDigits"="2"
"NumShape"="1"
"iFirstDayOfWeek"="0"
"iFirstWeekOfYear"="0"
"iLZero"="1"
"iMeasure"="0"
"iNegCurr"="5"
"iNegNumber"="1"
"iPaperSize"="9"
"iTime"="1"
"iTimePrefix"="0"
"iTLZero"="0"

[HKEY_CURRENT_USER\Control Panel\International\Geo]
"Nation"="203"

Iska

23-08-2012, 16:08

Дьявол кроется в деталях.
"sDecimal"=","
VBScript не может воспринять текст с точкой как Currency, поскольку у Вас десятичным разделителем служит запятая. Я у себя давно всё перевёл с запятой на точку.

Давайте попробуем сказать принудительно, что у Вас временно иная локаль:
Option Explicit

Const adInteger = 3
Const adCurrency = 6
Const adDate = 7
Const adVarChar = 200

Dim lngErrCode

Dim strSourceFile
Dim strLine

Dim objTS
Dim objRecordSet

Dim intNumberMaxLength
Dim intSummMaxLength
Dim intPlatMaxLength

If WScript.Arguments.Count = 1 Then
strSourceFile = WScript.Arguments.Item(0)

With WScript.CreateObject("Scripting.FileSystemObject")
If .FileExists(strSourceFile) Then
Set objTS = .OpenTextFile(strSourceFile)

With WScript.CreateObject("ADOR.Recordset")
With .Fields
.Append "Дата", adDate
.Append "Номер", adInteger
.Append "Сумма", adCurrency
.Append "ДлинаСтрокиСумма", adInteger
.Append "Плательщик1", adVarChar, 2^15 - 1
.Append "ДлинаСтрокиПлательщик1", adInteger
End With

.Open

Do Until objTS.AtEndOfStream
strLine = objTS.ReadLine()

Select Case Split(strLine, "=")(0)
Case "Дата"
.AddNew
.Fields.Item("Дата").Value = CDate(Split(strLine, "=")(1))
Case "Номер"
.Fields.Item("Номер").Value = CLng(Split(strLine, "=")(1))
Case "Сумма"
SetLocale "en-us"
.Fields.Item("Сумма").Value = CCur(Split(strLine, "=")(1))
SetLocale "ru"
.Fields.Item("ДлинаСтрокиСумма").Value = Len(FormatCurrency(.Fields.Item("Сумма").Value, 2))
Case "Плательщик1"
.Fields.Item("Плательщик1").Value = CStr(Split(strLine, "=")(1))
.Fields.Item("ДлинаСтрокиПлательщик1").Value = Len(CStr(Split(strLine, "=")(1)))
End Select
Loop

objTS.Close

.Sort = "Номер DESC" : .MoveFirst
intNumberMaxLength = Len(CStr(.Fields.Item("Номер").Value))

.Sort = "ДлинаСтрокиСумма DESC" : .MoveFirst
intSummMaxLength = .Fields.Item("ДлинаСтрокиСумма").Value

.Sort = "ДлинаСтрокиПлательщик1 DESC" : .MoveFirst
intPlatMaxLength = .Fields.Item("ДлинаСтрокиПлательщик1").Value

.Sort = "" : .MoveFirst

Do Until .EOF
With .Fields
WScript.StdOut.Write FormatString(.Item("Дата").Value, 10) & vbTab
WScript.StdOut.Write FormatString(.Item("Номер").Value, intNumberMaxLength) & vbTab
WScript.StdOut.Write FormatString(.Item("Сумма").Value, intSummMaxLength) & vbTab
WScript.StdOut.Write FormatString(.Item("Плательщик1").Value, intPlatMaxLength)
WScript.StdOut.WriteLine
End With

.MoveNext
Loop

.Close
End With

Set objTS = Nothing

lngErrCode = 0
Else
WScript.StdErr.WriteLine "File [" & strSourceFile & "] not found"
lngErrCode = 2
End If
End With
Else
WScript.StdErr.WriteLine "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ ""<Source file>"""
lngErrCode = 1
End If

WScript.Quit lngErrCode
'=============================================================================

'=============================================================================
Function FormatString(anyValue, intLength)
Select Case TypeName(anyValue)
Case "Date"
FormatString = Left(CStr(anyValue) & Space(intLength), intLength)
Case "String"
FormatString = Left(CStr(anyValue) & Space(intLength), intLength)
Case "Integer", "Long"
FormatString = Right(Space(intLength) & CStr(anyValue), intLength)
Case "Currency"
FormatString = Right(Space(intLength) & FormatCurrency(anyValue, 2), intLength)
Case Else
FormatString = "<unsupported type " & TypeName(anyValue) & ">"
End Select
End Function
'=============================================================================

А отчего такой странный разделитель:
"sThousand"="*"

TRaMeLL

23-08-2012, 17:22

Вот теперь идеально. Не знаю: что бы я без Вас делал, спасибо огроменное! :)
А в настройках я ничего не менял, даже не знаю почему такой разделитель.

Iska

24-08-2012, 00:53

Вот теперь идеально. »
Ну, вот и славненько.

Не знаю: что бы я без Вас делал, »
Да то же самое делали б, разве что сами.

TRaMeLL

26-09-2012, 07:59

Я снова за помощью. В реальных условиях, после перехода на новую систему файл Kl_to_1c.txt оказался другим и скрипт на нем не срабатывает.
Iska, написал вам PM, надеюсь на вашу помощь.