I am trying to create ADODB.Stream object in VBscript. This is the function:
Function ByteArray2Text(varByteArray)
'Convert byte array into a string with ADODB.Stream
'Data should be real plain text because binary data will be mangled
Dim byt
Const adTypeText = 2
Const adTypeBinary = 1
Set byt = CreateObject("ADODB.Stream")
byt.Type = adTypeBinary
byt.Open
byt.Write varByteArray
byt.Position = 0
byt.Type = adTypeText
byt.CharSet = "us-ascii"
ByteArray2Text = byt.ReadText
byt.Close
Set byt = Nothing
End Function
When I try to run this function i am getting error:
Microsoft VBScript runtime error: ActiveX component can't create object: 'ADODB.Stream'
What i need to do, to create this ADODB.Stream object?
Make sure that you have MDAC installed.
You also can try Microsoft Jet 4.0
You can also register these DLLs:
REGSVR32 "(path to "common files")\System\ole db\sqloledb.dll"
REGSVR32 "(path to "common files")\System\ole db\Oledb32.dll"
REGSVR32 "(path to "common files")\System\ole db\Msdasql.dll"
REGSVR32 "(path to "common files")\System\msadc\Msadce.dll"
They have relation with ADOdb
Make sure that:
The Stream component exits on your computer.
If it exists, type this at run dialog:
regsvr32 "path\stream_file_here.dll"
Chances are that the steam component file has been unregistered in the registry and you can't create an object of that.
Related
I have problems getting launching some shortcuts and getting their icon for some strange and unknown reason, using the following methods :
Public Shared Sub Launch(itemToLaunch As String)
Process.Start(itemToLaunch)
End Sub
Public Function GetShellIcon(ByVal path As String) As Icon
Dim info As SHFILEINFO = New SHFILEINFO()
Dim retval As IntPtr = SHGetFileInfo(path, 0, info, Marshal.SizeOf(info), SHGFI_ICON Or SHGFI_SMALLICON Or SHGFI_LARGEICON)
If retval = IntPtr.Zero Then
Return New Icon(GetType(Control), "Error.ico")
End If
Dim cargt() As Type = {GetType(IntPtr)}
Dim ci As ConstructorInfo = GetType(Icon).GetConstructor(BindingFlags.NonPublic Or BindingFlags.Instance, Nothing, cargt, Nothing)
Dim cargs() As Object = {info.IconHandle}
Dim icon As Icon = CType(ci.Invoke(cargs), Icon)
Return icon
End Function
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)>
Private Structure SHFILEINFO
Public IconHandle As IntPtr
Public IconIndex As Integer
Public Attributes As UInteger
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=260)>
Public DisplayString As String
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=80)>
Public TypeName As String
End Structure
Private Declare Auto Function SHGetFileInfo Lib "Shell32.dll" (path As String, attributes As Integer, ByRef info As SHFILEINFO, infoSize As Integer, flags As Integer) As IntPtr
Public Const SHGFI_ICON = &H100
Public Const SHGFI_SMALLICON = &H1
Public Const SHGFI_LARGEICON = &H0 ' Large icon
These methods works well on almost any item, but sometimes they send me a System.ComponentModel.Win32Exception in System.dll when trying to execute a shortcut file, and on these same files, getting their icon.
It gives me the following message (given by Process.Start is called with a ProcessStartInfo parameter with ErrorDialog=True) :
This error is different than the one that is raised if the path to the .lnk file is not correct pointing to an non existing file :
As an example, you can reproduce this problem this way :
Locate on a Windows 7 install the following files :
C:\Program Files\DVD Maker\DVDMaker.exe (native with Windows 7)
C:\Program Files\WinRAR\WinRAR.exe (v5.0 64 bits, but I guess this will have the same effect with another version)
C:\Program Files\Windows NT\Accessories\wordpad.exe (native with Windows 7)
Copy each of them to the Desktop
With a right-click-drag, create 3 links shortcuts for each of these 3 files from their original location to the desktop. Renames these Shortcuts (for convenience) "[Filename] linkorig"
With a right-click-drag, create 3 links shortcuts for each of the 3 copied files from the Desktop to the desktop. Renames these Shortcuts (for convenience) "[Filename] linkcopy"
Create a Visual basic project, put 4 PictureBoxes onto a Form and name them :
ExeOrigPictureBox
ExeCopyPictureBox
LnkOrigPictureBox
LnkCopyPictureBox
And some Labels to help yourself.
Then copy/paste the following code into the Form code window :
Imports System.Reflection
Imports System.Runtime.InteropServices
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
Me.ExeOrigPictureBox.Tag = "C:\Program Files\WinRAR\WinRAR.exe"
Me.ExeCopyPictureBox.Tag = "C:\Users\Moi\Desktop\WinRAR.exe"
Me.LnkOrigPictureBox.Tag = "C:\Users\Moi\Desktop\WinRAR.exe linkorig.lnk"
Me.LnkCopyPictureBox.Tag = "C:\Users\Moi\Desktop\WinRAR.exe linkcopy.lnk"
Me.ExeOrigPictureBox.Image = GetShellIcon(Me.ExeOrigPictureBox.Tag).ToBitmap
Me.ExeCopyPictureBox.Image = GetShellIcon(Me.ExeCopyPictureBox.Tag).ToBitmap
Me.LnkOrigPictureBox.Image = GetShellIcon(Me.LnkOrigPictureBox.Tag).ToBitmap
Me.LnkCopyPictureBox.Image = GetShellIcon(Me.LnkCopyPictureBox.Tag).ToBitmap
End Sub
Private Sub ExeOrigPictureBox_Click(sender As Object, e As EventArgs) Handles ExeOrigPictureBox.Click, ExeCopyPictureBox.Click, LnkOrigPictureBox.Click, LnkCopyPictureBox.Click
Dim pBox As PictureBox = DirectCast(sender, PictureBox)
Dim pi As ProcessStartInfo = New ProcessStartInfo
pi.FileName = pBox.Tag
pi.ErrorDialog = True
Process.Start(pi)
End Sub
End Class
Module Shell32
Public Function GetShellIcon(ByVal path As String) As Icon
Dim info As SHFILEINFO = New SHFILEINFO()
Dim retval As IntPtr = SHGetFileInfo(path, 0, info, Marshal.SizeOf(info), SHGFI_ICON Or SHGFI_SMALLICON Or SHGFI_LARGEICON)
If retval = IntPtr.Zero Then
Return New Icon(GetType(Control), "Error.ico")
End If
Dim cargt() As Type = {GetType(IntPtr)}
Dim ci As ConstructorInfo = GetType(Icon).GetConstructor(BindingFlags.NonPublic Or BindingFlags.Instance, Nothing, cargt, Nothing)
Dim cargs() As Object = {info.IconHandle}
Dim icon As Icon = CType(ci.Invoke(cargs), Icon)
Return icon
End Function
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)>
Private Structure SHFILEINFO
Public IconHandle As IntPtr
Public IconIndex As Integer
Public Attributes As UInteger
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=260)>
Public DisplayString As String
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=80)>
Public TypeName As String
End Structure
Private Declare Auto Function SHGetFileInfo Lib "Shell32.dll" (path As String, attributes As Integer, ByRef info As SHFILEINFO, infoSize As Integer, flags As Integer) As IntPtr
Public Const SHGFI_ICON = &H100
Public Const SHGFI_SMALLICON = &H1
Public Const SHGFI_LARGEICON = &H0 ' Large icon
End Module
Then execute.
You will obtain the following :
Clicking on any of the well displayed icons launches the WinRar application.
Clicking on the bad displayed icon displays this error :
Changing the value of Me.LnkOrigPictureBox.Tag with a wrong path like "C:\Users\Moi\Desktop\WinRARdontexistshere.exe linkorig.lnk" and doing the same thing displays another visual and error (as expected) :
This don't work neither with DVDMaker.exe
But everything is fine with wordpad.exe, icon and application launch.
(I've tested the case of the lower/uppercase to see if it interfers, but this is not the problem)
I've noticed the problem on some other apps without understanding the reasons of this, for example :
Paint .net
VirtualBox
CloneSpy
VirtualDub
and other standard Windows apps.
When copy/pasting the problematic file path C:\Users\Moi\Desktop\WinRAR.exe linkorig.lnk onto a Windows explorer title bar, the WinRAR.exe app is launched.
Of course same thing is I double-click the .lnk file.
It is also launched well when copy/pasted into a Windows-R command window.
And also launched if called by typing WinRAR.lnk from a command-line window being placed in the C:\Users\Moi\Desktop\ folder.
I'm running onto a Windows 7 64 bits. The app is compiled using Visual Studio Express 2015. I'm logged as administrator (the one and only default account created on the Windows install). Runing the compiled app "as an administrator" does not change anything.
I tried using some configurations such the following without success :
Dim info As ProcessStartInfo = New ProcessStartInfo(--- here the path ---)
info.CreateNoWindow = False
info.UseShellExecute = False
info.RedirectStandardError = True
info.RedirectStandardOutput = True
info.RedirectStandardInput = True
Dim whatever As Process = Process.Start(info)
How could I solve this launch problem, and the icon retrieval problem of these files ?
Woow... I found the answer by luck when I saw, making some tests with some examples found over the net, that the icon problem and the error message when trying to use the corresponding file was also present when using a standard OpenFileDialog. I suspected a bug in the .Net framework. And the solution was near this, and I still don't really understand its deep reasons.
The problem was the following :
The project was defined by default into the project settings to run with .Net Framework 4.5
I switched it to run with Framework 4
Runned the app : no more problem
I switched it back to run with Framework 4.5
No more problem at all.
I am having trouble sending a propertybag over winsock. I have a client/server application that sends images through using a propertybag. I convert the propertybag into a byte array and try to send it over winsock and then when I convert the byte array back to a propertybag, it cant seem to read it. It looks like the data was corrupted when it was sent.
Client(sending propertybag)
Dim pb As PropertyBag
Dim byt() As Byte
Set pb = New PropertyBag
pb.WriteProperty "picc", Image1.Picture
byt = pb.Contents
Winsock1.SendData byt
Server(Receiving propertybag)
Dim byt() As Byte
Dim pb As PropertyBag
Set pb = New PropertyBag
Winsock1.GetData byt, vbByte
pb.Contents = byt
Image1.Picture = pb.ReadProperty("picc")
The error I received:
Run-time error '327':
Data value named 'picc' not found
When I try to do execute the code in a single program without winsock, it works just fine. The problem occurs when I send the byte array over winsock.
Most people also utilize the ADO stream object (add reference to Microsoft ActiveX Data Objects 2.5 or whatever version) by going to Project -> References.
Here is a working example you can download using a PropertyBag as well as the ADO stream object.
It's called PicturePicture.zip and written by a very Winsock & client/server-knowledgeable programmer.
I'm trying to create named pipe using VBScript on win7.
This is my code (took from there):
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("\\.\pipe\PipeName", True)
a.WriteLine("This is a test.")
a.Close
But i got an error (manual translate, so may be not accurate):
test.vbs(2, 1) Microsoft VBScript runtime error: File not found
Same code with ordinary text file works fine:
Set a = fs.CreateTextFile(".\\PipeName", True)
But, when i tried to escape backslashes:
Set a = fs.CreateTextFile("\\\\.\\pipe\\PipeName", True)
I got:
test.vbs(2, 1) Microsoft VBScript runtime error: Path not found
UPD: I run script as administrator.
UPD2: I'm found another solution for my problem without using pipes, so my question is a little outdated, but I don't know what to do with it.
Did you create a named pipe server called 'PipeName'? This code works for me (I named my pipe 'HelloWorld'):
C# Server:
static void Main(string[] args)
{
using (var pipe = new NamedPipeServerStream("HelloWorld"))
{
pipe.WaitForConnection();
StreamReader reader = new StreamReader(pipe);
var line = reader.ReadLine();
Console.WriteLine(line);
}
Console.ReadLine();
}
VBScript Client:
Dim fs, pipe
Set fs = CreateObject("Scripting.FileSystemObject")
Set pipe = fs.OpenTextFile("\\.\pipe\HelloWorld", 8, False, 0)
pipe.WriteLine("This is my message")
pipe.Close
I tried to work with named pipe from VBScript. I failed to create named pipe by fso.CreateTextFile("\\.\pipe\MyPipe").
But I successfully connected from VBScript from with Pipe created by classical application:
Pipe was created by such code (pascal):
procedure OpenTestPipe;
var
i,hOut: Integer;
begin
hOut:=CreateNamedPipe('\\.\pipe\Test.htm',PIPE_ACCESS_OUTBOUND,PIPE_TYPE_BYTE,PIPE_UNLIMITED_INSTANCES,1024,1024,NMPWAIT_USE_DEFAULT_WAIT,nil);
i:=FileWrite(hOut,'Hello'#13#10,7);
MessageBox(0,'Pipe is opened','Pipe sample',0);
FileClose(hOut);
end;
When MessageBox was shown I opened VBScript
Set fso = CreateObject("Scripting.FileSystemObject")
MsgBox fso.OpenTextFile("\\.\pipe\test.htm",1).readLine
And got a message Hello
VBscript example:
Function ADO_WriteToFile(FileURL,data)
Dim arrBytes
SET ADObj = CreateObject("ADODB.Stream")
ADObj.Open
ADObj.Charset = "iso-8859-1"
ADObj.Type = adTypeText
ADObj.WriteText data
ADObj.SaveToFile FileURL, adSaveCreateOverwrite
ADObj.Close
ADObj.Open
ADObj.Type = adTypeBinary
ADObj.LoadFromFile FileURL
ADObj.Position = 3
arrBytes = ADObj.Read
ADObj.Position = 0
ADObj.SetEOS
ADObj.Write data
ADObj.SaveToFile FileURL, adSaveCreateOverwrite
ADObj.Close
End Function
JScript example:
function writeTo(fileName,str) {
var ado = new ActiveXObject("ADODB.Stream");
ado.Type = 2;
ado.Open();
ado.Position = 0;
ado.WriteText(str,0);
ado.SaveToFile(fileName,2);
ado.Close();
ado.Open();
ado.Type = 1;
ado.Position = 2;//line 19
var temp = ado.Read();
ado.Position = 0;
ado.SetEOS;
ado.Write(temp);
ado.SaveToFile(fileName,2);
ado.Close();
}
Why does the VBScript example work perfectly except for the fact that it can't accept file paths with space in them?
The JScript example errors out with the message "assignment to the parameter is incorrect." line 19. This doesn't happen if I set Position to 0 however:
ado.Position = 0;
i am using this to write binary files to disk btw
Here are some differences:
In the VBScript version, position is set to 3; in the JScript version, it is set to 2
In the VBScript version, the character set is defined; in the JScript version, it is undefined
In the VBScript version, WriteText and write both reference the argument; in the JScript version, only WriteText references it
References
Use vs Mention in JScript doesn't come for Free
JScript Data Types: Data Type Summary
I'm using Exchange Web Services Managed API 1.1 to connect to Exchange server 2010 and then find out new emails received. Now I want to save a copy of the .msg file to a folder on the disk.
I do not want to use any paid third party to integrate.
Any help will be appreciated.
If you are happy to save into the .eml format instead, it can be done very easily just using EWS and no third party libraries. The .eml file will contain all the same information and can be opened by Outlook in the same way as .msg (and also by other programs).
message.Load(new PropertySet(ItemSchema.MimeContent));
MimeContent mc = message.MimeContent;
FileStream fs = new FileStream("c:\test.eml", FileMode.Create);
fs.Write(mc.Content, 0, mc.Content.Length);
fs.Close();
Cleaned up code:
message.Load(new PropertySet(ItemSchema.MimeContent));
var mimeContent = message.MimeContent;
using (var fileStream = new FileStream(#"C:\Test.eml", FileMode.Create))
{
fileStream.Write(mimeContent.Content, 0, mimeContent.Content.Length);
}
There is no native support for MSG files using EWS. It's strictly an Outlook format.
The MSG spec is published at http://msdn.microsoft.com/en-us/library/cc463912%28EXCHG.80%29.aspx. It's a little complicated to understand, but do-able. You would need to pull down all of the properties for the message and then serialize it into an OLE structured file format. It's not an easy task.
In the end, you are probably better off going with a 3rd party library otherwise it might be a big task to accomplish.
You can easily access the MIME contents of the message through message.MimeContent and save the message as an EML file. The latest (2013 and 2016) versions of Outlook will be able to open EML files directly.
message.Load(new PropertySet(ItemSchema.MimeContent));
MimeContent mimcon = message.MimeContent;
FileStream fStream = new FileStream("c:\test.eml", FileMode.Create);
fStream.Write(mimcon.Content, 0, mimcon.Content.Length);
fStream.Close();
If you still need to convert to the MSG format, you have a few options:
MSG file format is documented - it is an OLE store (IStorage) file. See https://msdn.microsoft.com/en-us/library/cc463912(v=exchg.80).aspx
Use a third party MSG file wrapper, such as the one from Independentsoft: http://www.independentsoft.de/msg/index.html. Setting all properties that Outlook expects can be challenging.
Convert EML file to MSG directly using Redemption (I am its author):
set Session = CreateObject("Redemption.RDOSession") set Msg = Session.CreateMessageFromMsgFile("c:\test.msg") Msg.Import("c:\test.eml", 1024) Msg.Save
Keep in mind that MIME won't preserve all MAPI specific properties. You can use the Fast Transfer Stream (FTS) format used by the ExportItems EWS operation (which, just like the MSG format, preserves most MAPI properties). The FTS data can then be converted (without any loss of fidelity) to the MSG format using Redemption (I am its author) - RDOSession.CreateMessageFromMsgFile / RDOMail.Import(..., olFTS) / RDOMail.Save
RDOSession session = new RDOSession(); RDOMail msg = session.CreateMessageFromMsgFile(#"c:\temp\test.msg"); msg.Import(#"c:\temp\test.fts", rdoSaveAsType.olFTS); msg.Save();
This suggestion was posted as a comment by #mack, but I think it deserves its own place as an answer, if for no other reason than formatting and readability of answers vs. comments.
using (FileStream fileStream =
File.Open(#"C:\message.eml", FileMode.Create, FileAccess.Write))
{
message.Load(new PropertySet(ItemSchema.MimeContent));
MimeContent mc = message.MimeContent;
fileStream.Write(mc.Content, 0, mc.Content.Length);
}
If eml format is an option and php is the language use base64_decode on the Mimencontent before save on file.
If using https://github.com/Heartspring/Exchange-Web-Services-for-PHP or https://github.com/hatsuseno/Exchange-Web-Services-for-PHP need to add
$newmessage->mc = $messageobj->MimeContent->_;
on line 245 or 247.
This is how I solved the problem to download from EWS the email message in .eml format via vbs code
' This is the function that retrieves the message:
function CreaMailMsg(ItemId,ChangeKey)
Dim MailMsg
Dim GetItemSOAP,GetItemResponse,Content
LogFile.WriteLine (Now() & "-" & ":CreaMailMsg:ID:" & ItemId)
GetItemSOAP=ReadTemplate("GetItemMsg.xml")
GetItemSOAP=Replace(GetItemSOAP, "<!--ITEMID-->", ItemId)
GetItemSOAP=Replace(GetItemSOAP, "<!--ITEMCHANGEKEY-->", ChangeKey)
LogFile.WriteLine (Now() & ":GetItemSOAP:" & GetItemSOAP)
set GetItemResponse=SendSOAP(GetItemSOAP,TARGETURL,"",USERNAME,PASSWORD)
' Check we got a Success response
if not IsResponseSuccess(GetItemResponse, "m:GetItemResponseMessage","ResponseClass") then
LogFile.WriteLine (Now() & "-" & ":ERRORE:Fallita GetItemMsg:" & GetItemResponse.xml)
Chiusura 1
end if
' LogFile.WriteLine (Now() & "-" & ":DEBUG:riuscita GetItemMsg:" & GetItemResponse.xml)
Content = GetItemResponse.documentElement.getElementsByTagName("t:MimeContent").Item(0).Text
' LogFile.WriteLine (Now() & ":Contenuto MIME" & Content)
CreaMailMsg = WriteAttach2File(Content,"OriginaryMsg.eml")
' MailMsg.close
CreaMailMsg = true
end function
'###########################################################################
' These are the functions the save the message in .eml format
'###########################################################################
function WriteAttach2File(Content,nomeAttach)
Dim oNode,oXML,Base64Decode
' Read the contents Base64 encoded and Write a file
set oXML=CreateObject("MSXML2.DOMDocument")
set oNode=oXML.CreateElement("base64")
oNode.DataType="bin.base64"
oNode.Text = Content
Base64Decode = Stream_Binary2String(oNode.nodeTypedValue,nomeAttach)
Set oNode = Nothing
Set oXML = Nothing
end function
'###########################################################################
function Stream_Binary2String(binary,nomeAttach)
Const adTypeText = 2
Const adTypeBinary = 1
Dim BinaryStream
Set BinaryStream=CreateObject("ADODB.Stream")
BinaryStream.Type=adTypeBinary' Binary
BinaryStream.Open
BinaryStream.Write binary
BinaryStream.Position=0
BinaryStream.Type=adTypeText
BinaryStream.CharSet = "us-ascii"
Stream_Binary2String=BinaryStream.ReadText
'msgbox Stream_Binary2String
BinaryStream.SaveToFile ShareName & "\" & nomeAttach,2
Set BinaryStream=Nothing
end function
If you are going from Outlook's EntryID via VSTO (Hex) to EwsID, you need to look here: http://bernhardelbl.wordpress.com/2013/04/15/converting-entryid-to-ewsid-using-exchange-web-services-ews/
Saved me. I kept getting a "Data is corrupt." message.
You can download all the attachments using EWS API and C# . Below is the example given:
byte[][] btAttachments = new byte[3][]; //To store 3 attachment
if (item.HasAttachments) {
EmailMessage message = EmailMessage.Bind(objService, new ItemId(item.Id.UniqueId.ToString()), new PropertySet(BasePropertySet.IdOnly, ItemSchema.Attachments));
noOfAttachment = message.Attachments.Count;
// Iterate through the attachments collection and load each attachment.
foreach(Attachment attachment in message.Attachments)
{
if (attachment is FileAttachment)
{
FileAttachment fileAttachment = attachment as FileAttachment;
// Load the file attachment into memory and print out its file name.
fileAttachment.Load();
//Get the Attachment as bytes
if (i < 3) {
btAttachments[i] = fileAttachment.Content;
i++;
}
}
// Attachment is an item attachment.
else
{
// Load attachment into memory and write out the subject.
ItemAttachment itemAttachment = attachment as ItemAttachment;
itemAttachment.Load(new PropertySet(EmailMessageSchema.MimeContent));
MimeContent mc = itemAttachment.Item.MimeContent;
if (i < 3) {
btAttachments[i] = mc.Content;
i++;
}
}
}
}
Above code converts all the attachment into bytes. Once you have bytes, you can convert bytes into your required format.
To Convert bytes into files and save in the disk follow the below links:
Write bytes to file
http://www.digitalcoding.com/Code-Snippets/C-Sharp/C-Code-Snippet-Save-byte-array-to-file.html