useoffice2000.bas

Off2000 dll介绍

Attribute VB_Name = "UsefulOfficeExports"
'-----------------------------------------
'   UsefulOfficeExports
'
'   WARNING: All of these calls were figured out through
'   trial and error and lots of crashing. NONE of them
'   are officially supported and they may all disappear in
'   future versions. But most of them exist not only in
'   MSO9.DLL but also in MSO97.dll and MSO97rt.dll
'   too (the former is for Office 97 apps, the latter is
'   for Access runtime apps and VB5/VB6 IDE).
'
'   (c) 1999 Trigeminal Software, Inc.  All Rights Reserved
'------------------------------------------
Option Compare Text
Option Explicit

' The OFFICE declares that this module has code for
Private Declare Function FIsHttpUrl Lib "mso9.dll" Alias "#1355" (ByVal stUrlCand As Long) As Long
Private Declare Function MsoCchLoadWz Lib "mso9.dll" Alias "#292" (ByVal hInstance As Long, ByVal wID As Long, ByVal lpBuffer As Long, ByVal nBufferMax As Long) As Long
Private Declare Function MsoCchDecodeURL Lib "mso9.dll" Alias "#814" (ByVal stUrl As Long) As Long
Private Declare Function MsoCchWzFromColor Lib "mso9.dll" Alias "#849" (ByVal color As Long, ByVal stBuff As Long, ByVal cch As Long) As Long
Private Declare Function MsoFGetColorString Lib "mso9.dll" Alias "#466" (ByVal color As Long, ByVal stColor As Long, ByVal cch As Long, ByRef cchActual As Long) As Long
Private Declare Function MsoChsFromCpg Lib "mso9.dll" Alias "#359" (ByVal cpg As Long) As Long
Private Declare Function MsoChsFromLid Lib "mso9.dll" Alias "#296" (ByVal lid As Long) As Long
Private Declare Function MsoCopyFileW Lib "mso9.dll" Alias "#882" (ByVal stOld As Long, ByVal stNew As Long, ByVal fFailIfItsThere As Long) As Long
Private Declare Function MsoCpgBestForWzUrl Lib "mso9.dll" Alias "#2000" (ByVal stUrl As Long) As Long
Private Declare Function MsoCpgFromChs Lib "mso9.dll" Alias "#296" (ByVal Chs As Long) As Long
Private Declare Function MsoCpgFromLid Lib "mso9.dll" Alias "#296" (ByVal lid As Long) As Long
Private Declare Function MsoCreateShortcut Lib "mso9.dll" Alias "#315" (ByVal stShortcut As Long, ByVal stShortcutTo As Long) As Long
Private Declare Function MsoDialogFontNameLid Lib "mso9.dll" Alias "#1442" (ByVal stFont As Long, ByVal lid As Long) As Long
Private Declare Function MsoDwUrlAttributes Lib "mso9.dll" Alias "#1305" (ByVal stUrl As Long, ByVal unk As Long) As Long
Private Declare Function MsoEnsureMinUIFontSize Lib "mso9.dll" Alias "#1457" (lf As LOGFONT) As Long
Private Declare Function MsoFAdminPrivileges Lib "mso9.dll" Alias "#648" () As Long
Private Declare Function MsoFAnsiCodePageSupportsLCID Lib "mso9.dll" Alias "#1474" (ByVal cpg As Long, ByVal lcid As Long) As Long
Private Declare Function MsoFCheckIEVersion Lib "mso9.dll" Alias "#2034" (ByVal major As Long, ByVal minor As Long) As Long
Private Declare Function MsoFCreateFullDirectory Lib "mso9.dll" Alias "#704" (ByVal stDir As Long) As Boolean
Private Declare Function MsoFDirExist Lib "mso9.dll" Alias "#1074" (ByVal stDir As Long) As Long
Private Declare Function MsoFFileExist Lib "mso9.dll" Alias "#1284" (ByVal stFile As Long) As Long
Private Declare Function MsoFGetButtonSize Lib "mso9.dll" Alias "#465" () As Long
Private Declare Function MsoFGetExtension Lib "mso9.dll" Alias "#1527" (ByVal stFile As Long, ByVal stExt As Long) As Long
Private Declare Function MsoFGetTbShowKbdShortcuts Lib "mso9.dll" Alias "#482" () As Long
Private Declare Function MsoFGetTooltips Lib "mso9.dll" Alias "#485" () As Long
Private Declare Function MsoFIEPolicyAndVersion Lib "mso9.dll" Alias "#1562" (ByRef major As Long, ByRef minor As Long) As Long
Private Declare Function MsoFIsAppSharing Lib "mso9.dll" Alias "#1303" () As Long
Private Declare Function MsoFIsConferencing Lib "mso9.dll" Alias "#1571" () As Long
Private Declare Function MsoFIsMyDocumentsFolder Lib "mso9.dll" Alias "#670" (ByVal stDir As Long) As Long
Private Declare Function MsoFIsNotUrl Lib "mso9.dll" Alias "#1574" (ByVal stUrl As Long) As Long
Private Declare Function MsoFIsShortcutName Lib "mso9.dll" Alias "#517" (ByVal stFile As Long) As Long
Private Declare Function MsoFIsTerminalServer Lib "mso9.dll" Alias "#1576" () As Long
Private Declare Function MsoFLaunchMsInfo Lib "mso9.dll" Alias "#1188" (ByVal stApp As Long) As Long
Private Declare Function MsoFLogfontFromFaceName Lib "mso9.dll" Alias "#2033" (ByVal stName As Long, lf As LOGFONT) As Long
Private Declare Function MsoCreateFontFromResource Lib "mso9.dll" Alias "#2036" (ByVal ids As Long, ByVal hInstance As Long) As Long
Private Declare Function MsoFMyPictures Lib "mso9.dll" Alias "#241" (ByVal stBuff As Long) As Long
Private Declare Function MsoFNetModules Lib "mso9.dll" Alias "#2024" (ByVal param1 As Long, ByVal param2 As Long) As Long
Private Declare Function MsoFOverrideOfficeUIFont Lib "mso9.dll" Alias "#1593" (lf As Any) As Long
Private Declare Function MsoFPlaySoundFile Lib "mso9.dll" Alias "#964" (ByVal stSoung As Long, ByVal param1 As Long) As Long
Private Declare Function MsoFSetTooltips Lib "mso9.dll" Alias "#592" (ByVal fToolTips As Long) As Long
Private Declare Function MsoFSetButtonSize Lib "mso9.dll" Alias "#587" (ByVal fButtonSize As Long) As Long
Private Declare Function MsoFSubstituteTahomaLogfont Lib "mso9.dll" Alias "#600" (lf As LOGFONT) As Long
Private Declare Function MsoFSupportFEEditLID Lib "mso9.dll" Alias "#1646" () As Long
Private Declare Function MsoFSupportThisEditLID Lib "mso9.dll" Alias "#1647" (ByVal lid As Long) As Long
Private Declare Function MsoFUnicodeCommCtrl Lib "mso9.dll" Alias "#1650" () As Long
Private Declare Function MsoFValidLocale Lib "mso9.dll" Alias "#248" (ByVal lid As Long) As Long
Private Declare Function MsoFSzEqual Lib "mso9.dll" Alias "#610" (ByVal st1 As Long, ByVal st2 As Long, ByVal fCaseSensitive As Long) As Long
Private Declare Function MsoFWzEqual Lib "mso9.dll" Alias "#636" (ByVal st1 As Long, ByVal st2 As Long, ByVal fCaseSensitive As Long) As Long
Private Declare Function MsoGetHelpLcid Lib "mso9.dll" Alias "#1376" () As Long
Private Declare Function MsoGetInstallFlavor Lib "mso9.dll" Alias "#1709" () As Long
Private Declare Function MsoGetInstallLcid Lib "mso9.dll" Alias "#1377" () As Long
Private Declare Function MsoGetPreviousInstallFlavor Lib "mso9.dll" Alias "#1714" () As Long
Private Declare Function MsoGetTwoDigitYearMax Lib "mso9.dll" Alias "#1729" () As Long
Private Declare Function MsoGetUILcid Lib "mso9.dll" Alias "#1378" () As Long
Private Declare Function MsoMakeShortName Lib "mso9.dll" Alias "#1838" (ByVal stName As Long) As Long
Private Declare Function MsoSetTbShowKbdShortcuts Lib "mso9.dll" Alias "#853" (ByVal fShow As Long) As Long

' Non-Office support APIs, types, and constants
Private Const LF_FACESIZE = 32

Public Type LOGFONT
        lfHeight As Long
        lfWidth As Long
        lfEscapement As Long
        lfOrientation As Long
        lfWeight As Long
        lfItalic As Byte
        lfUnderline As Byte
        lfStrikeOut As Byte
        lfCharSet As Byte
        lfOutPrecision As Byte
        lfClipPrecision As Byte
        lfQuality As Byte
        lfPitchAndFamily As Byte
        lfFaceName(1 To LF_FACESIZE) As Byte
End Type

Private Const LOAD_LIBRARY_AS_DATAFILE As Long = &H2
Private Declare Function LoadLibraryEx Lib "kernel32" Alias "LoadLibraryExA" (ByVal lpLibFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long

'--------------------------
'   StFromOfficeDllAndIds
'
'   Given an Office dll and a string id,
'   return that string. Important since
'   ths strings cannot be read from
'   a LoadString call.
'--------------------------
Function StFromOfficeDllAndIds(stLibrary As String, ids As Long) As String
    Dim hInst As Long
    Dim cch As Long
    Dim stBuff As String
    
    hInst = LoadLibraryEx(stLibrary, 0&, LOAD_LIBRARY_AS_DATAFILE)
    If hInst > 0 Then
        stBuff = String$(256, vbNullChar)
        cch = MsoCchLoadWz(hInst, ids, StrPtr(stBuff), Len(stBuff))
        If cch > 0 Then
            StFromOfficeDllAndIds = Left$(stBuff, cch)
        End If
        Call FreeLibrary(hInst)
    End If
End Function

'--------------------------
'   FIsHttpUrlC
'
'   Is the string a URL?
'--------------------------
Function FIsHttpUrlC(stUrlCand As String) As Boolean
    FIsHttpUrlC = (FIsHttpUrl(StrPtr(stUrlCand)) <> 0)
End Function

'--------------------------
'   MsoCchDecodeURLC
'
'   Not sure what this function ACTUALLY does
'--------------------------
Function MsoCchDecodeURLC(stUrl As String) As Boolean
    MsoCchDecodeURLC = (MsoCchDecodeURL(StrPtr(stUrl)) <> 0)
End Function

'--------------------------
'   StColorFromColorNum
'
'   Could also use MsoFGetColorString, I think
'--------------------------
Function StColorFromColorNum(lColor As Long) As String
    Dim stBuff As String
    Dim cch As Long
    
    stBuff = String$(256, vbNullChar)
    cch = MsoCchWzFromColor(lColor, StrPtr(stBuff), Len(stBuff))
    If cch > 0 Then
        StColorFromColorNum = Left$(stBuff, cch)
    End If
End Function

'--------------------------
'   FCopyFile
'--------------------------
Function FCopyFile(stOld As String, stNew As String, Optional fFailIfItsThere As Boolean = True)
    FCopyFile = (MsoCopyFileW(StrPtr(stOld), StrPtr(stNew), Abs(fFailIfItsThere)) <> 0)
End Function

'--------------------------
'   FCreateShortcut
'
'   Creates a shortcut!
'--------------------------
Function FCreateShortcut(stFile As String, stShortcut As String) As Boolean
    FCreateShortcut = (MsoCreateShortcut(StrPtr(stShortcut), StrPtr(stFile)) = 0)
End Function

'--------------------------
'   StDlgFontFromLid
'
'   Give the dlg font, given a language ID
'--------------------------
Function StDlgFontFromLid(lid As Long) As String
    Dim stBuff As String
    Dim cch As Long
    Dim lBuff As Long
    
    stBuff = String$(256, vbNullChar)
    cch = MsoDialogFontNameLid(StrPtr(stBuff), lid)
    If cch > 0 Then
        StDlgFontFromLid = Left$(stBuff, cch)
    End If
End Function

'--------------------------
'   LAttribsOfStUrl
'
'   Not sure what the attribs are, but this function
'   returns them
'--------------------------
Function LAttribsOfStUrl(stUrl As String) As Long
    LAttribsOfStUrl = MsoDwUrlAttributes(StrPtr(stUrl), 0&)
End Function

'--------------------------
'   FixUpFont
'
'   I think this fixes up the size depending on locale
'   (such as 9 pt on FE systems?)
'--------------------------
Sub FixUpFont(ByRef lf As LOGFONT)
    Call MsoEnsureMinUIFontSize(lf)
End Sub

'--------------------------
'   FIsAdmin
'
'   Does the user have Admin privs on the machine?
'--------------------------
Function FIsAdmin() As Boolean
    FIsAdmin = (MsoFAdminPrivileges() <> 0)
End Function

'--------------------------
'   FCpgHandlesLcid
'
'   Does the given cpg handle the given language?
'--------------------------
Function FCpgHandlesLcid(cpg As Long, lcid As Long) As Boolean
    FCpgHandlesLcid = (MsoFAnsiCodePageSupportsLCID(cpg, lcid) <> 0)
End Function

'--------------------------
'   FCreateDir
'--------------------------
Function FCreateDir(stDir As String) As Boolean
    FCreateDir = (MsoFCreateFullDirectory(StrPtr(stDir)) <> 0)
End Function

'--------------------------
'   FDirExists
'--------------------------
Function FDirExists(stDir As String) As Boolean
    FDirExists = (MsoFDirExist(StrPtr(stDir)) <> 0)
End Function

'--------------------------
'   FFileExists
'--------------------------
Function FFileExists(stFile As String) As Boolean
    FFileExists = (MsoFFileExist(StrPtr(stFile)) <> 0)
End Function

'--------------------------
'   LargeButtons
'--------------------------
Property Get LargeButtons() As Boolean
    LargeButtons = (MsoFGetButtonSize() <> 0)
End Property
Property Let LargeButtons(fLarge As Boolean)
    Call MsoFSetButtonSize(Abs(fLarge))
End Property

'--------------------------
'   StExtOfStFile
'--------------------------
Function StExtOfStFile(stFile As String) As String
    Dim stBuff As String
    Dim ich As Integer
    
    stBuff = String$(5, vbNullChar)
    If MsoFGetExtension(StrPtr(stFile), StrPtr(stBuff)) = 1 Then
        stBuff = stBuff & vbNullChar
        ich = InStr(1, stBuff, vbNullChar, vbBinaryCompare)
        StExtOfStFile = Left$(stBuff, ich - 1)
    End If
End Function

'--------------------------
'   KeyboardShortcuts
'--------------------------
Property Get KeyboardShortcuts() As Boolean
    KeyboardShortcuts = (MsoFGetTbShowKbdShortcuts() <> 0)
End Property
Property Let KeyboardShortcuts(fShow As Boolean)
    Call MsoSetTbShowKbdShortcuts(Abs(fShow))
End Property

'--------------------------
'   AppSharing
'
'   Returns true if the app currently
'   has application sharing on?
'--------------------------
Property Get AppSharing() As Boolean
    AppSharing = (MsoFIsAppSharing() <> 0)
End Property

'--------------------------
'   Conferencing
'
'   Returns true if the app currently
'   has conferencing on?
'--------------------------
Property Get Conferencing() As Boolean
    Conferencing = (MsoFIsConferencing() <> 0)
End Property

'--------------------------
'   FIsMyDocsDir
'
'   Returns True if the passed in folder
'   is the "My documents" dir. On NT4,
'   for example, this is usually
'   <windir>\profiles\<user>\personal
'--------------------------
Function FIsMyDocsDir(stDir As String) As Boolean
    FIsMyDocsDir = (MsoFIsMyDocumentsFolder(StrPtr(stDir)) <> 0)
End Function

'--------------------------
'   FIsShortcut
'
'   Is the passed in file a shortcut (.LNK)?
'--------------------------
Function FIsShortcut(stFile As String) As Boolean
    FIsShortcut = (MsoFIsShortcutName(StrPtr(stFile)) <> 0)
End Function

'--------------------------
'   TerminalServer
'
'   Are we on Terminal Server
'--------------------------
Property Get TerminalServer() As Boolean
    TerminalServer = (MsoFIsTerminalServer() <> 0)
End Property

'--------------------------