[Resolvido] File Reader

[xanburzum 169]

Este script pega um arquivo ascii, lê, compacta ,ele cria e depois o segundo arquivo quando executado unpacts o arquivo ASCII orig, para pessoas que não tem o WinZip ou qualquer coisa. ele faz bem o seu objectivo.

 

'Entradas: quantos arquivos, e cada nome de arquivo, saída de nome, e sub nome
	'
	'Retorno: o arquivo de saída, e cria uma
	'Pasta para ele
	'
	  
	Main
	Sub Main()
	Dim inp1
		inp1 = InputBox("Quantos arquivos")
	if IsNumeric (inp1) = False Then 
		MsgBox "Por favor, introduza um número", vbcritical, "Error"
		Exit Sub
	Else
		Do_it inp1
	End if
	End Sub
	Sub Do_it (howmany)
	Dim Inp1, Inp2, SubName
	For x = 1 To howmany
	Inp1 = InputBox("Origanal File:")
	Inp2 = InputBox("Output File:")
	SubName = InputBox("SubName:")
	ReadEntireFile Inp1, Inp2, SubName
	next
	End Sub
	function ReadEntireFile(Inp1, Inp2, Subname)
	Dim fso, fso1, theFile, thefile1, retstring, retstring1
	Set fso = CreateObject("Scripting.FileSystemObject") '10
	Set fso1 = CreateObject("Scripting.FileSystemObject")
	Set thefile = fso.OpenTextFile(Inp1, 1, False)
	Set thefile1 = fso1.OpenTextFile(Inp2, 2, True)
	Do While theFile.AtEndOfStream <> True
	retstring = theFile.ReadLine
	retstring1 = retstring1 & "Zigy = Zigy & " & chr(34) & Replace(retstring, chr(34), "@") & chr(34) & " & VbCrLf" & VbCrLf
	Loop
	theFile.Close
	thefile1.write "Make_" & SubName & VbCrLf
	thefile1.write "Create_Folder_" & SubName & VbCrLf '20
	thefile1.write "Move_File_" & SubName & VbCrLf '20
	thefile1.write "" & VbCrLf
	thefile1.write "Sub Make_" & SubName & VbCrLf
	thefile1.write "Dim fso, MyFile, Zigy" & VbCrLf
	thefile1.write "Set fso = CreateObject(" & chr(34) & "Scripting.FileSystemObject" & chr(34) & ")" & VbCrLf
	thefile1.write "Set MyFile = fso.CreateTextFile(" & chr(34) & SubName & ".txt" & chr(34) & ", True)" & VbCrLf
	thefile1.write retstring1
	thefile1.write "MyFile.write Replace(Zigy, " & chr(34) & "@" & chr(34) & ", Chr(34))" & VbCrLf
	thefile1.write "MyFile.close" & VbCrLf
	thefile1.write "End Sub" & VbCrLf
	thefile1.write VbCrLf '30
	thefile1.write VbCrLf
	thefile1.write "Sub Create_Folder_" & SubName & VbCrLf
	thefile1.write "Dim fso, f, f1" & VbCrLf
	thefile1.write "Set fso = CreateObject(" & chr(34) & "Scripting.FileSystemObject" & chr(34) & ")" & VbCrLf
	thefile1.write "Set f1 = fso.GetFile(" & chr(34) & SubName & ".txt" & chr(34) & ")" & VbCrLf
	thefile1.write "Set f = fso.CreateFolder( f1.ParentFolder &" & chr(34) & "\" & SubName & chr(34) & ")" & VbCrLf
	thefile1.write "End Sub" & VbCrLf
	thefile1.write VbCrLf
	thefile1.write VbCrLf
	thefile1.write "Sub Move_File_"& SubName & VbCrLf '40
	thefile1.write "Dim fso, f" & VbCrLf
	thefile1.write "Set fso = CreateObject(" & chr(34) & "Scripting.FileSystemObject" & chr(34) & ")" & VbCrLf
	thefile1.write "Set f = fso.GetFile(" & chr(34) & SubName & ".txt" & chr(34) & ")" & VbCrLf
	thefile1.write "fso.MoveFile " & chr(34) & SubName & ".txt" & chr(34) & ", f.ParentFolder & " & chr(34) & "\" & SubName & "\" & SubName & ".txt" & chr(34) & VbCrLf
	thefile1.write "End Sub" & VbCrLf
	thefile1.close
	End function