i want to extract data from db2 mainframe which uses IBM code page 285 (EBCDIC code page)
with vbscript but saving this file (xml data) it displays wrong way.
How can i convert vbscript RecSet from 285 to ASCII or UTF-8 before saving file?
Function used for saving file:
Function WriteFileText( sText, sFileName)
Dim sFilePath
Dim objFSO 'As FileSystemObject
Dim objTextFile 'As Object
Dim i
Dim arr
sFilePath = "c:\jdk1.3\temp\" & sFileName
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.CreateTextFile(sFilePath, True, True)
a = 0
for i=1 to len(sText)
s2Text = right(left(sText,i),1)
if i > 54 and asc(s2Text) = 63 then a = a + 1 else objTextFile.Write (s2Text) end if
next
objTextFile.Close
'' Set objTextFile = objFSO.CreateTextFile(sFilePath, True, True)
'' used to convert to UTF8, as if only one True error appears when writing to file
See How to convert between ASCII and EBCDIC character codes. It's written in VB but whould be easy to convert to VBScript.
Related
My IBM MQ is not accepting XML file saved in UTF-8 format. I want to try if it accepts UTF-8 without BOM format. I have tried multiple things, but was unable to save the file in non-BOM format. My code is below.
Dim objStreamUTF8 : Set objStreamUTF8 = CreateObject("ADODB.Stream")
Dim objStreamUTF8NoBOM : Set objStreamUTF8NoBOM = CreateObject("ADODB.Stream")
With objStreamUTF8
.Charset = "UTF-8"
.Mode = 3
.Type = 2
.Open
objStreamUTF8.LoadFromFile uxtNewRenamePath'"C:\WINDOWS\Temp\DataFiles\TC10_ Apostrophe symbol in tag Cdtr_Adrline2_Pacs8_TxID201765133641.xml"
objStreamUTF8.Flush
strFileText = objStreamUTF8.ReadText()
strFileText = Replace(strFileText,"&#", "&#")
strFileText = Replace(Replace(Replace(Replace(Replace(strFileText, "GreaterThanSymbol", ">"), "LessThanSymbol", "<"), "ApostropheSymbol", "'"), "AmpersandSymbol", "&"), "DoubleQuotesSymbol", chr(34))
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile uxtNewRenamePath, True
Set objFSO = Nothing
.Position = 0
.Flush
.WriteText strFileText
.SaveToFile uxtNewRenamePath, 2
.Close
.Type = 1
.Open
.Position = objStreamUTF8.Size
End With
With objStreamUTF8NoBOM
.Mode = 3
.Type = 1
.Open
objStreamUTF8.CopyTo objStreamUTF8NoBOM
.SaveToFile uxtNewRenamePath, 2
End With
objStreamUTF8.Close
objStreamUTF8NoBOM.Close
When objStreamUTF8NoBOM is saved to file, the file is completely blank. Can you please tell me what I am doing wrong or how I can save the file in the desired format?
Got it. The position of the first stream has to be set to 3rd postion to skip BOM characters
i.e. objStreamUTF8.Position = 3
I have a directory of files that I want to Loop through and use part of their filename to replace text in a template doc.
For example one filename may be 'NV_AD32_city.dxf'. All files in the directory follow the same filename pattern of XX_XXXX_string.dxf, using two underscores.
I need to capture the string to the right of the first "_" and to the left of the "."so for this example that would be 'AD32_city'
How do I script to use capture that text of the active file to replace text in the template? I guess I need to create an object? But what is the object to use for the current file from a directory?
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Thx for the replies, guys. After several days of trying your code I am just not "getting it". I understand it is set up to take the part of the filename's string that I want but how do I tell the script to use the current file I am looping through? Here is my script so far. I have your code on line 20 under the Sub 'GetNewInputs'
Set fso = CreateObject("Scripting.FileSystemObject")
Option Explicit
Dim WritePath : WritePath = "S:\TempFolder\"
Dim OutFile : OutFile = "VEG_DXF-2-SHP_script-"
Dim WorkingFile : WorkingFile = GetFileContent(SelectFile())
Dim NewState, NewSection, NewArea
Dim OldState, OldSection, OldArea
Call GetNewInputs()
Call GetOldInputs()
Sub GetNewInputs()
NewState = UCase(InputBox("INPUT STATE:", _
"INPUT STATE", "SOCAL"))
NewSection = ("Section_" & InputBox("INPUT SECTION NUMBER:", _
"INPUT SECTION", "14"))
NewArea = "^[^_]+_(.*)\.dxf$"
End Sub
Private Sub GetOldInputs()
OldState = "XX"
OldSection = "_X"
OldArea = "ZZZZ"
End Sub
Function SelectFile()
SelectFile = vbNullString
Dim objShell : Set objShell = WScript.CreateObject("WScript.Shell")
Dim strMSHTA : strMSHTA = "mshta.exe ""about:" & "<" & "input type=file id=FILE>" _
&"<" & "script>FILE.click();new ActiveXObject('Scripting.FileSystemObject')" _
&".GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);" & "<" & "/script>"""
SelectFile = objShell.Exec(strMSHTA).StdOut.ReadLine()
If SelectFile = vbNullString Then
WScript.Echo "No file selected or not a text file."
WScript.Quit
End If
End Function
Private Function GetFileContent(filePath)
Dim objFS, objFile, objTS
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFile = objFS.GetFile(filePath)
Set objTS = objFile.OpenAsTextStream(1, 0)
GetFileContent = objTS.Read(objFile.Size)
Set objTS = Nothing
End Function
For Each FileRefIn fso.GetFolder("S:\SOCAL\Section_14\Veg DXFs\").Files
NewFile = WorkingFile
NewFile = Replace(NewFile, OldState, NewState)
NewFile = Replace(NewFile, OldSection, NewSection)
NewFile = Replace(NewFile, OldArea, NewArea)
WriteFile NewFile, WritePath & OutFile & ".gms"
WScript.Echo NewArea
Next
Private Sub WriteFile(strLine,fileName)
On Error Resume Next
Dim objFSO, objFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Do Until IsObject(objFile)
Set objFile = objFSO.OpenTextFile(fileName, 8, True)
Loop
objFile.WriteLine strLine
objFile.Close
End Sub
Well, that’s actually two questions.
To enumerate files in a directory, you can use FileSystemObject, like this (untested)
const strFolderPath = "C:\Temp\Whatever"
set objFSO = CreateObject( "Scripting.FileSystemObject" )
set objFolder = objFSO.GetFolder( strFolderPath )
set colFiles = objFolder.Files
for each objFile in colFiles
' Do whatever you want with objFile
next
Here's the reference of those objects properties/methods.
And to extract portion of file names, you could use a regular expression.
Here’s some guide how to use'em in VBScript.
The following expression should work for you, it will capture the portion of that file names you asked for:
"^[^_]+_(.*)\.dxf$"
If you need to edit the content of the .dxf files, you will need to work within the AutoCAD VBA (Visual Basic for Applications) environment.
If that is the case, you will need to start with something like below:
GetObject("AutoCAD.Application.20")
CreateObject("AutoCAD.Application.20")
https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2015/ENU/AutoCAD-ActiveX/files/GUID-0225808C-8C91-407B-990C-15AB966FFFA8-htm.html
** Please take note that "VBA is no longer distributed with the AutoCAD installation; it must be downloaded and installed separately. The VBA Enabler for Autodesk AutoCAD can be downloaded here."
I have two text files with following content:
file1.txt:
Windows 1.36
Linux 2.78
MacOS 3.45
Ubuntu 4.12
FreePhysicalMemory 30.12
TotalVisibleMemorySize 48.00
file2.txt:
MacOS 6.39
Windows 4.42
Linux 5.76
Android 3.46
FreePhysicalMemory 31.65
TotalVisibleMemorySize 48.00
output.xls:
OPERATING SYSTEM SERVER1 SERVER2
Windows 1.36 4.42
Linux 2.78 5.76
MacOS 3.45 6.39
Ubuntu 4.12 0.00
Android 0.00 3.46
FreePhysicalMemory 30.12 31.65
TotalVisibleMemorySize 48.00 48.00
I want to achieve following two things in a VBScript program or in any, which is appropriate to run on windows server:
Insert the contents of both file1.txt and fil2.txt in a excel
sheet output.xls like above.
Mail the content of output.xls file as a body in email.
I think, Point2 is being achieved using below code but not getting how can i achieve Point1 in same program.
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const FileToBeUsed = "c:\output.xls"
Dim objCDO1
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(FileToBeUsed, ForReading)
Set objCDO1 = CreateObject("CDO.Message")
objCDO1.Textbody = f.ReadAll
f.Close
objCDO1.TO ="sunny#abc.com"
objCDO1.From = "dontreply#abc.com"
objCDO1.Subject = "Server Memory"
objCDO1.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration /sendusing") = 2
objCDO1.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtpb.intra.abc.com"
objCDO1.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration /smtpserverport") = 25
objCDO1.Configuration.Fields.Update
objCDO1.Send
Set f = Nothing
Set fso = Nothing
Any suggestion is highly appreciated.
Note:My purpose here is to send email with properly formatted and aligned data.
EDIT1:
This is all i could do regarding points 1,2,3.
Don't know how to consolidate all this in a HTML email Body format..:(
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Dim fso,f,objFSO,objFile,objRE, FileName
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
const strFileName1 = "D:\file1.txt"
const strFileName2 = "D:\file2.txt"
Set objFile = objFSO.OpenTextFile(strFileName1, fsoForReading) + objFSO.OpenTextFile(strFileName2, fsoForReading)
objobjFile.Close
Set objFile = Nothing
Set objFSO = Nothing
Set objRE = New RegExp
With objRE
.Pattern = "[A-Z][0-9]"
.IgnoreCase = False
.Global = False
End With
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
const strFileName1 = "D:\file1.txt"
const strFileName2 = "D:\file2.txt"
Set objFile = objFSO.OpenTextFile(strFileName1, fsoForReading) + objFSO.OpenTextFile(strFileName2, fsoForReading)
Do Until objFile.AtEndOfStream
strSearchString = objFile.ReadLine
Set colMatches = objRegEx.Execute(strSearchString)
If colMatches.Count > 0 Then
For Each strMatch in colMatches
Wscript.Echo strSearchString
Next
End If
Loop
objFile.Close
Class memory1class
Public operatingsystem, memory
End Class
Dim memory1dict: Set memory1 = CreateObject("Scripting.Dictionary")
Dim memory2dict: Set memory2 = CreateObject("Scripting.Dictionary")
Dim memory1: Set memory1 = new memory1class
With memory1
.operatingsystem = "?"
.memory = "?"
End With
memory1dict.Add "1", memory1
Dim memory1details: Set memory1details = memory1dict.Item("1")
WScript.StdOut.WriteLine("operatingsystem:" & memory1details.first & " " & memory1details.memory & " )
I don't want to directly give you code, because this is a good opportunity for you to learn more about the different options you have available for solving the problem yourself, but I can give you a rough outline of what I would do.
Open the two text files for reading. Windows provides a "Scripting" library which contains the FileSystemObject. You would declare an instance of it as below, and you can google for the specifics of how to use it to open a text file:
Set fso = CreateObject("Scripting.FileSystemObject")
Read each file in a line at a time. Parse each line to get the "name" part and the "number" part as distinct values. You can do this by combining the InStr, InStrRev, and Mid functions or you can use the more powerful RegExp library (VBScript's Regular Expression class).
Set re = New RegExp
Store each "name" and "value" into a data structure for later use - I recomment an associative array such as VBScript's Dictionary class. Using a separate one for each text file will allow you to cross-reference them later.
Set dictStats1 = CreateObject("Scripting.Dictionary")
To display the data formatted correctly in the email, I suggest using an HTML table. In addition to the TextBody, the CDO.Message object has an HTMLBody property to allow you to give the email structured formatting instead of just raw text. Extrapolating from the simple example on w3school.com, you can construct a function that will accept the two dictionaries and use them to construct the HTML table and return it as a string to be loaded into the email via the HTMLBody property.
I hope that helps! Let me know if you have any questions about the specifics.
I used earlier ADODB.Stream to read and to write binary file here is the link for that
How to concatenate binary file using ADODB.stream in VBscript
it works fine the only problem is ADODB.stream is disabled on windows 2003 server,
Is there another way i can read 3 files in binary mode and concatenate them or store them in one file in VBscript
thank you
Jp
Based on Luc125 and Alberto answers here are the 2 reworked and simplified functions:
The Read function
Function readBinary(strPath)
Dim oFSO: Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim oFile: Set oFile = oFSO.GetFile(strPath)
If IsNull(oFile) Then MsgBox("File not found: " & strPath) : Exit Function
With oFile.OpenAsTextStream()
readBinary = .Read(oFile.Size)
.Close
End With
End Function
The Write function
Function writeBinary(strBinary, strPath)
Dim oFSO: Set oFSO = CreateObject("Scripting.FileSystemObject")
' below lines pupose: checks that write access is possible!
Dim oTxtStream
On Error Resume Next
Set oTxtStream = oFSO.createTextFile(strPath)
If Err.number <> 0 Then MsgBox(Err.message) : Exit Function
On Error GoTo 0
Set oTxtStream = Nothing
' end check of write access
With oFSO.createTextFile(strPath)
.Write(strBinary)
.Close
End With
End Function
I had a similar problem a year ago. We know that the TextStream objects are intended for ANSI or Unicode text data, not binary data; their .readAll() method produces a corrupted output if the stream is binary. But there is workaround. Reading the characters one by one into an array works fine. This should allow you to read binary data into VB strings, and write it back to disk. When further manipulating such binary strings do not forget that certain operations may result into broken strings because they are intended for text only. I for one always convert binary strings into integer arrays before working with them.Function readBinary(path)
Dim a
Dim fso
Dim file
Dim i
Dim ts
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.getFile(path)
If isNull(file) Then
MsgBox("File not found: " & path)
Exit Function
End If
Set ts = file.OpenAsTextStream()
a = makeArray(file.size)
i = 0
' Do not replace the following block by readBinary = by ts.readAll(), it would result in broken output, because that method is not intended for binary data
While Not ts.atEndOfStream
a(i) = ts.read(1)
i = i + 1
Wend
ts.close
readBinary = Join(a,"")
End Function
Sub writeBinary(bstr, path)
Dim fso
Dim ts
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set ts = fso.createTextFile(path)
If Err.number <> 0 Then
MsgBox(Err.message)
Exit Sub
End If
On Error GoTo 0
ts.Write(bstr)
ts.Close
End Sub
Function makeArray(n) ' Small utility function
Dim s
s = Space(n)
makeArray = Split(s," ")
End Function
The ADODB stream object is VBScript's only native method of reading binary streams. If ADODB is disabled, you will need to install some other third-party component to provide the same functionality.
It is possible to read all bytes together:
Set FS = CreateObject("Scripting.FileSystemObject")
Set fil = FS.GetFile(filename)
fpga = fil.OpenAsTextStream().Read(file.Size)
ADODB stream object is VBScript's only native method of reading binary streams
Const TypeBinary = 1
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Function readBytes(file)
Dim inStream: Set inStream = WScript.CreateObject("ADODB.Stream") ' ADODB stream object used
inStream.Open ' open with no arguments makes the stream an empty container
inStream.type= TypeBinary
inStream.LoadFromFile(file)
readBytes = inStream.Read()
End Function
Sub writeBytes(file, bytes)
Dim binaryStream: Set binaryStream = CreateObject("ADODB.Stream")
binaryStream.Type = TypeBinary
binaryStream.Open 'Open the stream and write binary data
binaryStream.Write bytes
binaryStream.SaveToFile file, ForWriting 'Save binary data to disk
End Sub
Read 3 files & join to one file (without ADODB):
Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FileExists("out.bin") Then oFSO.DeleteFile("out.bin")
Dim outFile : Set outFile = oFSO.OpenTextFile("out.bin", 8, true)
' 3 input files to concatenate
Dim oFS1 : Set oFS1 = oFSO.GetFile("in1.bin")
Dim oFS2 : Set oFS2 = oFSO.GetFile("in2.bin")
Dim oFS3 : Set oFS3 = oFSO.GetFile("in3.bin")
Dim read1 : Set read1 = oFS1.OpenAsTextStream()
Dim read2 : Set read2 = oFS2.OpenAsTextStream()
Dim read3 : Set read3 = oFS3.OpenAsTextStream()
Dim write1 : write1 = read1.Read(oFS1.Size)
read1.Close
outFile.write(write1)
Dim write2 : write2 = read2.Read(oFS2.Size)
read2.Close
outFile.write(write2)
Dim write3 : write3 = read3.Read(oFS3.Size)
read3.Close
outFile.write(write3)
outFile.Close
Tested on audio, video, image, zip archives & pdf (binaries) on Win 10 for binary file copy, edit, split, join, patching & (byte level) encryption, encoding & compression.
See example (answer) here for binary file patching.
How do I replace text from one file with text from another file using vbscript?
The text being replaced is somewhere in the middle of the file.
filea.txt:
hello cruel world
fileb.txt:
cruel
filec.txt:
happy
will make sResult = "hello happy world" after the following has executed.
Dim oFSO
Dim sFileAContents
Dim sFileBContents
Dim sFileCContents
Dim sResult
Set oFSO = CreateObject("Scripting.FileSystemObject")
sFileAContents = oFSO.OpenTextFile("c:\filea.txt").ReadAll()
sFileBContents = oFSO.OpenTextFile("c:\fileb.txt").ReadAll()
sFileCContents = oFSO.OpenTextFile("c:\filec.txt").ReadAll()
sResult = Replace(sFileAContents, sFileBContents, "")
FileToSearch is the file with the text you want to search for replacement
FileReplaceText is the file containing the replacement text
Edit the value of the variable strTextToFind to contain the text you are searching for and replacing
Dim objFSO
Dim strFileToSearch
Dim strFileReplaceText
Dim strTextToFind
Dim strTextToSearch
Dim strTextReplaceText
Dim strFinalText
strFileToSearch = "C:\FileToSearch.txt"
strFileReplaceText = "C:\FileReplaceText.txt"
strTextToFind = "text to search for here"
Set objFSO = CreateObject("Scripting.FileSystemObject")
strTextToSearch = objFSO.OpenTextFile(strFileToSearch).ReadAll()
strFileReplaceText = objFSO.OpenTextFile(strFileReplaceText).ReadAll()
strFinalText = Replace(strTextToSearch, strTextToFind, strFileReplaceText)
If you want to write this final text back out to a file then add this code:
Const ForWriting = 2
Dim strFileFinalOutput
strFileFinalOutput = "C:\FileFinalOutput.txt"
Set objTextFile = objFSO.OpenTextFile(strFileFinalOutput, ForWriting, True)
objTextFile.Write strFinalText
objTextFile.Close
Set objTextFile = Nothing
This code reads the entire file into memory (.ReadAll) and may experience problems with very large files. In this case, the code can be edited to read/search/replace/write the data line by line.
If the text you are searching for is not continuous and all on the same line then the search/replace process is more involded and this code will need additional work to handle it.