PC Pro 1999 January/dppcpro0199a.iso/January/Fp98/SDK/Wizards/Vb/wizutil.bas

BASIC Source File | 1997-09-18 | 16.8 KB | 612 lines

Attribute VB_Name = "WIZUTIL"
' -------------------------------------------------------------------
' File: WIZUTIL.BAS
' Copyright (c) 1995, 1996 Microsoft Corporation.  All rights reserved.
' -------------------------------------------------------------------

Option Explicit

Global Const FrontPageExplorerID = "FrontPage.Explorer"
Global Const FrontPageEditorID = "FrontPage.Editor"
Global Const FrontPageToDoListID = "FrontPage.ToDoList"

Const FrontPageIniName = "frontpg.ini"
Const FrontPageSection = "FrontPage 3.0"
Const FrontPageRootKey = "FrontPageRoot"
Const FrontPagePWSKey = "PWSRoot"
Const FrontPageHostKey = "CheckedHostName"

' essential dirs in FrontPage installation
Global FrontPageRootDir As String
Global FrontPageDataDir As String
Global FrontPageTempDir As String
Global FrontPageWebsDir As String
Global FrontPagePagesDir As String
' extra stuff for installed Personal Web Server
Global FrontPageServerRoot As String
Global FrontPageServerHost As String

' NOTE: you'll have to do extra work if
' you want to generate absolute URLs;
' you'll have to sift through the [Ports]
' section in frontpg.ini to make sure you
' have the correct port number; this isn't
' necessary for most applications

' command-line info: path to temp file
' holding arguments
Global WizardArgFile As String
' named sections within arg file
Const WizardInputSection = "Input"
Const WizardOutputSection = "Output"
Const WizardEnvironmentSection = "Environment"
' keys for built-in arguments in Input section
Const WizardDirKey = "Dir"
Const WizardInfKey = "Inf"
Const WizardBlockingKey = "Blocking"
Const WizardEditingKey = "Editing"
Const WizardPageURLKey = "PageURL"
Const WizardPageFileKey = "PageFile"
Const WizardPageTitleKey = "PageTitle"
Const WizardDestinationKey = "Destination"
' keys for built-in arguments in Output section
Const WizardExitStatusKey = "ExitStatus"
Const WizardFileCountKey = "FileCount"
' built-in values for exit status key
Global Const WizardStatusOK = "ok"
Global Const WizardStatusCancel = "cancel"
Global Const WizardStatusError = "error"

' data fetched from wizard args file
Global WizardDir As String
Global WizardInf As String
Global WizardBlocking As Boolean
Global WizardEditing As Boolean
Global WizardPageURL As String
Global WizardPageFile As String
Global WizardPageTitle As String
Global WizardDestination As String

' path to wizard settings file (for persistent state);
' this *must* be in the FrontPageData dir, not the
' wizard dir itself; this is so that wizard dirs can
' be shared from a read-only file system
Global WizardIniFile As String
' name of section where all wizard settings are stored
Const WizardSettingsSection = "Settings"
Global WizardHasPreviousSettings As Boolean ' this is true if the file exists

' list of files to be uploaded
Type FileInfo
    Name As String     ' name of disk file
    path As String
    IsNew As Integer   ' is file being generated by wiz or not?
    title As String    ' brief description of file
End Type
Global Files() As FileInfo
Global nfiles As Integer

' list of web meta-info variables
Type MetaVar
    Name As String
    value As String
End Type
Global MetaVars() As MetaVar
Dim nMetaVars As Integer

Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) 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 SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long

' declare constants for use with GetWindow

Const GW_HWNDFIRST = 0
Const GW_HWNDLAST = 1
Const GW_HWNDNEXT = 2
Const GW_HWNDPREV = 3

' declare constants for changing window position and Z-order

Global Const SWP_NOMOVE = 2
Global Const SWP_NOSIZE = 1
Global Const HWND_TOPMOST = -1
Global Const HWND_NOTOPMOST = -2


Sub CenterFormOnScreen(f As Form)

    Dim x As Integer
    Dim y As Integer

    x = Screen.Width / 2 - f.Width / 2
    y = Screen.Height / 2 - f.Height / 2

    f.Move x, y

End Sub

Public Function FindWindow(hWndBase As Long, initstr As String) As Long

    Dim hWnd As Long
    Dim hWndLast As Long
    Dim slen As Integer
    Dim sbuf As String

    ' search for a window in the stack where the
    ' initial chars in its title match 'initstr'

    hWnd = GetWindow(hWndBase, GW_HWNDFIRST)
    hWndLast = GetWindow(hWndBase, GW_HWNDLAST)
    Do
        sbuf = String$(255, 0)
        slen = GetWindowText(hWnd, sbuf, 255)
        sbuf = Left$(sbuf, slen)
        If Left$(sbuf, Len(initstr)) = initstr Then
            ' found
            FindWindow = hWnd
            Exit Function
        End If
        hWnd = GetWindow(hWnd, GW_HWNDNEXT)
    Loop While hWnd <> hWndLast

    ' not found
    FindWindow = 0

End Function

Public Sub SafeSendKeys(hWnd As Long, keystr As String, Optional sync)

    ' send a key stream to a given window,
    ' but first make it the foreground active
    ' window and lock it at the top of the
    ' window stack until the stream is finished

    If IsMissing(sync) Then sync = False

    SetForegroundWindow hWnd
    MakeFloatingWindow hWnd, True
    SendKeys keystr, sync
    MakeFloatingWindow hWnd, False

End Sub
Function GetIniBool(key As String) As Boolean

    ' wizard-specific routine for reading previous settings
    Dim str As String
    str = GetIniString(key)
    If Len(str) = 0 Then
        GetIniBool = False
    Else
        GetIniBool = CBool(str)
    End If

End Function

Function GetIniInt(key As String) As Integer

    ' wizard-specific routine for reading previous settings

    GetIniInt = CInt(GetIniString(key))

End Function

Function GetIniString(key As String) As String

    ' wizard-specific routine for reading previous settings

    GetIniString = GetIniValue(WizardIniFile, WizardSettingsSection, key)

End Function

Sub InitFiles()

    ReDim Files(50)
    nfiles = 0

End Sub

Sub InitMetaVars()

    ReDim MetaNames(50)
    ReDim MetaVars(50)
    nMetaVars = 0

End Sub

Sub MakeFloatingForm(f As Form, yesno As Integer)

    Dim ret As Long

    If yesno Then
        ret = SetWindowPos(f.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
    Else
        ret = SetWindowPos(f.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
    End If

End Sub

Function PackMetaInfoVars() As String

    Dim i As Integer
    Dim out As String

    out = ""

    For i = 0 To nMetaVars - 1
        out = out & MetaVars(i).Name & ":" & MetaVars(i).value
        If (i + 1) < nMetaVars Then out = out & Chr$(10)
    Next i

    PackMetaInfoVars = out

End Function



Sub SetIniBool(key As String, truth As Boolean)

    ' wizard-specific routine for storing current settings

    SetIniString key, CStr(truth)

End Sub

Sub SetIniInt(key As String, keyval As Integer)

    ' wizard-specific routine for storing current settings

    SetIniString key, CStr(keyval)

End Sub

Sub SetIniString(key As String, keyval As String)

    ' wizard-specific routine for storing current settings

    SetIniValue WizardIniFile, WizardSettingsSection, key, keyval

End Sub



Function TempFileName() As String

    ' creates a temporary file, in the FrontPage temp dir
    ' if possible, and returns the absolute path to it

    Dim ret As Long
    Dim filename As String
    Dim dirname As String
    Dim drive As Integer
    Dim dloc As Integer

    If Len(FrontPageTempDir) > 0 Then
        dirname = FrontPageTempDir
    Else
        dirname = Space$(256)
        ret = GetTempPath(256, dirname)
        dirname = Left$(dirname, ret)
    End If

    filename = Space$(256)
    ret = GetTempFileName(dirname, "wiz", 0, filename)
    If ret = 0 Then
        TempFileName = ""
    Else
        dloc = InStr(LCase$(filename), ".tmp")
        If dloc > 0 Then
            filename = Left$(filename, dloc + 3) ' get rid of trailing NULL
        End If
        TempFileName = filename
    End If

End Function

Sub AddFile(filename As String, status As Integer, descr As String)

    Dim asize As Integer

    If nfiles >= UBound(Files) Then
        If UBound(Files) < 50 Then
            asize = 100
        Else
            asize = UBound(Files) * 2
        End If
        ReDim Files(asize)
    End If

    Files(nfiles).Name = filename
    Files(nfiles).IsNew = status
    If descr = "" Then
        Files(nfiles).title = filename
    Else
        Files(nfiles).title = descr
    End If
    Files(nfiles).path = ""
    nfiles = nfiles + 1

End Sub

Public Function StringFromFile(filename As String) As String

    Dim f As Integer  ' file number
    Dim out As String ' output
    Dim ln As String  ' line of input
    Dim nl As String  ' end of line chars

    ' TODO: watch out for 32K string limit

    On Error GoTo StringFromFileError

    nl = Chr$(13) & Chr$(10)  ' newline
    out = ""  ' initialize string

    f = FreeFile

    Open filename For Input As f

    Do While Not EOF(f)
        Line Input #f, ln
        out = out & ln & nl
    Loop

    Close f

    StringFromFile = out

    Exit Function

StringFromFileError:
    ' file not found
    StringFromFile = ""
    Exit Function

End Function

Sub AddMetaVar(varname As String, varvalue As String)

    Dim asize As Integer

    If nMetaVars >= UBound(MetaVars) Then
        If UBound(MetaVars) < 50 Then
            asize = 100
        Else
            asize = UBound(MetaVars) * 2
        End If
        ReDim MetaVars(asize)
    End If

    MetaVars(nMetaVars).Name = varname
    MetaVars(nMetaVars).value = varvalue
    nMetaVars = nMetaVars + 1

End Sub




Public Sub GetFrontPageInfo()

    FrontPageRootDir = GetIniValue(FrontPageIniName, FrontPageSection, FrontPageRootKey)
    FrontPageDataDir = FrontPageRootDir & "\data"
    FrontPageTempDir = FrontPageRootDir & "\temp"
    FrontPageWebsDir = FrontPageRootDir & "\webs"
    FrontPagePagesDir = FrontPageRootDir & "\pages"

    FrontPageServerRoot = GetIniValue(FrontPageIniName, FrontPageSection, FrontPagePWSKey)
    FrontPageServerHost = GetIniValue(FrontPageIniName, FrontPageSection, FrontPageHostKey)

End Sub

Public Function GetIniValue(inifile As String, section As String, key As String) As String

    ' generic routine for reading INI values from any file

    Dim strval As String
    Dim valid As Long
    Dim size As Integer

    strval = Space$(2048)
    size = Len(strval)

    valid = GetPrivateProfileString(section, key, "*NO-VALUE*", strval, size, inifile)
    ' discard trailing spaces and NULL character
    strval = Left$(strval, valid)

    If strval = "*NO-VALUE*" Then
        ' means INI file is unreadable or doesn't exist or key not found;
        ' return empty string
        strval = ""
    End If

    GetIniValue = strval

End Function

Public Sub GetWizardInfo()

    ' only get a single argument:
    ' path to temp INI file with arguments;
    ' but have to handle quotes for installations
    ' with spaces in path

    Dim cmd As String
    Dim argfile As String
    Dim idx As Integer

    cmd = Command
    If (Left$(cmd, 1) = """") Then
        idx = Len(cmd)
        For idx = 2 To Len(cmd)
            If Mid$(cmd, idx, 1) = """" Then
                argfile = Trim$(Mid$(cmd, 2, idx - 2))
                Exit For
            End If
        Next idx
    Else
        argfile = Trim$(cmd)
    End If

    WizardArgFile = argfile

    ' fetch the built-in keys
    If Len(WizardArgFile) > 0 Then
        WizardDir = GetWizardInputVar(WizardDirKey)
        WizardInf = GetWizardInputVar(WizardInfKey)
        WizardBlocking = (CInt(GetWizardInputVar(WizardBlockingKey)) = 1)
        WizardEditing = (CInt(GetWizardInputVar(WizardEditingKey)) = 1)
        WizardPageURL = GetWizardInputVar(WizardPageURLKey)
        WizardPageFile = GetWizardInputVar(WizardPageFileKey)
        WizardPageTitle = GetWizardInputVar(WizardPageTitleKey)
        WizardDestination = GetWizardInputVar(WizardDestinationKey)
    End If

    ' establish the location for the wizard's persistent
    ' state info (if any) in FrontPage data dir; use this
    ' path if you need to save and restore settings from
    ' the previous run of your wizard
    If Len(FrontPageDataDir) > 0 Then
        WizardIniFile = FrontPageDataDir & "\" & App.EXEName & ".ini"
    Else
        ' use wizard dir; better than nothing
        WizardIniFile = App.path & "\" & App.EXEName & ".ini"
    End If

    WizardHasPreviousSettings = FileExists(WizardIniFile)

End Sub

Public Function GetWizardInputVar(key As String) As String

    If Len(WizardArgFile) > 0 Then
        GetWizardInputVar = GetIniValue(WizardArgFile, WizardInputSection, key)
    Else
        GetWizardInputVar = ""
    End If

End Function

Public Sub SetIniValue(file As String, section As String, key As String, value As String)

    ' generic routine for setting an INI value in any file

    Dim ret As Long

    ret = WritePrivateProfileString(section, key, value, file)

End Sub

Public Sub SetWizardOutputVar(key As String, value As String)

    If Len(WizardArgFile) > 0 Then
        SetIniValue WizardArgFile, WizardOutputSection, key, value
    End If

End Sub

Public Function FileExists(path As String) As Boolean

    On Error GoTo NoSuchFile
    Dim fileno As Integer

    fileno = FreeFile
    Open path For Input As #fileno
    Close #fileno
    FileExists = True
    Exit Function

NoSuchFile:
    FileExists = False
    Exit Function

End Function

Public Function GetWizardEnvironmentVar(key As String) As String

    ' use this routine to read environment variables as set
    ' in the program that launched the wizard
    GetWizardEnvironmentVar = GetIniValue(WizardArgFile, WizardEnvironmentSection, key)

End Function



Public Sub ValidatePageURLField(txtbox As TextBox)

    Dim inp As String
    Dim outp As String
    Dim sst As Integer
    Dim slen As Integer
    Dim i As Integer
    Dim ch As String
    Dim legals As String
    Dim gotdot As Boolean

    ' alphanumeric
    legals = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
    ' add the legal funny chars
    legals = legals & "-_@$~&"

    sst = txtbox.SelStart
    slen = txtbox.SelLength

    inp = txtbox.Text

    For i = 1 To Len(inp)
        ch = Mid$(inp, i, 1)
        If InStr(legals, ch) > 0 Then
            outp = outp & ch
        Else
            If ch = "." Then
                gotdot = True
                Exit For
            End If
        End If
    Next i

    If gotdot Then
        outp = outp & ".htm"
    Else
        If Right$(outp, 3) = "htm" Then
            outp = Left$(outp, Len(outp) - 3)
            outp = outp & ".htm"
        End If
    End If

    If outp <> inp Then
        txtbox.Text = outp
        txtbox.SelStart = sst + (Len(outp) - Len(inp))
    End If

End Sub

Public Sub SetWizardExitStatus(stat As String)

    SetWizardOutputVar WizardExitStatusKey, stat

End Sub

Public Sub SetWizardFileCount(num As Integer)

    SetWizardOutputVar WizardFileCountKey, CStr(num)

End Sub

Public Sub MakeFloatingWindow(hWnd As Long, yesno As Boolean)

    Dim ret As Long

    If yesno Then
        ret = SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
    Else
        ret = SetWindowPos(hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
    End If

End Sub