Function GetIPAddress() As String
Dim nicSet As Variant
Dim strIPAddress As String
'must have error handler enabled, as all
'adapters do not return all information
On Error Resume Next
Set nicSet = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
InstancesOf("Win32_NetworkAdapterConfiguration")
Forall nic In nicSet
If nic.IPEnabled Then
strIPAddress = nic.IPAddress(0)
If Left$(strIPAddress, 3) = "10." Or Left$(strIPAddress, 3) = "192" Then
GetIPAddress = strIPAddress
Exit Forall
End If
End If
End Forall
Set nicSet = Nothing
End Function
September 17, 2007 (IDG News Service) -- Yahoo Inc. has agreed to buy Zimbra Inc., a privately held company whose Web-hosted collaboration and messaging suite is considered a successful example of the software-as-a-service model.Yahoo will acquire Zimbra for $350 million in a transaction expected to close in this year's fourth quarter, the companies said today.
With Zimbra, Yahoo becomes a competitor to Google Inc., Zoho, Cisco Systems Inc.'s WebEx and others that provide Web-hosted collaboration and communication suites.
Zimbra, like other Web-hosted suite providers, is also considered a rival to Microsoft Corp. and its Office suite and Exchange messaging platform.
Yahoo is buying Zimbra in part to boost the Yahoo Mail Web mail service and leverage Zimbra's client base in universities, small and medium-size businesses, and Internet service providers, Yahoo said.
In addition to e-mail, Zimbra's suite also includes calendar and contact management components, as well as an open platform that allows third-party developers to create mini-applications, called Zimlets, for the suite.
After the deal closes, Zimbra will become a Yahoo subsidiary.
Option Public
Option Declare
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Adapted from sample code by Randy Birch, http://vbnet.mvps.org
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const ERROR_SUCCESS = 0
Const MAX_PATH = 260
Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" _
(Byval lpszLocalName As String, Byval lpszRemoteName As String, cbRemoteName As Long) As Long
Declare Function PathIsNetworkPath Lib "shlwapi.dll" Alias "PathIsNetworkPathA"_
(Byval pszPath As String) As Long
Declare Function PathIsUNC Lib "shlwapi.dll" Alias "PathIsUNCA" _
(Byval pszPath As String) As Long
Declare Function PathStripToRoot Lib "shlwapi.dll" Alias "PathStripToRootA" _
(Byval pPath As String) As Long
Declare Function PathSkipRoot Lib "shlwapi.dll" Alias "PathSkipRootA" _
(Byval pPath As String) As Long
Declare Function lstrcpyA Lib "kernel32" (Byval RetVal As String, Byval Ptr As Long) As Long
Declare Function lstrlenA Lib "kernel32" (Byval Ptr As Any) As Long
Sub Initialize
Msgbox GetUncFullPathFromMappedDrive("Z:")
End Sub
Function GetUncFullPathFromMappedDrive(sLocalName As String) As String
Dim sLocalRoot As String
Dim sRemoteName As String
Dim sRemotePath As String
Dim cbRemoteName As Long
sRemoteName = Space$(MAX_PATH)
cbRemoteName = Len(sRemoteName)
sLocalRoot = StripPathToRoot(sLocalName)
'modification to the GetUncFromMappedDrive()
'routine. Save the path info to a variable for
're-adding below.
sRemotePath = StripRootFromPath(sLocalName)
If PathIsNetworkPath(sLocalRoot) = 1 Then
If WNetGetConnection(sLocalRoot, _
sRemoteName, _
cbRemoteName) = ERROR_SUCCESS Then
sRemoteName = QualifyPath(TrimNull(sRemoteName)) & sRemotePath
If IsUNCPathValid(sRemoteName) Then
GetUncFullPathFromMappedDrive = sRemoteName
End If
End If
End If
End Function
Private Function StripPathToRoot(Byval spath As String) As String
'Removes all of the path except for
'the root information (ie drive. Also
'removes any trailing slash.
Dim pos As Integer
Call PathStripToRoot(spath)
pos = Instr(spath, Chr$(0))
If pos Then
StripPathToRoot = Left$(spath, pos - 2)
Else
StripPathToRoot = spath
End If
End Function
Private Function StripRootFromPath(Byval spath As String) As String
'Parses a path, ignoring the drive
'letter or UNC server/share path parts
'You need to use a separate function
'because the API call modifies the value
'you pass to it.
StripRootFromPath = TrimNull(GetStrFromPtrA(PathSkipRoot(spath)))
End Function
Private Function QualifyPath(spath As String) As String
'add trailing slash if required
If Right$(spath, 1) <> "\" Then
QualifyPath = spath & "\"
Else
QualifyPath = spath
End If
End Function
Private Function IsUNCPathValid(Byval spath As String) As Boolean
'Determines if string is a valid UNC
IsUNCPathValid = PathIsUNC(spath) = 1
End Function
Private Function GetStrFromPtrA(Byval lpszA As Long) As String
'Given a pointer to a string, return the string
GetStrFromPtrA = String$(lstrlenA(Byval lpszA), 0)
Call lstrcpyA(Byval GetStrFromPtrA, Byval lpszA)
End Function
Private Function TrimNull(startstr As String) As String
Dim lFound As Long
lFound = Instr(1, startstr, Chr$(0))
If lFound > 0 Then
TrimNull = Left$(startstr, lFound - 1)
Else
TrimNull = startstr
End If
End Function
Sub GenerateMDEFile(SourcePath As String, DestPath)
'SourcePath is the ADP file. DestPath is the ADE file.
On Error Resume Next
'I don't normally do this, but with automation you sometimes get weird errors
' that will cause the calling app to crash, but they can be safely ignored.
' Also, since we're using SendKeys you don't want an error dialog to pop up
' and start getting your keystrokes. That would be bad.
Dim objAccess As Variant
Set objAccess = CreateObject("Access.Application")
'Delete the destination (ADE) file if it exists
If Dir$(DestPath) <> "" Then
Kill DestPath
End If
'Make sure the Access window is active
objAccess.Visible = True
DoEvents
'This pastes in the source path, then hits Enter twice.
' The first Enter accepts the source path
' The second accepts the default name for the compiled version
SendKeys SourcePath & "{Enter}{Enter}"
objAccess.DoCmd.RunCommand acCmdMakeMDEFile 'Constant with a value of 7
objAccess.Quit
Set objAccess = Nothing
End Sub
In June, IBM shipped its first System p 570 servers with the POWER6 processor -- the world's fastest chip -- containing a unique design that creates dozens to hundreds of "virtual" servers on a single box. Live Partition Mobility, currently in beta testing with general availability planned later this year, is a continuous availability feature that will enable POWER6-based servers, such as the System p 570, to move live logical partitions -- including the entire operating system and all its running applications -- from one server to another while the systems are running.Update 8/22/2007:
The chair-person of the sub-committee deciding on the Swiss vote ruled that objections raised by participants were not enough to justify a Disapprove with comments option, presenting the body with only Approve with Comments or Abstain with Comments choices. The Swiss Internet User Group has outlined its objections to OOXML as an ISO standard, added that the majority wanted to vote Disapprove with Comments and alleges conflict of interest in the choice of chair-person (nominated by the committee chairman who is the Secretary General of ECMA).Overall an extremely disheartening read. I'm beginning to think OOXML will actually get approved, but it's only through shady deals and underhanded practices. I'm both surprised and not surprised.
I click OK, the dialog reappears, I click OK again, and then I get to this:
To use this, call API_GetHandleFromPartialCaption and you'll get back the hWnd of that application, or 0 if it's not found. What can you do with that? Well, you could close the application:(Declarations)
Declare Function GetForegroundWindow Lib "user32" () As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (Byval hwnd As Long, Byval lpString As String, Byval cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (Byval hwnd As Long) As Long
Declare Function GetWindow Lib "user32" (Byval hwnd As Long, Byval wCmd As Long) As Long
Const GW_HWNDNEXT = 2
Function API_GetHandleFromPartialCaption(sCaption As String) As Long
Dim lhWnd As Long
Dim sStr As String
API_GetHandleFromPartialCaption = False
'start with the current application
lhWnd = GetForegroundWindow
Do While lhWnd <> 0
sStr = String$(GetWindowTextLength(lhWnd) + 1, Chr$(0)) 'set the buffer to the length of the and fill it with null characters
GetWindowText lhWnd, sStr, Len(sStr) 'get the window title
sStr = Left$(sStr, Len(sStr) - 1) 'strip off the null chars
If Instr(1, sStr, sCaption) > 0 Then 'found it!
API_GetHandleFromPartialCaption = lhWnd
Exit Do
End If
'try again
lhWnd = GetWindow(lhWnd, GW_HWNDNEXT)
Loop
End Function
Or bring it to the foreground...(Declarations)
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (Byval hwnd As Long, Byval wMsg As Long, Byval wParam As Long, lParam As Long) As Long
Const WM_CLOSE = &H10
Function CloseDesigner
Dim hWnd As Long
hWnd = API_GetHandleFromPartialCaption("IBM Lotus Domino Designer")
If hWnd > 0 Then
Call SendMessage(hWnd, WM_CLOSE, 0, 0)
End If
End Function
(Note: this particular example could also be achieved with @LaunchApp("Designer").(Declarations)
Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Function SwitchToDesigner
Dim hWnd As Long
hWnd = API_GetHandleFromPartialCaption("IBM Lotus Domino Designer")
If hWnd > 0 Then
Call SetForegroundWindow(hWnd)
End If
End Function
