Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Показать сообщение отдельно

Ветеран


Сообщения: 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