1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
|
<!--
UnDBX - Tool to extract e-mail messages from Outlook Express DBX files.
Copyright (C) 2008-2013 Avi Rozen <avi.rozen@gmail.com>
DBX file format parsing code is based on DbxConv - a DBX to MBOX
Converter. Copyright (C) 2008, 2009 Ulrich Krebs
<ukrebs@freenet.de>
RFC-2822 and RFC-2047 parsing code is adapted from GNU Mailutils -
a suite of utilities for electronic mail, Copyright (C) 2002,
2003, 2004, 2005, 2006, 2009, 2010 Free Software Foundation, Inc.
This file is part of UnDBX.
UnDBX is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
-->
<HTML>
<HEAD>
<TITLE>UnDBX</TITLE>
<HTA:APPLICATION ID="appUnDBX"
APPLICATIONNAME="UnDBX"
BORDER="dialog"
BORDERSTYLE="normal"
CAPTION="yes"
ICON=""
MAXIMIZEBUTTON="no"
MINIMIZEBUTTON="yes"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="no"
CONTEXTMENU="no"
SYSMENU="yes"
VERSION="1.0"
WINDOWSTATE="normal"/>
<SCRIPT LANGUAGE="VBScript">
Option Explicit
Dim WshShell
Dim objFSO
Dim strUndbxExe, strUndbxVersion
Dim strStoreFolder, strDesktopFolder, strAppPath
Set WshShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
' This script is meant to be installed in the same folder as undbx.exe
strAppPath = Trim(appUnDBX.commandLine)
If Left(strAppPath,1) = """" And Right(strAppPath,1) = """" Then
strAppPath = Mid(strAppPath, 2, Len(strAppPath) - 2)
End If
strUndbxExe = objFSO.GetAbsolutePathName(objFSO.BuildPath(strAppPath, ".."))&"\undbx.exe"
If Not objFSO.FileExists(strUndbxExe) Then
MsgBox "UnDBX executable not found - " & strUndbxExe, vbCritical, "UnDBX"
Self.close
Else
Dim objScriptExec, strStdOut
Set objScriptExec = WshShell.Exec(strUndbxExe&" --version")
strStdOut = objScriptExec.StdOut.ReadAll
Set objScriptExec = Nothing
strUndbxVersion = Mid(Trim(strStdOut), 7, 5)
If Len(strUndbxVersion) <> 5 Then
MsgBox "Cannot determine version of UnDBX", vbCritical, "UnDBX"
Self.close
End If
End If
' Find Outlook Express storage folder
On Error Resume Next
strStoreFolder = WshShell.ExpandEnvironmentStrings(WshShell.RegRead("HKEY_CURRENT_USER\Identities\" & WshShell.RegRead("HKEY_CURRENT_USER\Identities\Last User ID") & "\Software\Microsoft\Outlook Express\5.0\Store Root"))
On Error GoTo 0
Dim objSFolders
Set objSFolders = WshShell.SpecialFolders
strDesktopFolder = objSFolders("Desktop")
Set objFSO = Nothing
Set WshShell = Nothing
Sub Window_onLoad
txtFileDbx.value = strStoreFolder
txtFileEml.value = strDesktopFolder
version.innerHTML = strUndbxVersion
disablePage False
window.resizeTo blurb.offsetWidth * 1.1, blurb.offsetHeight * 20
End Sub
Sub updateExtractButton
btnExtract.disabled = (Len(txtFileDbx.value) = 0) Or (Len(txtFileEml.value) = 0)
If chkRecover.checked Then
btnExtract.value = "Recover!"
Else
btnExtract.value = "Extract!"
End If
End Sub
Sub txtFileDbx_onKeyUp
updateExtractButton
End Sub
Sub txtFileDbx_onChange
updateExtractButton
End Sub
Sub txtFileEml_onKeyUp
updateExtractButton
End Sub
Sub txtFileEml_onChange
updateExtractButton
End Sub
Sub disablePage(state)
txtFileDbx.disabled = state
btnFileDbx.disabled = state
chkRecover.disabled = state
txtFileEml.disabled = state
btnFileEml.disabled = state
updateExtractButton
If state Then
btnExtract.disabled = True
End If
End Sub
Sub btnFileDbx_onClick
Dim strInFolder
disablePage True
strInFolder = GetFolder("Please select .dbx INPUT folder:")
If strInFolder <> "" Then
txtFileDbx.value = strInFolder
End If
disablePage False
End Sub
Sub btnFileEml_onClick
Dim strOutFolder
disablePage True
strOutFolder = GetFolder("Please select .eml OUTPUT folder:")
If strOutFolder <> "" Then
txtFileEml.value = strOutFolder
End If
disablePage False
End Sub
Sub chkRecover_onClick
updateExtractButton
End Sub
Sub btnExtract_onClick
disablePage True
document.body.style.cursor = "wait"
If isProcessRunning("msimn.exe") Then
MsgBox "Please exit Outlook Express first!", vbCritical, "UnDBX"
document.body.style.cursor = "default"
disablePage False
Exit Sub
End If
Dim objApp
Dim strInFolder, strOutFolder, strRecover
strInFolder = Trim(txtFileDbx.value)
If Right(strInFolder,1) = "\" Then
strInFolder = Left(strInFolder, Len(strInFolder)-1)
End If
strOutFolder = Trim(txtFileEml.value)
If Right(strOutFolder,1) = "\" Then
strOutFolder = Left(strOutFolder, Len(strOutFolder)-1)
End If
strRecover = ""
If chkRecover.checked Then
strRecover = "--recover"
End If
Set objApp = CreateObject("WScript.Shell")
' quoting is a bitch: the following should work even when all file paths contain spaces
objApp.Run "cmd /c """"" & strUndbxExe & """ " & strRecover & " """ & strInFolder & """ """ & strOutFolder & """ & pause""", 1, True
Set objApp = Nothing
document.body.style.cursor = "default"
disablePage False
End Sub
Function isProcessRunning(strExe)
'
' Check if the specified executable is running
'
Dim strComputer
Dim objWMIService
Dim colProcesses
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcesses = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = '"&strExe&"'")
isProcessRunning = colProcesses.Count > 0
Set colProcesses = Nothing
Set objWMIService = Nothing
End Function
Function GetFolder(strPrompt)
'
' Ask user to select a folder. Based on the following article:
' http://www.microsoft.com/technet/scriptcenter/resources/qanda/jun05/hey0617.mspx
'
Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0
Const OPTIONS = &H10&
Dim objShell
Dim objFolder
Dim objFolderItem
Dim strPath
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(MY_COMPUTER)
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Set objFolder = objShell.BrowseForFolder _
(WINDOW_HANDLE, strPrompt, OPTIONS, strPath)
If objFolder Is Nothing Then
GetFolder = ""
Exit Function
End If
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
GetFolder = strPath
Set objFolder = Nothing
Set objShell = Nothing
End Function
</SCRIPT>
</HEAD>
<BODY SCROLL="no" NOWRAP>
<FONT FACE="Times New Roman">
<CENTER><H2><A HREF="http://code.google.com/p/undbx">UnDBX</A> <SPAN ID="version"></SPAN></H2></CENTER>
<SPAN ID="blurb"><B>Extract and recover e-mail messages from Outlook Express <CODE>.dbx</CODE> files.</B></SPAN>
<BR/>
Copyright © 2008-2013, by <A HREF="http://machine-cycle.blogspot.com">Avi Rozen</A>.
<BR/><BR/><BR/>
Please select source <CODE>.dbx</CODE> folder:<BR/>
<INPUT TYPE="text" ID="txtFileDbx" SIZE="56" TABINDEX=1>
<INPUT TYPE="button" ID="btnFileDbx" VALUE="Browse..." TABINDEX=2>
<BR/>
<INPUT TYPE="checkbox" ID="chkRecover" TABINDEX=3>
enable <FONT COLOR="red">Recovery Mode</FONT> (use with corrupted <CODE>.dbx</CODE> files)<BR/>
<BR/>
Please select destination folder for extracted <CODE>.eml</CODE> files:<BR/>
<INPUT TYPE="text" ID="txtFileEml" SIZE="56" TABINDEX=4>
<INPUT TYPE="button" ID="btnFileEml" VALUE="Browse..." TABINDEX=5>
<BR/><BR/><BR/>
<CENTER><INPUT TYPE="submit" ID="btnExtract" VALUE="Extract!" TABINDEX=6></CENTER>
</FONT>
</BODY>
</HTML>
|
