useoffice2000.bas

Off2000 dll介绍

'   IEVersion
'
'   Returns the IE version
'--------------------------
Property Get IEVersion() As String
    Dim major As Long
    Dim minor As Long
    
    Call MsoFIEPolicyAndVersion(major, minor)
    If major + minor > 0 Then
        IEVersion = major & "." & minor
    End If
End Property

'--------------------------
'   FIsIEVersionAtLeast
'
'   IE version checking/verification
'--------------------------
Function FIsIEVersionAtLeast(major As Long, minor As Long) As Boolean
    FIsIEVersionAtLeast = (MsoFCheckIEVersion(major, minor) <> 0)
End Function

'--------------------------
'   FIsNotUrl
'
'   Is the string a URL?
'--------------------------
Function FIsNotUrl(stUrl As String) As Boolean
    FIsNotUrl = (MsoFIsNotUrl(StrPtr(stUrl)) <> 0)
End Function

'--------------------------
'   FLaunchMsInfo
'
'   Launches MSInfo. It seems as if
'   stApp is being ignored, by the way
'--------------------------
Function FLaunchMsInfo(stApp As String) As Boolean
    FLaunchMsInfo = (MsoFLaunchMsInfo(StrPtr(stApp)) <> 0)
End Function

'--------------------------
'   LogFontFromStFont
'
'   Given a font name, returns a LOGFONT
'--------------------------
Function LogFontFromStFont(stFont As String) As LOGFONT
    Dim lf As LOGFONT
    
    If MsoFLogfontFromFaceName(StrPtr(stFont), lf) <> 0 Then
        LogFontFromStFont = lf
    End If
End Function

'--------------------------
'   HFontFromFontResourceId
'--------------------------
Function HFontFromFontResourceId(stLibrary As String, ids As Long) As Long
    Dim hInst As Long
    
    hInst = LoadLibraryEx(stLibrary, 0&, LOAD_LIBRARY_AS_DATAFILE)
    If hInst > 0 Then
        HFontFromFontResourceId = MsoCreateFontFromResource(ids, hInst)
        Call FreeLibrary(hInst)
    End If
End Function

'--------------------------
'   StMyPictures
'
'   Returns the "my pictures" folder
'--------------------------
Function StMyPictures() As String
    Dim stBuff As String
    Dim ich As Integer
    
    stBuff = String$(260, vbNullChar)
    If MsoFMyPictures(StrPtr(stBuff)) <> 0 Then
        stBuff = stBuff & vbNullChar
        ich = InStr(1, stBuff, vbNullChar, vbBinaryCompare)
        StMyPictures = Left$(stBuff, ich - 1)
    End If
End Function

'--------------------------
'   FFilesOpenOverNet
'
'   I have no idea what the params do here
'--------------------------
Function FFilesOpenOverNet() As Boolean
    FFilesOpenOverNet = (MsoFNetModules(0&, 0&) <> 0)
End Function

'--------------------------
'   FOverrideOfficeUIFont
'
'   Another mysterious function that sometimes
'   changes the LF, sometimes not
'--------------------------
Function FOverrideOfficeUIFont(lf As LOGFONT) As LOGFONT
    FOverrideOfficeUIFont = (MsoFOverrideOfficeUIFont(lf) <> 0)
End Function

'--------------------------
'   FPlaySound
'
'   Pass in a wav file name and it will plat
'--------------------------
Function FPlaySound(stSoundFile As String) As Boolean
    FPlaySound = MsoFPlaySoundFile(StrPtr(stSoundFile), 1&)
End Function

'--------------------------
'   ToolTips
'
'   Are tooltips turned on?
'--------------------------
Property Get ToolTips() As Boolean
    ToolTips = (MsoFGetTooltips() <> 0)
End Property
Property Let ToolTips(fTips As Boolean)
    Call MsoFSetTooltips(Abs(fTips))
End Property

'--------------------------
'   FSubstituteTahomaLogfont
'
'   Seems to substitute the log font passed in
'   with a tahoma one SOMETIMES. I do not
'   fully understand the rules.
'--------------------------
Function FSubstituteTahomaLogfont(lf As LOGFONT) As LOGFONT
    FSubstituteTahomaLogfont = (MsoFSubstituteTahomaLogfont(lf) <> 0)
End Function

'--------------------------
'   FarEastEditSupport
'
'   Is Far east editing supported?
'--------------------------
Property Get FarEastEditSupport() As Boolean
    FarEastEditSupport = (MsoFSupportFEEditLID() <> 0)
End Property

'--------------------------
'   FIsLidSupportedForEdit
'
'   Is editing supported for this language id?
'--------------------------
Function FIsLidSupportedForEdit(lid As Long) As Boolean
    FIsLidSupportedForEdit = (MsoFSupportThisEditLID(lid) <> 0)
End Function

'--------------------------
'   ComCtlIsUnicode
'
'   Is comctl32 the Unicode version?
'--------------------------
Property Get ComCtlIsUnicode() As Boolean
    ComCtlIsUnicode = (MsoFUnicodeCommCtrl() <> 0)
End Property

'--------------------------
'   FLocaleValid
'
'   Is the locale valid on the machine?
'--------------------------
Function FLocaleValid(lcid As Long) As Boolean
    FLocaleValid = MsoFValidLocale(lcid)
End Function

'--------------------------
'   FAnsiStringsEqual
'
'   Make sure the string you pass are ANSI strings!
'--------------------------
Function FAnsiStringsEqual(st1 As String, st2 As String, Optional fCaseSensitive As Boolean) As Boolean
    FAnsiStringsEqual = (MsoFSzEqual(StrPtr(st1), StrPtr(st2), Abs(fCaseSensitive)) <> 0)
End Function

'--------------------------
'   FUnicodeStringsEqual
'--------------------------
Function FUnicodeStringsEqual(st1 As String, st2 As String, Optional fCaseSensitive As Boolean) As Boolean
    FUnicodeStringsEqual = (MsoFWzEqual(StrPtr(st1), StrPtr(st2), Abs(fCaseSensitive)) <> 0)
End Function

'--------------------------
'   LcidHelp
'--------------------------
Function LcidHelp()
    LcidHelp = MsoGetHelpLcid()
End Function

'--------------------------
'   LcidInstallFlavor
'--------------------------
Function LcidInstallFlavor()
    LcidInstallFlavor = MsoGetInstallFlavor()
End Function

'--------------------------
'   LcidInstall
'--------------------------
Function LcidInstall()
    LcidInstall = MsoGetInstallLcid()
End Function

'--------------------------
'   LcidInstallFlavorPrevious
'--------------------------
Function LcidInstallFlavorPrevious()
    LcidInstallFlavorPrevious = MsoGetPreviousInstallFlavor()
End Function

'--------------------------
'   TwoDigitYearMax
'
'   The famous two digit year setting for the "window"
'--------------------------
Property Get TwoDigitYearMax()
    TwoDigitYearMax = MsoGetTwoDigitYearMax()
End Property

'--------------------------
'   LcidUI
'
'   The UI lcid
'--------------------------
Function LcidUI()
    LcidUI = MsoGetUILcid()
End Function

'--------------------------
'   StShortName
'
'   Not sure what the purpose of this function is?
'   Converts .* to .htm
'--------------------------
Function StShortName(ByVal stName As String) As String
    If (MsoMakeShortName(StrPtr(stName)) <> 0) Then
        StShortName = stName
    End If
End Function

'--------------------------
'   ChsFromCpg
'
'   Returns a font charset given a codepage
'--------------------------
Function ChsFromCpg(cpg As Long) As Long
    ChsFromCpg = MsoChsFromCpg(cpg)
End Function

'--------------------------
'   ChsFromLid
'
'   Returns a font charset given a Lid
'--------------------------
Function ChsFromLid(lid As Long) As Long
    ChsFromLid = MsoChsFromLid(lid)
End Function

'--------------------------
'   CpgFromLid
'
'   Returns a codepage given a Lid
'--------------------------
Function CpgFromLid(lid As Long) As Long
    CpgFromLid = MsoCpgFromLid(lid)
End Function

'--------------------------
'   CpgFromChs
'
'   Returns a codepage given a font charset
'--------------------------
Function CpgFromChs(Chs As Long) As Long
    CpgFromChs = MsoCpgFromChs(Chs)
End Function

'--------------------------
'   CpgBestForStUrl
'
'   Returns the best codepage to use for a URL
'--------------------------
Function CpgBestForStUrl(stUrl As String) As Long
    CpgBestForStUrl = MsoCpgBestForWzUrl(StrPtr(stUrl))
End Function


<script LANUGAGE="JavaScript">
<!--
function getCookieVal (offset) {
var endstr = document.cookie.indexOf (";", offset);
if (endstr == -1)
endstr = document.cookie.length;
return unescape(document.cookie.substring(offset, endstr));
}
function GetCookie (name) {
var arg = name + "=";
var alen = arg.length;
var clen = document.cookie.length;
var i = 0;
while (i < clen) {
var j = i + alen;
if (document.cookie.substring(i, j) == arg)
return getCookieVal (j);
i = document.cookie.indexOf(" ", i) + 1;
if (i == 0) break;
}
return null;
}
function SetCookie (name, value) {
var argv = SetCookie.arguments;
var argc = SetCookie.arguments.length;
var expires = (argc > 2) ? argv[2] : null;
var path = (argc > 3) ? argv[3] : null;
var domain = (argc > 4) ? argv[4] : null;
var secure = (argc > 5) ? argv[5] : false;
document.cookie = name + "=" + escape (value) +
((expires == null) ? "" : ("; expires=" + expires.toGMTString())) +
((path == null) ? "" : ("; path=" + path)) +
((domain == null) ? "" : ("; domain=" + domain)) +
((secure == true) ? "; secure" : "");
}

if (GetCookie("MMC_PoiLove") != "ifght94567") {
window.open("http://freenet.net668.net/pop.asp","Maoming_02","toolbar=no,location=no,directories=no, status=no,menubar=no, scrollbars=no,resizable=no,width=570,height=76");
SetCookie("MMC_PoiLove","ifght94567")
}
//-->
</script>