Ветеран
Сообщения: 27449
Благодарности: 8087
|
Профиль
|
Отправить PM
| Цитировать
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
'=============================================================================
На копейки не рассчитано. Если могут присутствовать — надо будет править код.
|
Отправлено: 08:39, 22-08-2012
| #9
|