RiskYourLife/Client
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial commit: ROW Client source code

Browse Source 
Game client codebase including:
- CharacterActionControl: Character and creature management
- GlobalScript: Network, items, skills, quests, utilities
- RYLClient: Main client application with GUI and event handlers
- Engine: 3D rendering engine (RYLGL)
- MemoryManager: Custom memory allocation
- Library: Third-party dependencies (DirectX, boost, etc.)
- Tools: Development utilities

🤖 Generated with [Claude Code](https://claude.com/claude-code)

Co-Authored-By: Claude <noreply@anthropic.com>
This commit is contained in:
tindevil
2025-11-29 16:24:34 +09:00
commit e067522598
5135 changed files with 1745744 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

223
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/begin.frm Normal file
View File

@@ -0,0 +1,223 @@
VERSION 5.00
Begin VB.Form frmBegin
AutoRedraw = -1 'True
BorderStyle = 3 'Fixed Dialog
Caption = "#"
ClientHeight = 3540
ClientLeft = 1740
ClientTop = 1410
ClientWidth = 7545
ClipControls = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
HasDC = 0 'False
Icon = "begin.frx":0000
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
NegotiateMenus = 0 'False
ScaleHeight = 3540
ScaleWidth = 7545
ShowInTaskbar = 0 'False
Begin VB.CommandButton cmdInstall
Default = -1 'True
Height = 1080
Left = 330
MaskColor = &H0000FF00&
Picture = "begin.frx":0442
Style = 1 'Graphical
TabIndex = 0
Top = 510
UseMaskColor = -1 'True
Width = 1170
End
Begin VB.Frame fraDir
Caption = "#"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 660
Left = 135
TabIndex = 5
Top = 2010
Width = 7296
Begin VB.CommandButton cmdChDir
Caption = "#"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 390
Left = 4890
MaskColor = &H00000000&
TabIndex = 1
Top = 195
Width = 2310
End
Begin VB.Label lblDestDir
Caption = "#"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 135
TabIndex = 6
Top = 300
Width = 4440
End
End
Begin VB.CommandButton cmdExit
Cancel = -1 'True
Caption = "#"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 2610
MaskColor = &H00000000&
TabIndex = 2
Top = 3030
Width = 2205
End
Begin VB.Line linTopOfExitButtonIfNoDestDir
Visible = 0 'False
X1 = 2670
X2 = 4725
Y1 = 2280
Y2 = 2280
End
Begin VB.Label lblInstallMsg
AutoSize = -1 'True
Caption = "*"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 1725
TabIndex = 4
Top = 915
Width = 5565
WordWrap = -1 'True
End
Begin VB.Label lblBegin
AutoSize = -1 'True
Caption = "#"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 192
Left = 288
TabIndex = 3
Top = 132
Width = 6456
WordWrap = -1 'True
End
End
Attribute VB_Name = "frmBegin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdChDir_Click()
ShowPathDialog
If gintRetVal = gintRET_CONT Then
lblDestDir.Caption = gstrDestDir
cmdInstall.SetFocus
End If
End Sub
Private Sub cmdExit_Click()
ExitSetup Me, gintRET_EXIT
End Sub
Private Sub cmdInstall_Click()
If IsValidDestDir(gstrDestDir) Then
Unload Me
DoEvents
End If
End Sub
Private Sub Form_Load()
Dim intRes As Integer
Dim yAdjust As Integer
SetFormFont Me
fraDir.Caption = ResolveResString(resFRMDIRECTORY)
cmdChDir.Caption = ResolveResString(resBTNCHGDIR)
cmdExit.Caption = ResolveResString(resBTNEXIT)
lblBegin.Caption = ResolveResString(resLBLBEGIN)
cmdInstall.ToolTipText = ResolveResString(resBTNTOOLTIPBEGIN)
Caption = gstrTitle
If gfForceUseDefDest Then
intRes = resSPECNODEST
Else
intRes = resSPECDEST
End If
lblInstallMsg.Caption = ResolveResString(intRes, gstrPIPE1, gstrAppName)
lblDestDir.Caption = gstrDestDir
If gfForceUseDefDest Then
'We are forced to use the default destination directory, so the user
' will not be able to change it.
fraDir.Visible = False
'Close in the blank space on the form by moving the Exit button to where this frame
'currently is, and adjusting the size of the form respectively
yAdjust = cmdExit.Top - linTopOfExitButtonIfNoDestDir.Y1
cmdExit.Top = cmdExit.Top - yAdjust
Height = Height - yAdjust
End If
EtchedLine Me, fraDir.Left, cmdExit.Top - cmdExit.Height \ 2, fraDir.Width
CenterForm Me
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
HandleFormQueryUnload UnloadMode, Cancel, Me
End Sub

BIN
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/begin.frx Normal file
View File

Binary file not shown.

2033
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/common.bas Normal file
View File

File diff suppressed because it is too large Load Diff

52
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/commonrc.h Normal file
View File

@@ -0,0 +1,52 @@
#define resLOG_FILEUPTODATE 2000
#define resLOG_FILECOPIED 2001
#define resLOG_ERROR 2002
#define resLOG_WARNING 2003
#define resLOG_DURINGACTION 2004
//2005 - 2011 not currently used in Setup1.exe
#define resLOG_CANNOTWRITE 2005
#define resLOG_CANNOTCREATE 2006
#define resLOG_DONOTMODIFY 2007
#define resLOG_FILECONTENTS 2008
#define resLOG_FILEUSEDFOR 2009
#define resLOG_UNEXPECTED 2010
#define resLOG_OUTOFMEMORY 2011
#define resLOG_USERRESPONDEDWITH 2012
#define resLOG_CANTRUNAPPREMOVER 2013
#define resLOG_ABOUTTOREMOVEAPP 2014
// The following are the captions on system dialog buttons
#define resLOG_IDOK 2100
#define resLOG_IDCANCEL 2101
#define resLOG_IDABORT 2102
#define resLOG_IDRETRY 2103
#define resLOG_IDIGNORE 2104
#define resLOG_IDYES 2105
#define resLOG_IDNO 2106
#define resLOG_IDUNKNOWN 2107
#define resCOMMON_CANTREG 2200
#define resCOMMON_CANTREGUNEXPECTED 2201
#define resCOMMON_CANTREGOLE 2202
#define resCOMMON_CANTREGLOAD 2203
#define resCOMMON_CANTREGENTRY 2204
#define resCOMMON_CANTREGREG 2205
//2206 - 2208 not currently used in setup1.exe
#define resCOMMON_CANTREGAUTPRXRPC1 2206
#define resCOMMON_CANTREGAUTPRXRPC2 2207
#define resCOMMON_CTL3D32NOTCOPIED 2208
#define resCOMMON_INVALIDFILECHARS 2209
#define resCOMMON_MULTDIRBASENAME 2210
#define resCOMMON_CANTFINDSRCFILE 2211
#define resCOMMON_CANTREGTLB 2212
#define resCOMMON_RICHED32NOTCOPIED 2213
//2214 - 2216 not currently used in setup1.exe
#define resCOMMON_AXDISTNOTCOPIED 2214
#define resCOMMON_WINT351NOTCOPIED 2215
#define resCOMMON_CANTDOREBOOTCOPY 2216

46
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/commonrc.rc Normal file
View File

@@ -0,0 +1,46 @@
resLOG_FILEUPTODATE "File currently on disk was already up to date"
resLOG_FILECOPIED "File was not found or was an older version -- new file copied"
resLOG_ERROR "ERROR:"
resLOG_WARNING "WARNING:"
resLOG_DURINGACTION "DURING THIS ACTION:"
resLOG_CANNOTWRITE "Error writing to logfile '|1'"
resLOG_CANNOTCREATE "Setup fatal error: Unable to generate installation log file." // Used by setup.c!
resLOG_DONOTMODIFY "PLEASE DO NOT MODIFY OR DELETE THIS FILE!"
resLOG_FILECONTENTS "This file contains information about the installation of an application."
resLOG_FILEUSEDFOR "It will be used to automatically remove all application components from your computer if you choose to do so."
resLOG_UNEXPECTED "There was an unexpected problem trying to create or write to the logfile '|1'. Error number is |2."
resLOG_OUTOFMEMORY "Out of memory trying to create or write to the logfile '|1'"
resLOG_USERRESPONDEDWITH "User Responded with '|1'"
resLOG_CANTRUNAPPREMOVER "Error attempting to run the application removal program to remove temporary installation files."
resLOG_ABOUTTOREMOVEAPP "Setup will now start the application removal utility to remove temporary installation files."
// The following are the captions on system dialog buttons, but should NOT contain '&' for shortcuts
resLOG_IDOK "OK"
resLOG_IDCANCEL "Cancel"
resLOG_IDABORT "Abort"
resLOG_IDRETRY "Retry"
resLOG_IDIGNORE "Ignore"
resLOG_IDYES "Yes"
resLOG_IDNO "No"
resLOG_IDUNKNOWN "(Unknown)" // (Unexpected error case)
resCOMMON_CANTREG "An error occurred while registering the file '|1'"
resCOMMON_CANTREGUNEXPECTED "Unexpected error while registering file '|1'"
resCOMMON_CANTREGOLE "Could not initialize OLE in order to register file '|1'"
resCOMMON_CANTREGLOAD "LoadLibrary() failed while registering file '|1'"
resCOMMON_CANTREGENTRY "No entrypoint for DllRegisterServer() was found in '|1'"
resCOMMON_CANTREGREG "DllRegisterServer() in the file '|1' returned failure"
resCOMMON_CANTREGTLB "Could not register the TLB file '|1'."
resCOMMON_CANTREGAUTPRXRPC1 "One possible cause for this error is that RPC may not be installed on your computer."
resCOMMON_CANTREGAUTPRXRPC2 "If this is the problem, then you will need to exit Setup, install RPC, and restart Setup."
resCOMMON_CTL3D32NOTCOPIED "The file '|1' was not copied because it is intended for use under Windows NT 3.51 only. It is not needed under Windows 95 or NT 4.0."
resCOMMON_RICHED32NOTCOPIED "The file '|1' was not copied because it is intended for use under Windows 95 only. It is not needed under Windows NT 3.51 or 4.0."
resCOMMON_AXDISTNOTCOPIED "The file '|1' was not copied because it is intended for use under Windows 95 and NT 4.x only. It is not needed under Windows NT 3.51."
resCOMMON_WINT351NOTCOPIED "The file '|1' was not copied because it is intended for use under Windows NT 3.51 only. It is not needed under Windows 95 or NT 4.x."
// Localizers, a list of invalid file name characters can be easily obtained in Win95 by simply trying to create a file name in Explorer with any
// invalid characters in it. An error message will appear displaying all invalid characters.
resCOMMON_INVALIDFILECHARS "\/:*?""<>|"
resCOMMON_MULTDIRBASENAME "DISK"
resCOMMON_CANTFINDSRCFILE "Cannot find the source file '|1' to install."
resCOMMON_CANTDOREBOOTCOPY "Cannot update system file '|1'. You may not have permission to update system files on this machine."

127
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/copy.frm Normal file
View File

@@ -0,0 +1,127 @@
VERSION 5.00
Begin VB.Form frmCopy
BorderStyle = 3 'Fixed Dialog
Caption = "#"
ClientHeight = 1830
ClientLeft = 870
ClientTop = 1530
ClientWidth = 5910
ClipControls = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
HasDC = 0 'False
Icon = "copy.frx":0000
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
NegotiateMenus = 0 'False
ScaleHeight = 1830
ScaleWidth = 5910
ShowInTaskbar = 0 'False
Begin VB.PictureBox picStatus
AutoRedraw = -1 'True
ClipControls = 0 'False
FillColor = &H00FF0000&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 384
Left = 168
ScaleHeight = 330
ScaleWidth = 5535
TabIndex = 3
TabStop = 0 'False
Top = 708
Width = 5592
End
Begin VB.CommandButton cmdExit
Cancel = -1 'True
Caption = "#"
Default = -1 'True
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 2085
MaskColor = &H00000000&
TabIndex = 0
Top = 1275
Width = 1665
End
Begin VB.Label lblDestFile
Caption = "*"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 192
Left = 168
TabIndex = 1
Top = 300
Width = 5640
End
Begin VB.Label lblCopy
AutoSize = -1 'True
Caption = "#"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 165
TabIndex = 2
Top = 0
Width = 105
End
End
Attribute VB_Name = "frmCopy"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdExit_Click()
ExitSetup Me, gintRET_EXIT
End Sub
Private Sub Form_Load()
SetFormFont Me
cmdExit.Caption = ResolveResString(resBTNCANCEL)
lblCopy.Caption = ResolveResString(resLBLDESTFILE)
lblDestFile.Caption = vbNullString
frmCopy.Caption = gstrTitle
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
HandleFormQueryUnload UnloadMode, Cancel, Me
End Sub

BIN
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/copy.frx Normal file
View File

Binary file not shown.

406
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/dskspace.frm Normal file
View File

@@ -0,0 +1,406 @@
VERSION 5.00
Begin VB.Form frmDskSpace
AutoRedraw = -1 'True
BorderStyle = 3 'Fixed Dialog
Caption = "#"
ClientHeight = 2550
ClientLeft = 870
ClientTop = 1530
ClientWidth = 5355
ClipControls = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
HasDC = 0 'False
Icon = "dskspace.frx":0000
MaxButton = 0 'False
MinButton = 0 'False
NegotiateMenus = 0 'False
ScaleHeight = 2550
ScaleWidth = 5355
ShowInTaskbar = 0 'False
Begin VB.CommandButton cmdChgDrv
Caption = "#"
Default = -1 'True
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 195
MaskColor = &H00000000&
TabIndex = 2
Top = 1965
Width = 1560
End
Begin VB.CommandButton cmdInstall
Caption = "#"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 1875
MaskColor = &H00000000&
TabIndex = 1
Top = 1965
Width = 1560
End
Begin VB.CommandButton cmdExit
Cancel = -1 'True
Caption = "#"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 3570
MaskColor = &H00000000&
TabIndex = 0
Top = 1965
Width = 1560
End
Begin VB.Label lblNoSpace
AutoSize = -1 'True
Caption = "#"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 195
TabIndex = 11
Top = 150
Width = 105
End
Begin VB.Shape shpHeading
BorderColor = &H00000000&
Height = 480
Left = 195
Top = 750
Width = 4980
End
Begin VB.Label lblReqH
Alignment = 1 'Right Justify
Caption = "#"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 810
TabIndex = 10
Top = 810
Width = 1260
WordWrap = -1 'True
End
Begin VB.Label lblNeedH
Alignment = 1 'Right Justify
Caption = "#"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 3885
TabIndex = 9
Top = 810
Width = 1260
WordWrap = -1 'True
End
Begin VB.Label lblAvailH
Alignment = 1 'Right Justify
Caption = "#"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 2355
TabIndex = 8
Top = 810
Width = 1260
WordWrap = -1 'True
End
Begin VB.Label lblDiskH
AutoSize = -1 'True
Caption = "#"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 240
TabIndex = 7
Top = 1005
Width = 105
End
Begin VB.Shape shpSpace
BorderColor = &H00000000&
Height = 390
Left = 195
Top = 1230
Width = 4980
End
Begin VB.Label lblReq
Alignment = 1 'Right Justify
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 0
Left = 810
TabIndex = 6
Top = 1305
Visible = 0 'False
Width = 1260
End
Begin VB.Label lblNeed
Alignment = 1 'Right Justify
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 0
Left = 3885
TabIndex = 5
Top = 1305
Visible = 0 'False
Width = 1260
End
Begin VB.Label lblAvail
Alignment = 1 'Right Justify
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 0
Left = 2340
TabIndex = 4
Top = 1305
Visible = 0 'False
Width = 1260
End
Begin VB.Label lblDisk
AutoSize = -1 'True
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 0
Left = 240
TabIndex = 3
Top = 1305
Visible = 0 'False
Width = 510
End
End
Attribute VB_Name = "frmDskSpace"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const mstrFMT$ = "######0 K"
Private Sub cmdChgDrv_Click()
gintRetVal = gintRET_CANCEL
Unload Me
End Sub
Private Sub cmdExit_Click()
ExitSetup Me, gintRET_EXIT
End Sub
Private Sub cmdInstall_Click()
gintRetVal = gintRET_CONT
Unload Me
End Sub
Private Sub Form_Load()
Const ONE_K& = 1024
Dim intIdx As Integer
Dim lAvail As Long
Dim lReq As Long
Dim lTmp As Long
Dim intHeight As Integer
Dim intTop As Integer
Dim sDrive As String
Dim nCurrentWidth As Single
Dim nMaxWidth As Single
nCurrentWidth = lblDisk(0).Width
nMaxWidth = nCurrentWidth
SetFormFont Me
cmdExit.Caption = ResolveResString(resBTNEXIT)
cmdInstall.Caption = ResolveResString(resBTNINSTALLNOW)
cmdChgDrv.Caption = ResolveResString(resBTNCHGDRV)
lblDiskH.Caption = ResolveResString(resLBLDRIVE)
lblAvailH.Caption = ResolveResString(resLBLAVAIL)
lblNeedH.Caption = ResolveResString(resLBLNEEDED)
lblReqH.Caption = ResolveResString(resLBLREQUIRED)
lblNoSpace.Caption = ResolveResString(resLBLNOSPACE)
frmDskSpace.Caption = gstrTitle
intHeight = lblDisk(0).Height * 1.6
intTop = lblDisk(0).Top
'
'borders are for design mode only...
'
lblDisk(0).BorderStyle = vbTransparent
lblReq(0).BorderStyle = vbTransparent
lblAvail(0).BorderStyle = vbTransparent
lblNeed(0).BorderStyle = vbTransparent
For intIdx = 1 To DriveCount
Load lblDisk(intIdx)
Load lblReq(intIdx)
Load lblAvail(intIdx)
Load lblNeed(intIdx)
lAvail = gsDiskSpace(intIdx).lAvail
lReq = gsDiskSpace(intIdx).lReq
sDrive = DriveFromDriveIndex(intIdx)
RemoveDirSep sDrive
lblDisk(intIdx).Caption = sDrive
If lblDisk(intIdx).Width > nMaxWidth Then
nMaxWidth = lblDisk(intIdx).Width
End If
lblReq(intIdx).Caption = Format$(lReq / ONE_K, mstrFMT)
lblAvail(intIdx).Caption = Format$(lAvail / ONE_K, mstrFMT)
If lReq > lAvail Then
lTmp = lReq - lAvail
Else
lTmp = 0
End If
lblNeed(intIdx).Caption = Format$(lTmp / ONE_K, mstrFMT)
lblDisk(intIdx).Top = intTop
lblReq(intIdx).Top = intTop
lblAvail(intIdx).Top = intTop
lblNeed(intIdx).Top = intTop
intTop = intTop + intHeight
lblDisk(intIdx).Visible = True
lblReq(intIdx).Visible = True
lblAvail(intIdx).Visible = True
lblNeed(intIdx).Visible = True
Next intIdx
If nMaxWidth <> nCurrentWidth Then
nMaxWidth = nMaxWidth - nCurrentWidth
For intIdx = 1 To DriveCount
lblReq(intIdx).Left = lblReq(intIdx).Left + nMaxWidth
lblAvail(intIdx).Left = lblAvail(intIdx).Left + nMaxWidth
lblNeed(intIdx).Left = lblNeed(intIdx).Left + nMaxWidth
Next intIdx
lblReqH.Left = lblReqH.Left + nMaxWidth
lblAvailH.Left = lblAvailH.Left + nMaxWidth
lblNeedH.Left = lblNeedH.Left + nMaxWidth
shpHeading.Width = shpHeading.Width + nMaxWidth
shpSpace.Width = shpSpace.Width + nMaxWidth
Width = Width + nMaxWidth
nMaxWidth = nMaxWidth / 3
cmdChgDrv.Width = cmdChgDrv.Width + nMaxWidth
cmdInstall.Left = cmdInstall.Left + nMaxWidth
cmdInstall.Width = cmdInstall.Width + nMaxWidth
cmdExit.Left = cmdExit.Left + (2 * nMaxWidth)
cmdExit.Width = cmdExit.Width + nMaxWidth
End If
shpSpace.Height = intHeight * (intIdx - 1)
cmdChgDrv.Top = shpSpace.Top + shpSpace.Height + cmdChgDrv.Height
cmdInstall.Top = cmdChgDrv.Top
cmdExit.Top = cmdChgDrv.Top
frmDskSpace.Height = cmdChgDrv.Top + cmdChgDrv.Height * 2.5
EtchedLine Me, 100, cmdChgDrv.Top - cmdChgDrv.Height * 0.5, ScaleWidth - 200
CenterForm Me
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
HandleFormQueryUnload UnloadMode, Cancel, Me
End Sub

BIN
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/dskspace.frx Normal file
View File

Binary file not shown.

271
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/group.frm Normal file
View File

@@ -0,0 +1,271 @@
VERSION 5.00
Begin VB.Form frmGroup
BorderStyle = 3 'Fixed Dialog
Caption = "* #"
ClientHeight = 5250
ClientLeft = 1095
ClientTop = 1515
ClientWidth = 5460
ClipControls = 0 'False
HasDC = 0 'False
Icon = "group.frx":0000
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
NegotiateMenus = 0 'False
ScaleHeight = 350
ScaleMode = 3 'Pixel
ScaleWidth = 364
ShowInTaskbar = 0 'False
Begin VB.DirListBox dir95Groups
Height = 930
Left = 765
TabIndex = 8
Top = 60
Visible = 0 'False
Width = 3810
End
Begin VB.Frame Frame1
Height = 30
Left = 105
TabIndex = 7
Top = 4650
Width = 5220
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "#"
Height = 345
Left = 2880
MaskColor = &H00000000&
TabIndex = 3
Top = 4800
Width = 1140
End
Begin VB.CommandButton cmdContinue
Caption = "#"
Default = -1 'True
Height = 345
Left = 1395
MaskColor = &H00000000&
TabIndex = 2
Top = 4800
Width = 1140
End
Begin VB.ListBox lstGroups
Height = 2010
ItemData = "group.frx":0442
Left = 1080
List = "group.frx":0449
Sorted = -1 'True
TabIndex = 1
Top = 2220
Width = 3240
End
Begin VB.TextBox txtGroup
Height = 300
Left = 1080
MaxLength = 128
TabIndex = 0
Text = "*"
Top = 1410
Width = 3270
End
Begin VB.Label lblDDE
Height = 225
Left = 225
TabIndex = 9
Top = 1350
Visible = 0 'False
Width = 705
End
Begin VB.Label lblGroups
AutoSize = -1 'True
Caption = "#"
Height = 195
Left = 1080
TabIndex = 6
Top = 1950
Width = 105
End
Begin VB.Label lblGroup
AutoSize = -1 'True
Caption = "#"
Height = 195
Left = 1080
TabIndex = 5
Top = 1170
Width = 105
End
Begin VB.Label lblMain
AutoSize = -1 'True
Caption = "#"
Height = 195
Left = 180
TabIndex = 4
Top = 165
Width = 5100
WordWrap = -1 'True
End
End
Attribute VB_Name = "frmGroup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mstrGroup As String
Private mstrDefGroup As String
Private mstrProgramsPath As String
Private mfrm As Form
Private mfPrivate As Boolean
Private mfStartMenu As Boolean
Private Sub cmdCancel_Click()
ExitSetup frmGroup, gintRET_EXIT
End Sub
Private Sub cmdContinue_Click()
mstrGroup = txtGroup.Text
If Not fCreateProgGroup() Then
'
' Couldn't create the group. Let
' the user try again.
'
txtGroup.SetFocus
Else
'
' The group got created ok, so unload Choose Program Group dialog
' and continue on with setup.
'
Unload Me
End If
End Sub
Private Function fCreateProgGroup() As Boolean
'
' Create a program group.
'
Dim strMsg As String
If Not fValidFilename(mstrGroup) Then
strMsg = ResolveResString(resGROUPINVALIDGROUPNAME, gstrPIPE1, CStr(gintMAX_PATH_LEN), gstrPIPE2, ResolveResString(resCOMMON_INVALIDFILECHARS))
MsgFunc strMsg, vbOKOnly Or vbQuestion, gstrTitle
Exit Function
End If
'
'Go ahead and create the main program group
'
If Not fCreateShellGroup(mstrGroup, True, , mfPrivate, mfStartMenu) Then
Exit Function
End If
fCreateProgGroup = True
End Function
Private Sub Form_Load()
'
' Initialize localized control properties.
'
SetFormFont Me
Caption = ResolveResString(resGROUPFRM, gstrPIPE1, gstrAppName)
lblMain.Caption = ResolveResString(resGROUPLBLMAIN)
lblGroup.Caption = ResolveResString(resGROUPLBLGROUP)
lblGroups.Caption = ResolveResString(resGROUPLBLGROUPS)
cmdContinue.Caption = ResolveResString(resGROUPBTNCONTINUE)
cmdCancel.Caption = ResolveResString(resLOG_vbCancel)
'
' Initialize the Program Group text box with the
' title of the application.
'
txtGroup.Text = gstrTitle
'
' Load the ListBox with the program manager groups.
'
LoadW95Groups
'
' Initialize the Program Group textbox with the
' default group selected in the list box.
'
lstGroups_Click
End Sub
Private Sub lstGroups_Click()
txtGroup.Text = lstGroups.Text
End Sub
Private Sub txtGroup_Change()
cmdContinue.Enabled = Len(Trim$(txtGroup.Text)) > 0
End Sub
Private Sub LoadW95Groups()
'
' This routine uses the system registry to
' retrieve a list of all the subfolders in the
' \windows\start menu\programs folder.
'
Dim strFolder As String
Dim iFolder As Integer
mstrProgramsPath = strGetProgramsFilesPath()
strFolder = Dir$(mstrProgramsPath, vbDirectory) ' Retrieve the first entry.
lstGroups.Clear
Do While Len(strFolder) > 0
'
' Ignore the current directory and the encompassing directory.
'
If strFolder <> "." Then
If strFolder <> ".." Then
'
' Verify that we actually got a directory and not a file.
'
If DirExists(mstrProgramsPath & strFolder) Then
'
' We got a directory, add it to the list.
'
lstGroups.AddItem strFolder
End If
End If
End If
'
' Get the next subfolder in the Programs folder
'
strFolder = Dir$
Loop
'
' The lstGroups listbox now contains a listing of all the Programs
' subfolders (the groups).
'
' Look for the default folder in the list and select it. If it's
' not there, add it.
'
iFolder = SendMessageString(lstGroups.hWnd, LB_FINDSTRINGEXACT, -1, mstrDefGroup)
If iFolder = LB_ERR Then
'
' The group doesn't yet exist, add it to the list.
'
lstGroups.AddItem mstrDefGroup
lstGroups.ListIndex = lstGroups.NewIndex
Else
lstGroups.ListIndex = iFolder
End If
End Sub
Public Property Get GroupName(frm As Form, strDefGroup As String, Optional fPriv As Boolean = True, Optional ByVal fStart As Boolean = False) As String
mstrDefGroup = strDefGroup
Set mfrm = frm
mfPrivate = fPriv
mfStartMenu = fStart
If gfNoUserInput Then
mstrGroup = mstrDefGroup
If Not fCreateProgGroup() Then
ExitSetup frmSetup1, gintRET_FATAL
End If
Else
Show vbModal
End If
GroupName = mstrGroup
End Property
Private Sub txtGroup_GotFocus()
txtGroup.SelStart = 0
txtGroup.SelLength = Len(txtGroup.Text)
End Sub

BIN
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/group.frx Normal file
View File

Binary file not shown.

BIN
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/install.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 4.8 KiB

273
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/logging.bas Normal file
View File

@@ -0,0 +1,273 @@
Attribute VB_Name = "basLogging"
Option Explicit
'
' Module basLogging (32-bit functionality only)
'
'The routines in this module are used for logging actions,
'warnings, notes and errors in an application removal
'logfile. This logfile will be used by the application
'removal utility (ST6UNST.EXE) in the event that the user
'decides to remove the installed application (via a Program
'Manager icon under Windows NT or the Add/Remove Programs
'control panel applet under Windows 95).
'
'The functions are based on transaction-like "actions".
'Whenever the setup program starts to process a new action
'(an action is anything which the application removal
'utility must undo), the function NewAction() must be
'called with the appropriate parameters for that action
'(search for NewAction in this project to see how the
'correct parameters for various actions are formed).
'When the action has been successfully completed, the
'function CommitAction() is called, or, if the
'action was not successfully completed, AbortAction()
'must be called. If CommitAction() is called, then the
'action is logged at that point, and the application
'removal utility will undo that action (example, delete
'a file which was copied by setup).
'
'Actions may be nested (for instance, a file copy
'action may have a nested direction creation action).
'Any errors, warnings or notes logged will note in
'the logfile the pending action (if any). Even if
'an error is logged, the pending action must either
'be committed or canceled. See comments for each
'function below for more specifics.
'
'Application removal is only supported for 32-bit projects
'Set this constant to FALSE if you do not want warnings to appear
'in the logfile
Public Const fLOG_WARNINGS = True
'Global Action Key constants
Public Const gstrKEY_PRIVATEFILE = "PrivateFile"
Public Const gstrKEY_TEMPFILE = "TempFile"
Public Const gstrKEY_SHAREDFILE = "SharedFile"
Public Const gstrKEY_SYSTEMFILE = "SystemFile"
Public Const gstrKEY_CREATEDIR = "CreateDir"
Public Const gstrKEY_SHELLLINK = "ShellLink"
Public Const gstrKEY_DLLSELFREGISTER = "DllSelfRegister"
Public Const gstrKEY_EXESELFREGISTER = "ExeSelfRegister"
Public Const gstrKEY_TLBREGISTER = "TLBRegister"
Public Const gstrKEY_REMOTEREGISTER = "RemoteRegister"
Public Const gstrKEY_REGKEY = "RegKey"
Public Const gstrKEY_REGVALUE = "RegValue"
'vb6stkit.dll logging errors
Private Const LOGERR_SUCCESS = 0
Private Const LOGERR_INVALIDARGS = 1
Private Const LOGERR_OUTOFMEMORY = 2
Private Const LOGERR_EXCEEDEDCAPACITY = 3
Private Const LOGERR_WRITEERROR = 4
Private Const LOGERR_NOCURRENTACTION = 5
Private Const LOGERR_UNEXPECTED = 6
Private Const LOGERR_FILENOTFOUND = 7
'Logging error Severities
Private Const LogErrOK = 1 ' OK to continue upon this error
Private Const LogErrFatal = 2 ' Must terminate install upon this error
'vb6stkit.DLL interfaces
Private Declare Function DllAbortAction Lib "vb6stkit.dll" Alias "AbortAction" () As Long
Private Declare Function DllAddActionNote Lib "vb6stkit.dll" Alias "AddActionNote" (ByVal lpszNote As String) As Long
Private Declare Function DllCommitAction Lib "vb6stkit.dll" Alias "CommitAction" () As Long
Private Declare Function fDllWithinAction Lib "vb6stkit.dll" Alias "fWithinAction" () As Long
Private Declare Function DllLogError Lib "vb6stkit.dll" Alias "LogError" (ByVal lpszERROR As String, ByVal lpszDURINGACTION As String, ByVal lpszErrMsg As String) As Long
Private Declare Function DllLogNote Lib "vb6stkit.dll" Alias "LogNote" (ByVal lpszNote As String) As Long
Private Declare Function DllLogWarning Lib "vb6stkit.dll" Alias "LogWarning" (ByVal lpszWARNING As String, ByVal lpszDURINGACTION As String, ByVal lpszWarningMsg As String) As Long
Private Declare Function DllNewAction Lib "vb6stkit.dll" Alias "NewAction" (ByVal lpszKey As String, ByVal lpszData As String) As Long
Private Declare Function DllEnableLogging Lib "vb6stkit.dll" Alias "EnableLogging" (ByVal lpszFilename As String) As Long
Private Declare Function DllDisableLogging Lib "vb6stkit.dll" Alias "DisableLogging" () As Long
'-----------------------------------------------------------
' SUB: AbortAction
'
' Aborts the current action.
'-----------------------------------------------------------
'
Public Sub AbortAction()
ShowLoggingError DllAbortAction(), LogErrFatal
End Sub
'-----------------------------------------------------------
' SUB: AddActionNote
'
' Adds an note which will be written to the log file
' immediately following the current action
'-----------------------------------------------------------
'
Public Sub AddActionNote(ByVal strNote As String)
ShowLoggingError DllAddActionNote(strNote), LogErrOK
End Sub
'-----------------------------------------------------------
' SUB: CommitAction
'
' Marks the successful completion of the current action.
' The action will be output to the log file.
'-----------------------------------------------------------
'
Public Sub CommitAction()
ShowLoggingError DllCommitAction(), LogErrFatal
End Sub
'-----------------------------------------------------------
' SUB: DisableLogging
'
' Disables application removal logging. All logging
' functions can still be called, and must still be
' symentically correct, but no data will be written to disk.
'-----------------------------------------------------------
'
Public Sub DisableLogging()
ShowLoggingError DllDisableLogging(), LogErrFatal
End Sub
'-----------------------------------------------------------
' SUB: EnableLogging
'
' Enables application setup/removal logging to the specified logfile
'-----------------------------------------------------------
'
Public Sub EnableLogging(ByVal strLogFileName As String)
ShowLoggingError DllEnableLogging(strLogFileName), LogErrFatal
End Sub
'-----------------------------------------------------------
' SUB: LogError
'
' Logs an error to the logfile. The action is NOT aborted.
'-----------------------------------------------------------
'
Public Sub LogError(ByVal strErr As String)
ShowLoggingError DllLogError(ResolveResString(resLOG_ERROR), ResolveResString(resLOG_DURINGACTION), strErr), LogErrFatal
End Sub
'-----------------------------------------------------------
' SUB: LogWarning
'
' Logs a warning to the logfile. The action is NOT aborted.
' Warnings are different from errors in that generally
' warnings are not brought to the end user's attention.
' Also, the bootstrapper does not ever log warnings. It only
' logs errors.
'
' The logging of warnings can be turned off by changing the
' value of fLOG_WARNINGS in the declarations section of this
' module.
'-----------------------------------------------------------
'
Public Sub LogWarning(ByVal strWarning As String)
If fLOG_WARNINGS Then
ShowLoggingError DllLogWarning(ResolveResString(resLOG_WARNING), ResolveResString(resLOG_DURINGACTION), strWarning), LogErrFatal
End If
End Sub
'-----------------------------------------------------------
' SUB: LogNote
'
' Logs a note to the logfile. It is not necessary to have
' a current action in order to execute this subroutine.
'-----------------------------------------------------------
'
Public Sub LogNote(ByVal strNote As String)
ShowLoggingError DllLogNote(strNote), LogErrOK
End Sub
'-----------------------------------------------------------
' SUB: NewAction
'
' Marks the start of a new action for logging. If this
' routine is called before any current action is committed
' or aborted, the previous action will be placed
' on a stack. Once the new action has been committed or
' aborted, the previous action will become active again.
' The reporting of errors, warnings, notes and action
' results are not printed until the action aborts or
' commits.
' Several actions may be stacked in a first-in-first-out
' manner by calling this routine repeatedly.
'-----------------------------------------------------------
'
Public Sub NewAction(ByVal strKey As String, ByVal strData As String)
ShowLoggingError DllNewAction(strKey, strData), LogErrFatal
End Sub
Private Sub ShowLoggingError(ByVal lErr As Long, ByVal lErrSeverity As Long)
Dim strErrMsg As String
Static fRecursive As Boolean
Dim iRet As Integer
Dim fAbort As Boolean
If lErr = LOGERR_SUCCESS Then
Exit Sub
End If
If fRecursive Then
'If we're getting called recursively, we're likely
'getting errors while trying to write out errors to
'the logfile. Nothing to do but turn off logging
'and abort setup.
DisableLogging
MsgError ResolveResString(resUNEXPECTED), vbExclamation Or vbOKOnly, gstrTitle
ExitSetup frmSetup1, gintRET_FATAL
End If
fRecursive = True
Select Case lErr
Case LOGERR_OUTOFMEMORY, LOGERR_WRITEERROR, LOGERR_UNEXPECTED, LOGERR_FILENOTFOUND
strErrMsg = ResolveResString(resUNEXPECTED)
Case LOGERR_INVALIDARGS, LOGERR_EXCEEDEDCAPACITY, LOGERR_NOCURRENTACTION
'Note: These errors are most likely the result of improper customization
'of this project. Make certain that any changes you have made to these
'files are valid and bug-free.
'LOGERR_INVALIDARGS -- some parameter to a logging function was invalid or improper
'LOGERR_EXCEEDEDCAPACITY -- the stacking depth of actions has probably been
' exceeded. This most likely means that CommitAction or AbortAction statements
' are missing from your code.
'LOGERR_NOCURRENTACTION -- the logging function you tried to use requires that
' there be a current action, but there was none. Check for a missing NewAction
' statement.
strErrMsg = ResolveResString(resUNEXPECTED)
Case Else
strErrMsg = ResolveResString(resUNEXPECTED)
End Select
If lErrSeverity = LogErrOK Then
' User can select whether or not to continue
iRet = MsgFunc(strErrMsg, vbOKCancel Or vbExclamation, gstrTitle)
If gfNoUserInput Then iRet = vbCancel ' can't continue if silent install.
Select Case iRet
Case vbOK
Case vbCancel
fAbort = True
Case Else
fAbort = True
End Select
Else
' Fatal
MsgFunc strErrMsg, vbOKOnly Or vbExclamation, gstrTitle
fAbort = True
End If
If fAbort Then
ExitSetup frmCopy, gintRET_ABORT
End If
fRecursive = False
End Sub
'-----------------------------------------------------------
' FUNCTION: fWithinAction
'
' Returns TRUE iff there is a current Action
'-----------------------------------------------------------
'
Public Function fWithinAction() As Boolean
fWithinAction = (fDllWithinAction() <> 0)
End Function

55
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/message.frm Normal file
View File

@@ -0,0 +1,55 @@
VERSION 5.00
Begin VB.Form frmMessage
BorderStyle = 3 'Fixed Dialog
ClientHeight = 900
ClientLeft = 1065
ClientTop = 1995
ClientWidth = 5340
ClipControls = 0 'False
ControlBox = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
HasDC = 0 'False
Icon = "message.frx":0000
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
NegotiateMenus = 0 'False
ScaleHeight = 900
ScaleWidth = 5340
ShowInTaskbar = 0 'False
Begin VB.Image imgMsg
Height = 480
Left = 270
Picture = "message.frx":0442
Top = 210
Width = 480
End
Begin VB.Label lblMsg
AutoSize = -1 'True
Caption = "*"
Height = 195
Left = 945
TabIndex = 0
Top = 360
Width = 4110
WordWrap = -1 'True
End
End
Attribute VB_Name = "frmMessage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Form_Load()
SetFormFont Me
End Sub

BIN
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/message.frx Normal file
View File

Binary file not shown.

33
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/modshell.bas Normal file
View File

@@ -0,0 +1,33 @@
Attribute VB_Name = "modShell"
Option Explicit
Public Enum SpecialFolderIDs
sfidDESKTOP = &H0
sfidPROGRAMS = &H2
sfidPERSONAL = &H5
sfidFAVORITES = &H6
sfidSTARTUP = &H7
sfidRECENT = &H8
sfidSENDTO = &H9
sfidSTARTMENU = &HB
sfidDESKTOPDIRECTORY = &H10
sfidNETHOOD = &H13
sfidFONTS = &H14
sfidTEMPLATES = &H15
sfidCOMMON_STARTMENU = &H16
sfidCOMMON_PROGRAMS = &H17
sfidCOMMON_STARTUP = &H18
sfidCOMMON_DESKTOPDIRECTORY = &H19
sfidAPPDATA = &H1A
sfidPRINTHOOD = &H1B
sfidProgramFiles = &H10000
sfidCommonFiles = &H10001
End Enum
Public Declare Function SHGetSpecialFolderLocation Lib "shell32" (ByVal hwndOwner As Long, ByVal nFolder As SpecialFolderIDs, ByRef pIdl As Long) As Long
Public Declare Function SHGetPathFromIDListA Lib "shell32" (ByVal pIdl As Long, ByVal pszPath As String) As Long
Public Declare Function SHGetDesktopFolder Lib "shell32" (ByRef pshf As IVBShellFolder) As Long
Public Declare Function SHGetMalloc Lib "shell32" (ByRef pMalloc As IVBMalloc) As Long
' SHGetSpecialFolderLocation successful rtn val
Public Const NOERROR = 0

162
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/overwrit.frm Normal file
View File

@@ -0,0 +1,162 @@
VERSION 5.00
Begin VB.Form frmOverwrite
BorderStyle = 3 'Fixed Dialog
Caption = "frmOverwrite"
ClientHeight = 3990
ClientLeft = 45
ClientTop = 330
ClientWidth = 5160
ClipControls = 0 'False
HasDC = 0 'False
Icon = "Overwrit.frx":0000
MaxButton = 0 'False
MinButton = 0 'False
NegotiateMenus = 0 'False
ScaleHeight = 3990
ScaleWidth = 5160
ShowInTaskbar = 0 'False
StartUpPosition = 1 'CenterOwner
Begin VB.CommandButton cmdNoAll
Caption = "cmdNoAll"
Height = 375
Left = 3720
TabIndex = 2
Top = 3480
Width = 1315
End
Begin VB.CommandButton cmdNo
Caption = "cmdNo"
Height = 375
Left = 2280
TabIndex = 1
Top = 3480
Width = 1315
End
Begin VB.CommandButton cmdYes
Caption = "cmdYes"
Default = -1 'True
Height = 375
Left = 840
TabIndex = 0
Top = 3480
Width = 1315
End
Begin VB.Label lblVersion
BackStyle = 0 'Transparent
Caption = "lblVersion"
Height = 255
Left = 120
TabIndex = 7
Top = 2280
Width = 4935
End
Begin VB.Label lblDescription
BackStyle = 0 'Transparent
Caption = "lblDescription"
Height = 615
Left = 120
TabIndex = 6
Top = 1560
Width = 4935
End
Begin VB.Label lblFileName
BackStyle = 0 'Transparent
Caption = "lblFileName"
Height = 615
Left = 120
TabIndex = 5
Top = 840
Width = 4935
End
Begin VB.Label lblCopy
BackStyle = 0 'Transparent
Caption = "lblCopy"
Height = 615
Left = 120
TabIndex = 4
Top = 2640
Width = 4935
End
Begin VB.Label lblTopInfo
BackStyle = 0 'Transparent
Caption = "lblTopInfo"
Height = 615
Left = 120
TabIndex = 3
Top = 120
Width = 4935
End
End
Attribute VB_Name = "frmOverwrite"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private msFile As String
Private msDesc As String
Private msVer As String
Private mfFormLoaded As Boolean
Private mfYes As Boolean
Private mfNo As Boolean
Private mfNoToAll As Boolean
Private Sub cmdNo_Click()
mfNo = True
Unload Me
End Sub
Private Sub cmdNoAll_Click()
mfNoToAll = True
Unload Me
End Sub
Private Sub cmdYes_Click()
mfYes = True
Unload Me
End Sub
Private Sub Form_Load()
mfFormLoaded = True
SetFormFont Me
'Load the strings for this form.
Caption = ResolveResString(resOVERWRITEFORM)
lblTopInfo.Caption = ResolveResString(resOVERWRITEINFO)
lblCopy.Caption = ResolveResString(resOVERWRITEKEEP)
cmdYes.Caption = ResolveResString(resOVERYES)
cmdNo.Caption = ResolveResString(resOVERNO)
cmdNoAll.Caption = ResolveResString(resOVERNOTOALL)
lblFileName.Caption = ResolveResString(resOVERWRITEFILE, gstrPIPE1, msFile)
lblDescription.Caption = ResolveResString(resOVERWRITEDESC, gstrPIPE1, msDesc)
lblVersion.Caption = ResolveResString(resOVERWRITEVER, gstrPIPE1, msVer)
SetMousePtr vbNormal
End Sub
'public access to local vars
Public Property Let FileName(sName As String)
msFile = sName
If mfFormLoaded Then lblFileName.Caption = ResolveResString(resOVERWRITEFILE, gstrPIPE1, msFile)
End Property
Public Property Let Description(sDesc As String)
msDesc = sDesc
If mfFormLoaded Then lblDescription.Caption = ResolveResString(resOVERWRITEDESC, gstrPIPE1, msDesc)
End Property
Public Property Let Version(sVer As String)
msVer = sVer
If mfFormLoaded Then lblVersion.Caption = ResolveResString(resOVERWRITEVER, gstrPIPE1, msVer)
End Property
Private Sub Form_Unload(Cancel As Integer)
SetMousePtr vbHourglass
End Sub
Public Property Get ReturnVal() As Byte
'Return 0 for yes
'return 1 for no
'return 2 for no to all
If mfYes Then ReturnVal = owYes
If mfNo Then ReturnVal = owNo
If mfNoToAll Then ReturnVal = owNoToAll
End Property

BIN
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/overwrit.frx Normal file
View File

Binary file not shown.

346
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/path.frm Normal file
View File

@@ -0,0 +1,346 @@
VERSION 5.00
Begin VB.Form frmPath
BorderStyle = 3 'Fixed Dialog
Caption = "#"
ClientHeight = 4710
ClientLeft = 150
ClientTop = 1530
ClientWidth = 5955
ClipControls = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
HasDC = 0 'False
Icon = "path.frx":0000
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
NegotiateMenus = 0 'False
ScaleHeight = 4710
ScaleWidth = 5955
ShowInTaskbar = 0 'False
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "#"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 4170
MaskColor = &H00000000&
TabIndex = 7
Top = 2640
Width = 1560
End
Begin VB.CommandButton cmdOK
Caption = "#"
Default = -1 'True
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 4170
MaskColor = &H00000000&
TabIndex = 6
Top = 1890
Width = 1560
End
Begin VB.DriveListBox drvDrives
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 216
TabIndex = 5
Top = 4140
Width = 3510
End
Begin VB.DirListBox dirDirs
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1605
Left = 204
TabIndex = 3
Top = 1896
Width = 3510
End
Begin VB.TextBox txtPath
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 288
Left = 204
MaxLength = 240
TabIndex = 1
Top = 1056
Width = 5532
End
Begin VB.Label lblDrives
AutoSize = -1 'True
Caption = "#"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 210
TabIndex = 4
Top = 3870
Width = 105
End
Begin VB.Label lblDirs
AutoSize = -1 'True
Caption = "#"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 210
TabIndex = 2
Top = 1590
Width = 105
End
Begin VB.Label lblPath
AutoSize = -1 'True
Caption = "#"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 210
TabIndex = 0
Top = 750
Width = 105
End
Begin VB.Label lblPrompt
AutoSize = -1 'True
Caption = "*"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 192
Left = 204
TabIndex = 8
Top = 204
Width = 5532
WordWrap = -1 'True
End
End
Attribute VB_Name = "frmPath"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mfMustExist As Integer
Private mfCancelExit As Integer
Private mfSinkEvents As Boolean
Private Sub cmdCancel_Click()
If mfCancelExit Then
ExitSetup Me, gintRET_EXIT
Else
gintRetVal = gintRET_CANCEL
Unload Me
End If
End Sub
Private Sub cmdOK_Click()
Dim strPathName As String
Dim strMsg As String
Dim intRet As Integer
SetMousePtr vbHourglass
strPathName = ResolveDir(txtPath.Text, mfMustExist, True)
If Len(strPathName) > 0 Then
' Avoid Option Compare Text and use explicit UCase comparisons because there
' is a Unicode character (&H818F) which is equal to a path separator when
' using Option Compare Text.
If UCase$(strPathName) <> UCase$(gstrDestDir) Then
If Not DirExists(strPathName) Then
strMsg = ResolveResString(resDESTDIR) & vbLf & vbLf & strPathName
strMsg = strMsg & vbLf & vbLf & ResolveResString(resCREATE)
intRet = MsgFunc(strMsg, vbYesNo Or vbQuestion, gstrTitle)
If gfNoUserInput Then
ExitSetup Me, gintRET_FATAL
End If
If intRet = vbNo Then
txtPath.SetFocus
SetMousePtr vbDefault
Exit Sub
End If
End If
If Not IsValidDestDir(strPathName) Then
txtPath.SetFocus
SetMousePtr vbDefault
Exit Sub
End If
End If
frmSetup1.Tag = strPathName
gintRetVal = gintRET_CONT
Unload Me
Else
txtPath.SetFocus
End If
SetMousePtr vbDefault
End Sub
Private Sub dirDirs_Change()
If mfSinkEvents Then
mfSinkEvents = False
txtPath.Text = dirDirs.Path
drvDrives.Drive = dirDirs.Path
mfSinkEvents = True
End If
End Sub
Private Sub drvDrives_Change()
Static strOldDrive As String
Dim strDrive As String
If mfSinkEvents Then
mfSinkEvents = False
If GetDrive(drvDrives.Drive, strDrive) Then
If CheckDrive(strDrive, Caption) Then
strOldDrive = strDrive
dirDirs.Path = strDrive
txtPath.Text = dirDirs.Path
Else
drvDrives.Drive = strOldDrive
End If
End If
mfSinkEvents = True
End If
End Sub
Private Sub Form_Load()
Dim strDrive As String
On Error Resume Next
mfSinkEvents = False
SetMousePtr vbHourglass
SetFormFont Me
cmdOK.Caption = ResolveResString(resBTNOK)
lblDrives.Caption = ResolveResString(resLBLDRIVES)
lblDirs.Caption = ResolveResString(resLBLDIRS)
lblPath.Caption = ResolveResString(resLBLPATH)
Caption = ResolveResString(resCHANGEDIR)
lblPrompt.Caption = ResolveResString(resDESTPROMPT)
cmdCancel.Caption = ResolveResString(resBTNCANCEL)
mfCancelExit = False
dirDirs.Path = gstrDestDir
If Err.Number <> 0 Then
'Next try root of destination drive
If GetDrive(gstrDestDir, strDrive) Then
Err.Clear
dirDirs.Path = strDrive
End If
End If
If Err.Number <> 0 Then
If GetDrive(App.Path, strDrive) Then
dirDirs.Path = strDrive
End If
End If
GetDrive dirDirs.Path, strDrive
drvDrives.Drive = strDrive
mfSinkEvents = True
'Init txtPath.Text to gstrDestDir even if this
' directory does not (yet) exist.
txtPath.Text = gstrDestDir
mfMustExist = False
SetMousePtr vbDefault
CenterForm Me
'Highlight all of txtPath's text so that typing immediately overwrites it
txtPath.SelStart = 0
txtPath.SelLength = Len(txtPath.Text)
Err.Clear
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode <> vbFormCode Then
If mfCancelExit Then
ExitSetup Me, gintRET_EXIT
Cancel = True
Else
gintRetVal = gintRET_CANCEL
Unload Me
End If
End If
End Sub

BIN
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/path.frx Normal file
View File

Binary file not shown.

168
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/registry.bas Normal file
View File

@@ -0,0 +1,168 @@
Attribute VB_Name = "modRegistry"
Option Explicit
Option Compare Text
Private Const gsSLASH_BACKWARD As String = "\"
''Registry API Declarations...
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, _
ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, _
ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, ByRef phkResult As Long, _
ByRef lpdwDisposition As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32" Alias "RegDeleteKeyA" _
(ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32" Alias "RegEnumValueA" _
(ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
ByRef lpcbValueName As Long, ByVal lpReserved As Long, ByRef lpType As Long, _
ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" _
(ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As Long, _
ByVal lpcbClass As Long, lpftLastWriteTime As FileTime) As Long
''Reg Data Types...
Private Const REG_NONE = 0 ' No value type
Private Const REG_SZ = 1 ' Unicode nul terminated string
Private Const REG_EXPAND_SZ = 2 ' Unicode nul terminated string
Private Const REG_BINARY = 3 ' Free form binary
Private Const REG_DWORD = 4 ' 32-bit number
Private Const REG_DWORD_LITTLE_ENDIAN = 4 ' 32-bit number (same as REG_DWORD)
Private Const REG_DWORD_BIG_ENDIAN = 5 ' 32-bit number
Private Const REG_LINK = 6 ' Symbolic Link (unicode)
Private Const REG_MULTI_SZ = 7 ' Multiple Unicode strings
Private Const REG_RESOURCE_LIST = 8 ' Resource list in the resource map
Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9 ' Resource list in the hardware description
Private Const REG_RESOURCE_REQUIREMENTS_LIST = 10
''Reg Create Type Values...
Private Const REG_OPTION_RESERVED = 0 ' Parameter is reserved
Private Const REG_OPTION_NON_VOLATILE = 0 ' Key is preserved when system is rebooted
Private Const REG_OPTION_VOLATILE = 1 ' Key is not preserved when system is rebooted
Private Const REG_OPTION_CREATE_LINK = 2 ' Created key is a symbolic link
Private Const REG_OPTION_BACKUP_RESTORE = 4 ' open for backup or restore
''Reg Key Security Options...
Private Const READ_CONTROL = &H20000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
Private Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
Private Const KEY_EXECUTE = KEY_READ
Private Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE _
+ KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS _
+ KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
''Return Value...
Private Const ERROR_SUCCESS = 0
Private Const ERROR_ACCESS_DENIED = 5&
Private Const ERROR_NO_MORE_ITEMS = 259&
''Hierarchy separator
Private Const KeySeparator As String = "\"
''Registry Security Attributes TYPE...
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type
Private Type FileTime
dwLowDateTime As Long
dwHighDateTime As Long
End Type
''Reg Key ROOT Types...
Public Enum REGToolRootTypes
HK_CLASSES_ROOT = &H80000000
HK_CURRENT_USER = &H80000001
HK_LOCAL_MACHINE = &H80000002
HK_USERS = &H80000003
HK_PERFORMANCE_DATA = &H80000004
HK_CURRENT_CONFIG = &H80000005
HK_DYN_DATA = &H80000006
End Enum
'Retrieves a key value.
Public Function GetKeyValue(ByVal KeyRoot As REGToolRootTypes, KeyName As String, ValueName As String, ByRef ValueData As String) As Boolean
Dim i As Long ' Loop Counter
Dim hKey As Long ' Handle To An Open Registry Key
Dim KeyValType As Long ' Data Type Of A Registry Key
Dim sTmp As String ' Tempory Storage For A Registry Key Value
Dim sReturn As String
Dim KeyValSize As Long ' Size Of Registry Key Variable
Dim sByte As String
If ValidKeyName(KeyName) Then
On Error GoTo LocalErr
' Open registry key under KeyRoot
Attempt RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
sTmp = String$(1024, 0) ' Allocate Variable Space
KeyValSize = 1024 ' Mark Variable Size
' Retrieve Registry Key Value...
Attempt RegQueryValueEx(hKey, ValueName, 0, _
KeyValType, sTmp, KeyValSize) ' Get/Create Key Value
If (Asc(Mid$(sTmp, KeyValSize, 1)) = 0) Then ' Win95 Adds Null Terminated String...
sTmp = Left$(sTmp, KeyValSize - 1) ' Null Found, Extract From String
Else ' WinNT Does NOT Null Terminate String...
sTmp = Left$(sTmp, KeyValSize) ' Null Not Found, Extract String Only
End If
' Determine Key Value Type For Conversion...
Select Case KeyValType ' Search Data Types...
Case REG_SZ ' String Registry Key Data Type
sReturn = sTmp '(Do nothing)
Case REG_DWORD ' Double Word Registry Key Data Type
For i = Len(sTmp) To 1 Step -1 ' Convert Each Bit
sByte = Hex(Asc(Mid$(sTmp, i, 1)))
Do Until Len(sByte) = 2
sByte = "0" & sByte
Loop
sReturn = sReturn & sByte ' Build Value Char. By Char.
Next
sReturn = Format$("&h" + sReturn) ' Convert Double Word To String
End Select
GetKeyValue = True
ValueData = sReturn
LocalErr:
On Error Resume Next
RegCloseKey hKey
End If
End Function
Private Sub Attempt(rc As Long)
If (rc <> ERROR_SUCCESS) Then
Err.Raise 5
End If
End Sub
Private Function ValidKeyName(KeyName As String) As Boolean
'A key name is invalid if it begins or ends with \ or contains \\
If Left$(KeyName, 1) <> gsSLASH_BACKWARD Then
If Right$(KeyName, 1) <> gsSLASH_BACKWARD Then
If InStr(KeyName, gsSLASH_BACKWARD & gsSLASH_BACKWARD) = 0 Then
ValidKeyName = True
End If
End If
End If
End Function

486
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/serverdt.frm Normal file
View File

@@ -0,0 +1,486 @@
VERSION 5.00
Begin VB.Form frmRemoteServerDetails
BorderStyle = 3 'Fixed Dialog
Caption = "#"
ClientHeight = 4545
ClientLeft = 3195
ClientTop = 2400
ClientWidth = 7800
ClipControls = 0 'False
ControlBox = 0 'False
HasDC = 0 'False
Icon = "serverdt.frx":0000
MaxButton = 0 'False
MinButton = 0 'False
NegotiateMenus = 0 'False
ScaleHeight = 4545
ScaleWidth = 7800
ShowInTaskbar = 0 'False
Begin VB.CommandButton cmdCancel
Caption = "#"
Height = 375
Left = 5580
MaskColor = &H00000000&
TabIndex = 5
Top = 3930
Width = 1935
End
Begin VB.CommandButton cmdOK
Caption = "#"
Default = -1 'True
Enabled = 0 'False
Height = 375
Left = 3540
MaskColor = &H00000000&
TabIndex = 4
Top = 3930
Width = 1935
End
Begin VB.ComboBox cboNetworkProtocol
Height = 300
Left = 2400
Style = 2 'Dropdown List
TabIndex = 3
Top = 3165
Width = 5100
End
Begin VB.TextBox txtNetworkAddress
Height = 300
Left = 2400
MaxLength = 128
TabIndex = 1
Top = 2535
Width = 5100
End
Begin VB.Frame Frame1
Height = 555
Left = 225
TabIndex = 7
Top = 1395
Width = 7290
Begin VB.Label lblServerName
Alignment = 2 'Center
AutoSize = -1 'True
Caption = "#"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 135
TabIndex = 8
Top = 240
Width = 7020
WordWrap = -1 'True
End
End
Begin VB.Label lblNetworkProtocol
AutoSize = -1 'True
Caption = "#"
Height = 195
Left = 210
TabIndex = 2
Top = 3165
Width = 2100
WordWrap = -1 'True
End
Begin VB.Label lblNetworkAddress
AutoSize = -1 'True
Caption = "#"
Height = 195
Left = 225
TabIndex = 0
Top = 2535
Width = 2100
WordWrap = -1 'True
End
Begin VB.Label lblRemoteServerDetails
AutoSize = -1 'True
Caption = "#"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 360
TabIndex = 6
Top = 360
Width = 7020
WordWrap = -1 'True
End
End
Attribute VB_Name = "frmRemoteServerDetails"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mfNetworkAddressSpecified As Boolean
Private mfNetworkProtocolSpecified As Boolean
Private mfDCOM As Boolean
Private Declare Function RpcNetworkIsProtseqValid Lib "rpcrt4.dll" Alias "RpcNetworkIsProtseqValidA" (ByVal strProtseq As String) As Long
'Determines whether a given protocol sequence is supported and available on this machine
Private Function fIsProtocolSeqSupported(ByVal strProto As String, ByVal strProtoFriendlyName) As Boolean
Const RPC_S_OK = 0&
Const RPC_S_PROTSEQ_NOT_SUPPORTED = 1703&
Const RPC_S_INVALID_RPC_PROTSEQ = 1704&
Dim rcps As Long
Static fUnexpectedErr As Boolean
On Error Resume Next
rcps = RpcNetworkIsProtseqValid(strProto)
Select Case rcps
Case RPC_S_OK
fIsProtocolSeqSupported = True
Case RPC_S_PROTSEQ_NOT_SUPPORTED
LogNote ResolveResString(resNOTEPROTOSEQNOTSUPPORTED, gstrPIPE1, strProto, gstrPIPE2, strProtoFriendlyName)
Case RPC_S_INVALID_RPC_PROTSEQ
LogWarning ResolveResString(resNOTEPROTOSEQINVALID, gstrPIPE1, strProto, gstrPIPE2, strProtoFriendlyName)
Case Else
If Not fUnexpectedErr Then
MsgWarning ResolveResString(resPROTOSEQUNEXPECTEDERR), vbOKOnly Or vbInformation, gstrTitle
If gfNoUserInput Then
'
' This is probably redundant since this form should never
' be shown if we are running in silent or SMS mode.
'
ExitSetup frmRemoteServerDetails, gintRET_FATAL
End If
fUnexpectedErr = True
End If
End Select
End Function
Private Sub cboNetworkProtocol_Click()
cmdOK.Enabled = fValid()
End Sub
Private Sub cmdCancel_Click()
ExitSetup frmRemoteServerDetails, gintRET_EXIT
End Sub
Private Sub cmdOK_Click()
Hide
End Sub
Private Sub Form_Load()
Dim fMoveControlsUp As Boolean 'Whether or not to move controls up to fill in an empty space
Dim yTopCutoff As Integer 'We will move all controls lower down than this y value
Dim yDiff As Integer
Dim c As Control
SetFormFont Me
Caption = ResolveResString(resREMOTESERVERDETAILSTITLE)
lblRemoteServerDetails.Caption = ResolveResString(resREMOTESERVERDETAILSLBL)
lblNetworkAddress.Caption = ResolveResString(resNETWORKADDRESS)
lblNetworkProtocol.Caption = ResolveResString(resNETWORKPROTOCOL)
cmdOK.Caption = ResolveResString(resOK)
cmdCancel.Caption = ResolveResString(resCANCEL)
'
' We don't care about protocols if this is DCOM.
'
If Not mfDCOM Then
FillInProtocols
End If
'Now we selectively turn on/off the available controls depending on how
' much information we need from the user.
If mfNetworkAddressSpecified Then
'The network address has already been filled in, so we can hide this
' control and move all the other controls up
txtNetworkAddress.Visible = False
lblNetworkAddress.Visible = False
fMoveControlsUp = True
yTopCutoff = txtNetworkAddress.Top
ElseIf mfNetworkProtocolSpecified Or mfDCOM Then
'The network protocol has already been filled in, so we can hide this
' control and move all the other controls up
cboNetworkProtocol.Visible = False
lblNetworkProtocol.Visible = False
fMoveControlsUp = True
yTopCutoff = cboNetworkProtocol.Top
End If
If fMoveControlsUp Then
'Find out how much to move the controls up
yDiff = cboNetworkProtocol.Top - txtNetworkAddress.Top
For Each c In Controls
If c.Top > yTopCutoff Then
c.Top = c.Top - yDiff
End If
Next c
'Finally, shrink the form
Height = Height - yDiff
End If
'Center the form
Top = (Screen.Height - Height) \ 2
Left = (Screen.Width - Width) \ 2
End Sub
'-----------------------------------------------------------
' SUB: GetServerDetails
'
' Requests any missing information about a remote server from
' the user.
'
' Input:
' [strRegFile] - the name of the remote registration file
' [strNetworkAddress] - the network address, if known
' [strNetworkProtocol] - the network protocol, if known
' [fDCOM] - if true, this component is being accessed via
' distributed com and not Remote automation. In
' this case, we don't need the network protocol or
' Authentication level.
'
' Ouput:
' [strNetworkAddress] - the network address either passed
' in or obtained from the user
' [strNetworkProtocol] - the network protocol either passed
' in or obtained from the user
'-----------------------------------------------------------
'
Public Sub GetServerDetails( _
ByVal strRegFile As String, _
strNetworkAddress As String, _
strNetworkProtocol As String, _
fDCOM As Boolean _
)
Dim i As Integer
Dim strServerName As String
'See if anything is missing
mfNetworkAddressSpecified = (Len(strNetworkAddress) > 0)
mfNetworkProtocolSpecified = (Len(strNetworkProtocol) > 0)
mfDCOM = fDCOM
If mfNetworkAddressSpecified And (mfNetworkProtocolSpecified Or mfDCOM) Then
'Both the network address and protocol sequence have already
'been specified in SETUP.LST. There is no need to ask the
'user for more information.
'However, we do need to check that the protocol sequence specified
'in SETUP.LST is actually installed and available on this machine
'(Remote Automation only).
'
If Not mfDCOM Then
CheckSpecifiedProtocolSequence strNetworkProtocol, strGetServerName(strRegFile)
End If
Exit Sub
End If
strServerName = strGetServerName(strRegFile)
Load Me
lblServerName.Caption = strServerName
If Not gfNoUserInput Then
'
' Show the form and extract necessary information from the user
'
Show vbModal
Else
'
' Since this is silent, simply accept the first one on
' the list.
'
' Note that we know there is at least 1 protocol in the
' list or else the program would have aborted in
' the Form_Load code when it called FillInProtocols().
'
cboNetworkProtocol.ListIndex = 0
End If
If mfNetworkProtocolSpecified And Not mfDCOM Then
'The network protocol sequence had already been specified
'in SETUP.LST. We need to check that the protocol sequence specified
'in SETUP.LST is actually installed and available on this machine
'(32-bit only).
CheckSpecifiedProtocolSequence strNetworkProtocol, strGetServerName(strRegFile)
End If
If Not mfNetworkAddressSpecified Then
strNetworkAddress = txtNetworkAddress
End If
If Not mfNetworkProtocolSpecified And Not mfDCOM Then
strNetworkProtocol = gProtocol(cboNetworkProtocol.ListIndex + 1).strName
End If
Unload Me
End Sub
'-----------------------------------------------------------
' SUB: FillInProtocols
'
' Fills in the protocol combo with the available protocols from
' setup.lst
'-----------------------------------------------------------
Private Sub FillInProtocols()
Dim i As Integer
Dim fSuccessReading As Boolean
Dim strMsg As String
cboNetworkProtocol.Clear
fSuccessReading = ReadProtocols(gstrSetupInfoFile, gstrINI_SETUP)
If Not fSuccessReading Or gcProtocols <= 0 Then
MsgError ResolveResString(resNOPROTOCOLSINSETUPLST), vbExclamation Or vbOKOnly, gstrTitle
ExitSetup frmRemoteServerDetails, gintRET_FATAL
End If
For i = 1 To gcProtocols
If fIsProtocolSeqSupported(gProtocol(i).strName, gProtocol(i).strFriendlyName) Then
cboNetworkProtocol.AddItem gProtocol(i).strFriendlyName
End If
Next i
If cboNetworkProtocol.ListCount > 0 Then
'We were successful in finding at least one protocol available on this machine
Exit Sub
End If
'None of the protocols specified in SETUP.LST are available on this machine. We need
'to let the user know what's wrong, including which protocol(s) were expected.
MsgError ResolveResString(resNOPROTOCOLSSUPPORTED1), vbExclamation Or vbOKOnly, gstrTitle
'
' Don't log the rest if this in SMS. Ok for silent mode since
' silent can take more than 255 characters.
'
#If SMS Then
If Not gfSMS Then
#End If
strMsg = ResolveResString(resNOPROTOCOLSSUPPORTED2) & vbLf
For i = 1 To gcProtocols
strMsg = strMsg & vbLf & vbTab & gProtocol(i).strFriendlyName
Next i
MsgError strMsg, vbExclamation Or vbOKOnly, gstrTitle
#If SMS Then
End If
#End If
ExitSetup frmRemoteServerDetails, gintRET_FATAL
End Sub
'-----------------------------------------------------------
' SUB: strGetServerName
'
' Given a remote server registration file, retrieves the
' friendly name of the server
'-----------------------------------------------------------
Private Function strGetServerName(ByVal strRegFilename As String) As String
Const strKey = "AppDescription="
Dim strLine As String
Dim iFile As Integer
Dim strName As String
On Error GoTo DoErr
'This will have to do if we can't find the friendly name
SeparatePathAndFileName strRegFilename, , strGetServerName
iFile = FreeFile
Open strRegFilename For Input Access Read Lock Read Write As #iFile
Do Until EOF(iFile)
Line Input #iFile, strLine
If InStr(1, UCase$(strLine), UCase$(strKey)) = 1 Then
'We've found the line with the friendly server name
strName = Mid$(strLine, Len(strKey) + 1)
If Len(strName) > 0 Then
strGetServerName = strName
End If
Exit Do
End If
Loop
Close iFile
Exit Function
DoErr:
strGetServerName = vbNullString
End Function
Private Sub txtNetworkAddress_Change()
cmdOK.Enabled = fValid()
End Sub
'Returns True iff the inputs are valid
Private Function fValid() As Boolean
fValid = True
'
' If this is dcom, we don't care about the network protocol.
'
If Not mfDCOM Then
If Not mfNetworkProtocolSpecified Then
If cboNetworkProtocol.ListIndex < 0 Then
fValid = False
Exit Function
End If
End If
End If
If Not mfNetworkAddressSpecified Then
If Len(txtNetworkAddress.Text) = 0 Then
fValid = False
End If
End If
End Function
Private Sub CheckSpecifiedProtocolSequence(ByVal strNetworkProtocol As String, ByVal strFriendlyServerName As String)
'Attempt to find the friendly name of this protocol from the list in SETUP.LST
Dim fSuccessReading As Boolean
Dim strFriendlyName As String
Dim i As Integer
strFriendlyName = strNetworkProtocol 'This will have to do if we can't find anything better
fSuccessReading = ReadProtocols(gstrSetupInfoFile, gstrINI_SETUP)
If fSuccessReading And gcProtocols > 0 Then
For i = 1 To gcProtocols
If UCase$(gProtocol(i).strName) = UCase$(strNetworkProtocol) Then
strFriendlyName = gProtocol(i).strFriendlyName
Exit For
End If
Next i
End If
'Now check to see if this protocol is available
If fIsProtocolSeqSupported(strNetworkProtocol, strFriendlyName) Then
'OK
Exit Sub
Else
'Nope, not supported. Give an informational message about what to do, then continue with setup.
Retry:
If gfNoUserInput Or MsgError( _
ResolveResString(resSELECTEDPROTONOTSUPPORTED, gstrPIPE1, strFriendlyServerName, gstrPIPE2, strFriendlyName), _
vbInformation Or vbOKCancel, _
gstrTitle) _
= vbCancel Then
'
' The user chose cancel. Give them a chance to exit (if this isn't a silent or sms install;
' otherwise any call to ExitSetup is deemed fatal.
'
ExitSetup frmRemoteServerDetails, gintRET_EXIT
GoTo Retry
Else
'The user chose OK. Continue with setup.
Exit Sub
End If
End If
End Sub

BIN
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/serverdt.frx Normal file
View File

Binary file not shown.

5374
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/setup1.bas Normal file
View File

File diff suppressed because it is too large Load Diff

731
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/setup1.frm Normal file
View File

@@ -0,0 +1,731 @@
VERSION 5.00
Begin VB.Form frmSetup1
AutoRedraw = -1 'True
BackColor = &H00400000&
BorderStyle = 0 'None
ClientHeight = 1770
ClientLeft = 225
ClientTop = 1590
ClientWidth = 7950
ClipControls = 0 'False
DrawStyle = 5 'Transparent
FillStyle = 0 'Solid
BeginProperty Font
Name = "Times New Roman"
Size = 24
Charset = 0
Weight = 700
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
HasDC = 0 'False
Icon = "setup1.frx":0000
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
NegotiateMenus = 0 'False
PaletteMode = 1 'UseZOrder
ScaleHeight = 118
ScaleMode = 3 'Pixel
ScaleWidth = 530
WindowState = 2 'Maximized
Begin VB.Label lblModify
AutoSize = -1 'True
BorderStyle = 1 'Fixed Single
Caption = $"setup1.frx":0442
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 450
Left = 15
TabIndex = 1
Top = 15
Visible = 0 'False
Width = 7860
WordWrap = -1 'True
End
Begin VB.Label lblDDE
AutoSize = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "This label is used for DDE connection to the Program Manager"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 15
TabIndex = 0
Top = 1515
Visible = 0 'False
Width = 4485
End
End
Attribute VB_Name = "frmSetup1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'
' Can't put this is a resource because it indicated resource load failure, must localize separately
'
Private Const mstrRESOURCELOADFAIL$ = "An error occurred while initializing string resources used by Setup."
'-----------------------------------------------------------
' SUB: DrawBackGround
'
' Draws the 'blue wash' screen and prints the 'shadowed'
' app setup title
'-----------------------------------------------------------
'
Private Sub DrawBackGround()
Const intBLUESTART% = 255
Const intBLUEEND% = 0
Const intBANDHEIGHT% = 2
Const intSHADOWSTART% = 8
Const intSHADOWCOLOR% = 0
Const intTEXTSTART% = 4
Const intTEXTCOLOR% = 15
Const intRed% = 1
Const intGreen% = 2
Const intBlue% = 4
Const intBackRed% = 8
Const intBackGreen% = 16
Const intBackBlue% = 32
Dim sngBlueCur As Single
Dim sngBlueStep As Single
Dim intFormHeight As Integer
Dim intFormWidth As Integer
Dim intY As Integer
Dim iColor As Integer
Dim iRed As Single, iBlue As Single, iGreen As Single
'
'Get system values for height and width
'
intFormHeight = ScaleHeight
intFormWidth = ScaleWidth
If Len(ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_COLOR)) = 0 Then
iColor = intBlue
Else
iColor = CInt(ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_COLOR))
End If
'Calculate step size and blue start value
'
sngBlueStep = intBANDHEIGHT * (intBLUEEND - intBLUESTART) / intFormHeight
sngBlueCur = intBLUESTART
'
'Paint blue screen
'
For intY = 0 To intFormHeight Step intBANDHEIGHT
If iColor And intBlue Then iBlue = sngBlueCur
If iColor And intRed Then iRed = sngBlueCur
If iColor And intGreen Then iGreen = sngBlueCur
If iColor And intBackBlue Then iBlue = 255 - sngBlueCur
If iColor And intBackRed Then iRed = 255 - sngBlueCur
If iColor And intBackGreen Then iGreen = 255 - sngBlueCur
Line (-1, intY - 1)-(intFormWidth, intY + intBANDHEIGHT), RGB(iRed, iGreen, iBlue), BF
sngBlueCur = sngBlueCur + sngBlueStep
Next intY
'
'Print 'shadowed' appname
'
CurrentX = intSHADOWSTART
CurrentY = intSHADOWSTART
ForeColor = QBColor(intSHADOWCOLOR)
Print Caption
CurrentX = intTEXTSTART
CurrentY = intTEXTSTART
ForeColor = QBColor(intTEXTCOLOR)
Print Caption
End Sub
Private Sub Form_Load()
'
' Most of the work for Setup1 takes place in Form_Load()
' and is mostly driven by the information found in the
' SETUP.LST file. To customize the Setup1 functionality,
' you will generally want to modify SETUP.LST.
' Particularly, information regarding the files you are
' installing is all stored in SETUP.LST. Exceptions include
' the Remote Automation files RacMgr32.Exe and AutMgr32.Exe
' and special redistributable packages such as mdac_typ.exe.
' These require special handling below.
'
' Some customization can also be done by editing the code
' below in Form_Load or in other parts of this program.
' Places that are more likely to need customization are
' documented with suggestions and examples in the code.
'
'
'Uncomment these three lines for debugging. To debug:
'1) Rebuild Setup1.exe and rebuild the cab file
' to include the new Setup1.exe.
'2) Run setup.exe against the new cab
'3) When the message box appears, open the Setup1 project
' in VB, paste the command line from the clipboard into the
' Project/Properties/Make/Command Line Arguments field.
'4) F5 in VB.
'
'Clipboard.Clear
'Clipboard.SetText Command$
'MsgBox Command$
Const fDefCreateGroupUnderWin95 = False
Dim strGroupName As String 'Name of Program Group
Dim oFont As StdFont
Dim lChar As Long
Dim cIcons As Integer ' Count of how many icons are required.
Dim cGroups As Integer ' Count of how many groups are required.
Dim fCreateGroup As Boolean
Dim iLoop As Integer
Dim sUCASEStartMenuKey As String
Dim sUCASEProgramsMenuKey As String
Dim sGroup As String
Dim strRemAutGroupName As String
Dim strPerAppPath As String
Dim iRet As Integer
gfRegDAO = False
On Error GoTo MainError
SetFormFont Me
'All the controls and the form are sharing the
'same font object, so create a new font object
'for the form so that the appearance of all the
'controls are not changed also
Set oFont = New StdFont
With oFont
.Size = 24
.Bold = True
.Italic = True
.Charset = lblModify.Font.Charset
.Name = lblModify.Font.Name
End With
Set Font = oFont
'
'Initialize string resources used by global vars and forms/controls
'
GetStrings
'
'Get Windows, Windows\Fonts, and Windows\System directories
'
gstrWinDir = GetWindowsDir()
gstrWinSysDir = GetWindowsSysDir()
gstrFontDir = GetWindowsFontDir()
'
' If the Windows System directory is a subdirectory of the
' Windows directory, the proper place for installation of
' files specified in the setup.lst as $(WinSysDest) is always
' the Windows \System directory. If the Windows \System
' directory is *not* a subdirectory of the Windows directory,
' then the user is running a shared version of Windows. In
' this case, if the user does not have write access to the
' shared system directory, we change the system files
' destination to the windows directory
'
' Avoid Option Compare Text and use explicit UCase comparisons because there
' is a Unicode character (&H818F) which is equal to a path separator when
' using Option Compare Text.
If InStr(UCase$(gstrWinSysDir), UCase$(gstrWinDir)) <> 1 Then
If Not WriteAccess(gstrWinSysDir) Then
gstrWinSysDir = gstrWinDir
End If
End If
'
' The command-line arguments must be processed as early
' as possible, because without them it is impossible to
' call the app removal program to clean up after an aborted
' setup.
'
#If SMS Then
ProcessCommandLine Command$, gfSilent, gstrSilentLog, gfSMS, gstrMIFFile, gstrSrcPath, gstrAppRemovalLog, gstrAppRemovalEXE
gfNoUserInput = (gfSilent Or gfSMS)
#Else
ProcessCommandLine Command$, gfSilent, gstrSilentLog, gstrSrcPath, gstrAppRemovalLog, gstrAppRemovalEXE
gfNoUserInput = gfSilent
#End If
AddDirSep gstrSrcPath
'
' The Setup Bootstrapper (SETUP.EXE) copies SETUP1.EXE and SETUP.LST to
' the end user's windows directory. Information required for setup such
' as setup flags and fileinfo is read from the copy of SETUP.LST found in
' that directory.
'
gstrSetupInfoFile = gstrWinDir & gstrFILE_SETUP
'Get the Appname (this will be shown on the blue wash screen)
gstrAppName = ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_APPNAME)
gintCabs = CInt(ReadIniFile(gstrSetupInfoFile, gstrINI_BOOT, gstrINI_CABS))
If Len(gstrAppName) = 0 Then
MsgError ResolveResString(resNOSETUPLST), vbOKOnly Or vbCritical, gstrSETMSG
gstrTitle = ResolveResString(resSETUP, gstrPIPE1, gstrAppName)
ExitSetup Me, gintRET_FATAL
End If
gstrAppExe = ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_APPEXE)
gstrTitle = ResolveResString(resSETUP, gstrPIPE1, gstrAppName)
If gfSilent Then LogSilentMsg gstrTitle & vbCrLf
'Get a temporary directory to use
gsTEMPDIR = String$(255, 0)
lChar = GetTempPath(255, gsTEMPDIR)
gsTEMPDIR = Left$(gsTEMPDIR, lChar)
AddDirSep gsTEMPDIR
gsTEMPDIR = gsTEMPDIR & ReadIniFile(gstrSetupInfoFile, gstrINI_BOOT, gsINI_TEMPDIR)
AddDirSep gsTEMPDIR
'
' Get the name of the CAB
'
gsCABFULLNAME = gstrWinDir & ReadIniFile(gstrSetupInfoFile, gstrINI_BOOT, gstrINI_CABNAME)
'
' Display the background "blue-wash" setup screen as soon as we get the title
'
ShowMainForm
'
' Display the welcome dialog
'
ShowWelcomeForm
'
' If this flag is set, then the default destination directory is used
' without question, and the user is never given a chance to change it.
' This is intended for installing an .EXE/.DLL as a component rather
' than as an application in an application directory. In this case,
' having an application directory does not really make sense.
'
If ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_FORCEUSEDEFDEST) = "1" Then
gfForceUseDefDest = True
End If
'
' Read default destination directory. If the name specified conflicts
' with the name of a file, then prompt for a new default directory
'
gstrDestDir = ResolveDestDir(ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_APPDIR))
Do While FileExists(gstrDestDir) Or Len(gstrDestDir) = 0
If MsgError(ResolveResString(resBADDEFDIR), vbOKCancel Or vbQuestion, gstrSETMSG) = vbCancel Then
ExitSetup Me, gintRET_FATAL
End If
If gfNoUserInput Then
ExitSetup Me, gintRET_FATAL
Else
ShowPathDialog
End If
Loop
'
' Ensure a trailing backslash on the destination directory
'
AddDirSep gstrDestDir
Do
'
' Display install button and default directory. The user
' can change the destination directory from here.
'
ShowBeginForm
'
' This would be a good place to display an option dialog, allowing the user
' a chance to select installation options: samples, docs, help files, etc.
' Results of this dialog would be checked in the loop below
'
'ShowOptionsDialog (Function you could write with option check boxes, etc.)
'
'
' Initialize "table" of drives used and disk space array
'
InitDiskInfo
SetMousePtr vbHourglass
ShowStaticMessageDialog ResolveResString(resDISKSPACE)
'
' For every section in SETUP.LST that will be installed, call CalcDiskSpace
' with the name of the section
'
CalcDiskSpace gstrINI_FILES
'CalcDiskSpace "MySection"
'CalcDiskSpace "MyOtherSection"
'
' If you created an options dialog, you need to check results here to
' determine whether disk space needs to be calculated (if the option(s)
' will be installed)
'
'If chkInstallSamples.Value then
' CalcDiskSpace "Samples"
'End If
'
HideStaticMessageDialog
SetMousePtr vbDefault
'
' After all CalcDiskSpace calls are complete, call CheckDiskSpace to check
' the results and display warning form (if necessary). If the user wants
' to try another destination directory (or cleanup and retry) then
' CheckDiskSpace will return False
'
Loop Until CheckDiskSpace()
'
' Starts logging to the setup logfile (will be used for application removal)
'
EnableLogging gstrAppRemovalLog
'
' Should go ahead and force the application directory to be created,
' since the application removal logfile will later be copied there.
'
MakePath gstrDestDir, False 'User may not ignore errors here
'
' Create the main program group if one is wanted/needed.
'
'
' If fDefCreateGroupUnderWin95 is set to False (this is the default), then no
' program group will be created under Win95 unless it is absolutely necessary.
'
' By default under Windows 95, no group should be created, and the
' single program icon should be placed directly under the
' Start>Programs menu (unless there are other, user-defined icons to create
'
'
' Read through the SETUP.LST file and determine how many icons are needed.
'
cIcons = CountIcons(gsICONGROUP)
cGroups = CountGroups(gsICONGROUP)
'
' Do the same for other sections in SETUP.LST if you've added your own.
'
'cIcons = cIcons + CountIcons("MySection")
'cIcons = cIcons + CountIcons("MyOtherSection")
'
' The following variable determines whether or not we create a program
' group for icons. It is controlled by fNoGroupUnderWin95,
' fAdditionalIcons, and FTreatAsWin95().
'
fCreateGroup = (cGroups > 0)
If fCreateGroup Then
For iLoop = 0 To cGroups - 1
sGroup = GetGroup(gsICONGROUP, iLoop)
strGroupName = vbNullString
Select Case UCase$(sGroup)
Case UCase$(gsSTARTMENUKEY), UCase$(gsPROGMENUKEY)
' Skip start menu and programs - they're already there and don't
' need to be created.
Case Else
strGroupName = frmGroup.GroupName(frmSetup1, sGroup, GetPrivate(gsICONGROUP, iLoop), GetStart(gsICONGROUP, iLoop))
If UCase$(sGroup) <> UCase$(strGroupName) Then
SetGroup gsICONGROUP, iLoop, strGroupName
End If
End Select
fMainGroupWasCreated = True
Next
End If
' Before we begin copying files, check for mdac_typ
' and if we find it, spawn that off first. We will tell
' it to never reboot, and check at the end to see if we need to.
DoEvents
If CheckDataAccess Then
'We need to install data access. Display message.
ShowStaticMessageDialog ResolveResString(resINSTALLADO)
InstallDataAccess
HideStaticMessageDialog
End If
'
' Show copy form and set copy gauge percentage to zero
'
SetMousePtr vbHourglass
ShowCopyDialog
UpdateStatus frmCopy.picStatus, 0, True
'
' Always start with Disk #1
'
gintCurrentDisk = 1
'
' For every section in SETUP.LST that needs to be installed, call CopySection
' with the name of the section
'
CopySection gstrINI_FILES
'CopySection "MySection"
'CopySection "MyOtherSection"
'
' If you created an options dialog, you need to check results here to
' determine whether to copy the files in the particular section(s).
'
'If chkInstallSamples.Value then
' CopySection "Samples"
'End If
'
UpdateStatus frmCopy.picStatus, 1, True
HideCopyDialog
'
' Now, do all the 'invisible' update things that are required
'
SetMousePtr vbDefault
ShowStaticMessageDialog ResolveResString(resUPDATING)
'
' Register all the files that have been saved in the registration array. The
' CopySection API adds a registration entry (when required) if a file is copied.
'
RegisterFiles
'
' Register all the licenses that appear in the [Licenses] section of
' Setup.lst.
'
RegisterLicenses
'
' If any DAO files were installed, we need to add some special
' keys to the registry to support it so that links will work
' in OLE Database fields.
'
If gfRegDAO Then
RegisterDAO
End If
CheckForAndInstallDirectX gstrINI_FILES, Me.hWnd
'
' Create program icons (or links, i.e. shortcuts).
'
If fMainGroupWasCreated Or (cIcons > 0) Then
ShowStaticMessageDialog ResolveResString(resPROGMAN)
CreateIcons gsICONGROUP
'
' Do the same for other sections in SETUP.LST if you've added your own.
'
'CreateIcons "MySection"
'CreateIcons "MyOtherSection"
'
End If
'
' Create a separate program group and icons for the Remote Automation
' Connection Manager and the Automation Manager, if either has been
' installed.
' This program group is entirely separate from the one created for the
' application program (if any), because it will be shared by all
' VB applications which install them.
'
' NOTE: This is NOT the place to install additional icons. This is
' NOTE: handled after the Remote Automation icons have been created.
'
ShowStaticMessageDialog ResolveResString(resPROGMAN)
If Len(gsDest.strAUTMGR32) > 0 Or Len(gsDest.strRACMGR32) > 0 Then
'At least one of these programs was installed. Go ahead
'and create the program group.
strRemAutGroupName = ResolveResString(resREMAUTGROUPNAME)
'
' Create the group for the Remote Automation Icons. Note that
' since the user cannot choose the name of this group, there is
' no way at this point to correct an error if one occurs. Therefore,
' fCreateShellGroup will abort setup, without returning, if there
' is an error.
'
fCreateShellGroup strRemAutGroupName, False, False
'Now create the icons for AUTMGR32.EXE and RACMGR32.EXE
If Len(gsDest.strRACMGR32) > 0 Then
CreateShellLink gsDest.strRACMGR32, strRemAutGroupName, vbNullString, ResolveResString(resRACMGR32ICON), True, gsPROGMENUKEY, False
End If
If Len(gsDest.strAUTMGR32) > 0 Then
CreateShellLink gsDest.strAUTMGR32, strRemAutGroupName, vbNullString, ResolveResString(resAUTMGR32ICON), True, gsPROGMENUKEY, False
End If
End If
'
'Register the per-app path
'
If Len(gstrAppExe) > 0 Then
strPerAppPath = ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_APPPATH)
AddPerAppPath gstrAppExe, gsDest.strAppDir, strPerAppPath
End If
ExitSetup:
HideStaticMessageDialog
If fWithinAction() Then
'By now, all logging actions should have been either aborted or committed.
MsgError ResolveResString(resSTILLWITHINACTION), vbExclamation Or vbOKOnly, gstrTitle
ExitSetup Me, gintRET_FATAL
End If
MoveAppRemovalFiles strGroupName
ExitSetup Me, gintRET_FINISHEDSUCCESS
MainError:
iRet = MsgError(Err.Description & vbLf & vbLf & ResolveResString(resUNEXPECTED), vbRetryCancel Or vbExclamation, gstrTitle)
If gfNoUserInput Then iRet = vbCancel
Select Case iRet
Case vbRetry
Resume
Case vbCancel
ExitSetup Me, gintRET_ABORT
Resume
End Select
End Sub
'-----------------------------------------------------------
' SUB: HideCopyDialog
'
' Unloads the copy files status form
'-----------------------------------------------------------
'
Private Sub HideCopyDialog()
Unload frmCopy
End Sub
'-----------------------------------------------------------
' SUB: HideStaticMessageDialog
'
' Unloads the setup messages form
'-----------------------------------------------------------
'
Private Sub HideStaticMessageDialog()
Unload frmMessage
End Sub
'-----------------------------------------------------------
' SUB: ShowBeginForm
'
' Displays the begin setup form
'-----------------------------------------------------------
'
Private Sub ShowBeginForm()
If gfNoUserInput Then
If Not IsValidDestDir(gstrDestDir) Then
ExitSetup frmSetup1, gintRET_FATAL
End If
Else
frmBegin.Show vbModal
End If
End Sub
'-----------------------------------------------------------
' SUB: ShowCopyDialog
'
' Displays the copy files status form
'-----------------------------------------------------------
'
Private Sub ShowCopyDialog()
CenterForm frmCopy
If gfNoUserInput Then
frmCopy.cmdExit.Visible = False
End If
frmCopy.Show
frmCopy.Refresh
If frmCopy.cmdExit.Visible Then
frmCopy.cmdExit.SetFocus
End If
End Sub
'-----------------------------------------------------------
' SUB: ShowMainForm
'
' Displays the main setup 'blue wash' form
'-----------------------------------------------------------
'
Private Sub ShowMainForm()
Caption = gstrTitle
Show
DrawBackGround
Refresh
End Sub
'-----------------------------------------------------------
' SUB: ShowStaticMessageDialog
'
' Displays a setup message in a 'box' of the appropriate
' size for the message
'
' IN: [strMessage] - message to display
'-----------------------------------------------------------
'
Private Sub ShowStaticMessageDialog(ByVal strMessage As String)
Dim frm As Form
Set frm = frmMessage
frm.lblMsg.Caption = strMessage
'
'Default height is twice the height of the setup icon.
'If the height of the message text is greater, then
'increase the form height to the label height plus
'half an icon height
'
frm.ScaleHeight = frm.imgMsg.Height * 2
If frm.lblMsg.Height > frm.ScaleHeight Then
frm.ScaleHeight = frm.lblMsg.Height + frm.imgMsg.Height * 0.5
End If
'
'Vertically center the icon and label within the form
'
frm.imgMsg.Top = frm.ScaleHeight / 2 - frm.imgMsg.Height / 2
frm.lblMsg.Top = frm.ScaleHeight / 2 - frm.lblMsg.Height / 2
CenterForm frm
frm.Show
frm.Refresh
End Sub
'-----------------------------------------------------------
' SUB: ShowWelcomeForm
'
' Displays the welcome to setup form
'-----------------------------------------------------------
'
Private Sub ShowWelcomeForm()
If Not gfNoUserInput Then
frmWelcome.Show vbModal
End If
End Sub
'-----------------------------------------------------------
' SUB: GetStrings
'
' Loads string resources into global vars and forms/controls
'-----------------------------------------------------------
'
Private Sub GetStrings()
On Error GoTo GSErr
gstrSETMSG = ResolveResString(resSETMSG)
Exit Sub
GSErr:
MsgError mstrRESOURCELOADFAIL, vbCritical Or vbOKOnly, vbNullString
ExitSetup Me, gintRET_FATAL
End Sub
Private Sub Form_Unload(Cancel As Integer)
CleanUpCabs
End Sub

BIN
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/setup1.frx Normal file
View File

Binary file not shown.

BIN
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/setup1.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.1 KiB

180
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/setup1.rc Normal file
View File

@@ -0,0 +1,180 @@
#include "setupres.h"
STRINGTABLE DISCARDABLE
BEGIN
//
//Common with bootstrapper
//
#include "commonrc.rc"
//
//Global
//
resSETMSG "Setup Message"
//
//frmBegin
//
resSPECDEST "Click this button to install |1 software to the specified destination directory."
resSPECNODEST "Click this button to install |1 software to your computer."
//
//frmWelcome
//
resWELCOME "Welcome to the |1 installation program."
//
//frmPath
//
resDESTPROMPT "Enter or select a destination directory."
resDESTDIR "The destination directory:"
resCREATE "does not exist. Do you want the directory to be created?"
resCHANGEDIR "Change Directory"
//
//Setup1.Bas
//
resCALCSPACE "An error occurred while calculating required disk space."
resDRVREAD "Cannot read drive "
resDRVCHK "Please verify the drive door is closed and that the disk is formatted and free of errors."
resCANTOPEN "Could not open the file named:"
resMAKEDIR "Could not create directory: |1"
resASKEXIT "Are you sure you want to Exit?"
resINTERRUPTED "|1 Setup was interrupted before your new software was fully installed."
resCANRUN "You can run |1 Setup in its entirety at a later time to complete the installation."
resINCOMPLETE "Setup is not yet complete."
resQUITNOW "If you quit now, this product will not be correctly installed."
resQUITSETUP "Quit the setup of this product?"
resSUCCESS "|1 Setup was completed successfully."
resERROR "|1 Setup was not completed successfully."
resALLOCUNIT "Error determining allocation unit for drive "
resSAMEASSRC "is in the Setup source files directory. Please type a different directory."
resINSERT "Please insert the disk labeled:"
resDISK "'Disk "
resINTO "' into drive "
resSECTNAME "Section: "
resINVLINE "Invalid line in setup information file!"
resDIRSPECIFIED "The specified directory:"
resDIRINVALID "is invalid, incomplete, or write protected. Please type a full path with drive letter; for example 'C:\\APPS'."
resNOTEXIST "The directory doesn't exist!"
resDIRINVNAME "Invalid Directory Name"
resWRITEPROT "The destination file is write protected."
resINUSE "The destination file in in-use. Please ensure that all other applications are closed."
resOUTOFSPACE "Out of space on destination drive |1"
resACCESSVIOLATION "An access violation occurred while copying the file."
resSHARINGVIOLATION "A sharing violation occurred while copying the file."
resOUTOFMEMORY "Out of memory trying to copy the file."
resCANNOTCREATE "Cannot create temporary file."
resCANNOTDELETE "Cannot delete existing destination file."
resCANNOTRENAME "Cannot rename temporary file."
resCANNOTREADSRC "Cannot read source file."
resCANNOTREADDST "Cannot read destination file attributes."
resBUFFTOOSMALL "Internal copy error."
resNOINSTALL " The file could not be installed."
resCHKCONNECT "Please check the connection to drive "
resWARNIGNORE "If you ignore a copy error, the file will not be copied. The application may not function properly as a result. Do you want to ignore the error?"
resCANTREADUNC "Cannot read network path '|1'."
resCHECKUNC "Please verify that this path is correct and that you have permission to access it."
resCANTFINDAPPREMOVALLOG "Application removal logfile '|1' not found. Unable to continue."
resBADCOMMANDLINE "Invalid command-line parameters. Unable to continue."
resCANTFINDAPPREMOVALEXE "Application removal executable '|1' not found. Unable to continue."
resCANTREGISTERAPPREMOVER "Error registering the application removal executable with Windows"
resCHOOSENEWDEST "Please run setup again and select a new location for application files."
resERR_REG "An error occurred trying to update the Windows registration database."
resMICROSOFTSHARED "Microsoft Shared\\"
resCANTCREATEPROGRAMGROUP "An error occurred trying to create the program group '|1'"
resCANTCREATEPROGRAMICON "An error occurred trying to create a program icon for '|1'"
resCANTCOPYLOG "An error occurred trying to copy '|1' to the application directory"
resCANTFINDREGFILE "The file '|1' could not be registered because it was not found."
resCANTRUNPROGRAM "Windows was unable to run the program '|1'. Your system may be low on memory, or the program may not have been found."
resREMOTELINENOTFOUND "Error: 'SETUP.LST' contains no information on how to register the remote component '|1'. This information should have been found in a '|2' key in SETUP.LST"
resCANTCOPYPATHTOOLONG "Cannot copy file, Destination Path is too long."
resCANTCREATEICONPATHTOOLONG "Cannot create Uninstall Icon, Destination Path is too long."
resICONMISSING "No icon was specified in SETUP.LST for |1. Do you want to continue without creating this icon? Click Yes to continue. Click No to Exit Setup."
//
//Setup1.Frm
//
resBADDEFDIR "Setup was unable to determine a valid default destination directory. You will need to specify a destination directory."
resDISKSPACE "Setup is checking for necessary disk space..."
resPROGMAN "Setup is creating program icons..."
resUPDATING "Setup is updating your system..."
resSETUP "|1 Setup"
resNOSETUPLST "The SETUP.LST file is corrupt or could not be found."
resUNEXPECTED "An unexpected setup error has occurred!"
resSTILLWITHINACTION "Setup error: Missing 'CommitAction()' or 'AbortAction()'."
resREMAUTGROUPNAME "Remote Automation Management"
resAUTMGR32ICON "Automation Manager"
resRACMGR32ICON "RemAuto Connection Manager"
resINSTALLADO "Installing Data Access components..."
resREBOOT "Your system needs to be rebooted to update system settings.\n\nWould you like to reboot your system now?"
resREBOOTNO "Your application may not work correctly until you have rebooted your system."
//
//Common.Bas
//
resDISKSPCERR "Error determining disk space free for drive "
//
//Forms/Controls Strings
//
//resBTNINSTALL "&Install"
resFRMDIRECTORY "Directory:"
resBTNCHGDIR "&Change Directory"
resBTNEXIT "E&xit Setup"
resLBLBEGIN "Begin the installation by clicking the button below."
resBTNCANCEL "Cancel"
resLBLDESTFILE "Destination File:"
resBTNINSTALLNOW "&Install Now"
resBTNCHGDRV "&Change Drive"
resLBLDRIVE "Drive"
resLBLAVAIL "Space Available"
resLBLNEEDED "Space Needed"
resLBLREQUIRED "Space Required"
resLBLNOSPACE "There is not enough free disk space on one or more drives."
resBTNOK "OK"
resLBLDRIVES "Dri&ves:"
resLBLDIRS "&Directories:"
resLBLPATH "&Path:"
resLBLRUNNING "Setup cannot install system files or update shared files if they are in use. Before proceeding, we recommend that you close any applications you may be running."
resBTNTOOLTIPBEGIN "Click here to begin setup"
//
// Group.Frm
//
resGROUPFRM "|1 - Choose Program Group"
resGROUPLBLMAIN "Setup will add items to the group shown in the Program Group box. You can enter a new group name or select one from the Existing Groups list."
resGROUPLBLGROUP "&Program Group:"
resGROUPLBLGROUPS "E&xisting Groups:"
resGROUPBTNCONTINUE "&Continue"
resGROUPINVALIDGROUPNAME "A program group name must be less than |1 characters long and cannot contain any of the following characters: |2"
//
//ServerDt.Frm
//
resNETWORKADDRESS "Network &Address"
resNETWORKPROTOCOL "Network &Protocol"
resOK "&Continue"
resCANCEL "E&xit Setup"
resREMOTESERVERDETAILSTITLE "Remote ActiveX Component Configuration"
resREMOTESERVERDETAILSLBL "Please fill in the requested configuration information about the following remote component:"
resNOTEPROTOSEQNOTSUPPORTED "The protocol sequence |1 (|2) is not supported or available on this machine"
resNOTEPROTOSEQINVALID "The protocol sequence '|1' ('|2') is invalid"
resPROTOSEQUNEXPECTEDERR "An unexpected error occurred while determining the protocol sequences available on this machine"
resNOPROTOCOLSINSETUPLST "Setup error: An error occurred trying to read protocols from the SETUP.LST file."
resNOPROTOCOLSSUPPORTED1 "None of the protocols needed by this application appear to be available or installed on this machine."
resNOPROTOCOLSSUPPORTED2 "In order to run Setup successfully, you will need to first install one of the following network protocol sequences: "
resSELECTEDPROTONOTSUPPORTED "This application will not be able to access the remote component '|1' until the protocol '|2' is installed."
resOVERWRITEFORM "Version Conflict"
//VERIFY698: I've changed this text. My new text, unfortunately, is ugly, but alas, correct! It used to say
// "A file being copied is older than..." but this was not true. In reality, the file was sometimes
// older, sometimes older or the same. Now the file is reliably older or the same, which is what it
// should be.
resOVERWRITEINFO "A file being copied is not newer than the file currently on your system. It is recommended that you keep your existing file."
resOVERWRITEFILE "File name: '|1'"
resOVERWRITEDESC "Description: '|1'"
resOVERWRITEVER "Your version: '|1'"
resOVERWRITEKEEP "Do you want to keep this file?"
resOVERNOTOALL "No to &All"
resOVERYES "&Yes"
resOVERNO "&No"
END

BIN
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/setup1.res Normal file
View File

Binary file not shown.

59
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/setup1.vbp Normal file
View File

@@ -0,0 +1,59 @@
Type=Exe
Reference=*\G{78BF8D80-7B03-11D1-AAB1-00AA00BDD685}#1.0#0#VBShell.tlb#VB-friendly Shell interfaces
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Form=setup1.frm
Module=basSetup1; setup1.bas
Module=basCommon; common.bas
Module=basSetupRes; setupres.bas
Module=basLogging; logging.bas
Form=begin.frm
Form=welcome.frm
Form=path.frm
Form=message.frm
Form=dskspace.frm
Form=copy.frm
Form=serverdt.frm
Form=group.frm
Module=modShell; modShell.bas
Form=Overwrit.frm
RelatedDoc=commonrc.rc
RelatedDoc=setup1.rc
RelatedDoc=commonrc.h
RelatedDoc=setupres.h
ResFile32="setup1.res"
IconForm="frmSetup1"
Startup="frmSetup1"
HelpFile=""
Title="Visual Basic 6.0 Setup Toolkit"
ExeName32="setup1.exe"
Command32=""
Name="Setup1"
HelpContextID="0"
Description="Visual Basic 6.0 Setup Toolkit"
CompatibleMode="0"
MajorVer=8
MinorVer=0
RevisionVer=0000
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft Corporation"
VersionFileDescription="Visual Basic 6.0 Setup Toolkit"
VersionLegalCopyright="Copyright (C) 1987-1999 Microsoft Corporation"
VersionLegalTrademarks="Microsoft(R) is a registered trademark of Microsoft Corporation. Windows(TM) is a trademark of Microsoft Corporation."
VersionProductName="Visual Basic"
CondComp="LOGGING = -1 : SMS = 0"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1

15
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/setup1.vbw Normal file
View File

@@ -0,0 +1,15 @@
frmSetup1 = 104, 141, 745, 546, , 110, 110, 640, 558, C
basSetup1 = 0, 22, 749, 636, Z
basCommon = 66, 66, 707, 471,
basSetupRes = 0, 0, 0, 0, C
basLogging = 0, 0, 0, 0, C
frmBegin = 0, 0, 0, 0, C, 154, 154, 684, 602, C
frmWelcome = 0, 0, 0, 0, C, 176, 176, 706, 624, C
frmPath = 0, 0, 0, 0, C, 198, 198, 728, 646, C
frmMessage = 0, 0, 0, 0, C, 220, 220, 750, 668, C
frmDskSpace = 0, 0, 0, 0, C, 0, 0, 530, 448, C
frmCopy = 0, 0, 0, 0, C, 22, 22, 552, 470, C
frmRemoteServerDetails = 0, 0, 0, 0, C, 44, 44, 574, 492, C
frmGroup = 0, 0, 0, 0, C, 66, 66, 596, 514, C
modShell = 0, 0, 0, 0, C
frmOverwrite = 0, 0, 0, 0, C, 88, 88, 618, 536, C

217
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/setupres.bas Normal file
View File

@@ -0,0 +1,217 @@
Attribute VB_Name = "basSetupRes"
Option Explicit
'
' Public vars
'
Public Const resSETMSG% = 1
'
'frmBegin
'
Public Const resSPECDEST% = 100
Public Const resSPECNODEST% = 101
'
'frmWelcome
'
Public Const resWELCOME% = 200
'
'frmPath
'
Public Const resDESTPROMPT% = 301
Public Const resDESTDIR% = 302
Public Const resCREATE% = 303
Public Const resCHANGEDIR% = 304
'
'Setup1.Bas
'
Public Const resCALCSPACE% = 400
Public Const resDRVREAD% = 401
Public Const resDRVCHK% = 402
Public Const resCANTOPEN% = 403
Public Const resMAKEDIR% = 407
Public Const resASKEXIT% = 411
Public Const resINTERRUPTED% = 412
Public Const resCANRUN% = 413
Public Const resINCOMPLETE% = 414
Public Const resQUITNOW% = 415
Public Const resQUITSETUP% = 416
Public Const resSUCCESS% = 417
Public Const resERROR% = 418
Public Const resALLOCUNIT% = 419
Public Const resSAMEASSRC% = 420
Public Const resINSERT% = 423
Public Const resDISK% = 424
Public Const resINTO% = 425
Public Const resSECTNAME% = 426
Public Const resINVLINE% = 427
Public Const resDIRSPECIFIED% = 428
Public Const resDIRINVALID% = 429
Public Const resNOTEXIST% = 430
Public Const resDIRINVNAME% = 431
Public Const resWRITEPROT% = 432
Public Const resINUSE% = 433
Public Const resOUTOFSPACE% = 434
Public Const resACCESSVIOLATION% = 435
Public Const resSHARINGVIOLATION% = 436
Public Const resOUTOFMEMORY% = 437
Public Const resCANNOTCREATE% = 438
Public Const resCANNOTDELETE% = 439
Public Const resCANNOTRENAME% = 440
Public Const resCANNOTREADSRC% = 441
Public Const resCANNOTREADDST% = 442
Public Const resBUFFTOOSMALL% = 443
Public Const resNOINSTALL% = 444
Public Const resCHKCONNECT% = 445
Public Const resWARNIGNORE% = 446
Public Const resCANTREADUNC% = 449
Public Const resCHECKUNC% = 450
Public Const resCANTFINDAPPREMOVALLOG = 451
Public Const resBADCOMMANDLINE = 452
Public Const resCANTFINDAPPREMOVALEXE = 453
Public Const resCANTREGISTERAPPREMOVER = 455
Public Const resCHOOSENEWDEST = 460
Public Const resERR_REG = 462
Public Const resMICROSOFTSHARED = 463
Public Const resCANTCREATEPROGRAMGROUP = 465
Public Const resCANTCREATEPROGRAMICON = 466
Public Const resCANTCOPYLOG = 467
Public Const resCANTFINDREGFILE = 468
Public Const resCANTRUNPROGRAM = 469
Public Const resREMOTELINENOTFOUND = 470
Public Const resCANTCOPYPATHTOOLONG% = 473
Public Const resCANTCREATEICONPATHTOOLONG% = 474
Public Const resICONMISSING = 475
'
'Setup1.Frm
'
Public Const resBADDEFDIR% = 500
Public Const resDISKSPACE% = 501
Public Const resPROGMAN% = 502
Public Const resUPDATING% = 503
Public Const resSETUP% = 505
Public Const resNOSETUPLST% = 506
Public Const resUNEXPECTED% = 507
Public Const resSTILLWITHINACTION = 509
Public Const resREMAUTGROUPNAME = 510
Public Const resAUTMGR32ICON = 511
Public Const resRACMGR32ICON = 512
Public Const resINSTALLADO = 514
Public Const resREBOOT = 515
Public Const resREBOOTNO = 516
'
'Common.Bas
'
Public Const resDISKSPCERR% = 600
'
'Forms/Controls
'
Public Const resFRMDIRECTORY% = 701
Public Const resBTNCHGDIR% = 702
Public Const resBTNEXIT% = 703
Public Const resLBLBEGIN = 704
Public Const resBTNCANCEL% = 705
Public Const resLBLDESTFILE% = 706
Public Const resBTNINSTALLNOW% = 707
Public Const resBTNCHGDRV% = 708
Public Const resLBLDRIVE% = 709
Public Const resLBLAVAIL% = 710
Public Const resLBLNEEDED% = 711
Public Const resLBLREQUIRED% = 712
Public Const resLBLNOSPACE% = 713
Public Const resBTNOK% = 714
Public Const resLBLDRIVES% = 715
Public Const resLBLDIRS% = 716
Public Const resLBLPATH% = 717
Public Const resLBLRUNNING% = 718
Public Const resBTNTOOLTIPBEGIN = 719
'
' Group.Frm
'
Public Const resGROUPFRM = 800
Public Const resGROUPLBLMAIN = 801
Public Const resGROUPLBLGROUP = 802
Public Const resGROUPLBLGROUPS = 803
Public Const resGROUPBTNCONTINUE = 804
Public Const resGROUPINVALIDGROUPNAME = 805
'
'ServerDt.Frm
'
Public Const resNETWORKADDRESS = 900
Public Const resNETWORKPROTOCOL = 901
Public Const resOK = 902
Public Const resCANCEL = 903
Public Const resREMOTESERVERDETAILSTITLE = 904
Public Const resREMOTESERVERDETAILSLBL = 905
Public Const resNOTEPROTOSEQNOTSUPPORTED = 906
Public Const resNOTEPROTOSEQINVALID = 907
Public Const resPROTOSEQUNEXPECTEDERR = 908
Public Const resNOPROTOCOLSINSETUPLST = 909
Public Const resNOPROTOCOLSSUPPORTED1 = 910
Public Const resNOPROTOCOLSSUPPORTED2 = 911
Public Const resSELECTEDPROTONOTSUPPORTED = 912
' Overwrite forms information
Public Const resOVERWRITEFORM = 1000
Public Const resOVERWRITEINFO = 1001
Public Const resOVERWRITEFILE = 1002
Public Const resOVERWRITEDESC = 1003
Public Const resOVERWRITEVER = 1004
Public Const resOVERWRITEKEEP = 1005
Public Const resOVERNOTOALL = 1006
Public Const resOVERYES = 1007
Public Const resOVERNO = 1008
'
'Logging (common with bootstrapper)
'
Public Const resLOG_FILEUPTODATE = 2000
Public Const resLOG_FILECOPIED = 2001
Public Const resLOG_ERROR = 2002
Public Const resLOG_WARNING = 2003
Public Const resLOG_DURINGACTION = 2004
Public Const resLOG_USERRESPONDEDWITH = 2012
Public Const resLOG_CANTRUNAPPREMOVER = 2013
Public Const resLOG_ABOUTTOREMOVEAPP = 2014
Public Const resLOG_vbok = 2100
Public Const resLOG_vbCancel = 2101
Public Const resLOG_vbabort = 2102
Public Const resLOG_vbretry = 2103
Public Const resLOG_vbignore = 2104
Public Const resLOG_vbyes = 2105
Public Const resLOG_vbno = 2106
Public Const resLOG_IDUNKNOWN = 2107
'Other resources possibly common with the bootstrapper
Public Const resCOMMON_CANTREG = 2200
Public Const resCOMMON_CANTREGUNEXPECTED = 2201
Public Const resCOMMON_CANTREGOLE = 2202
Public Const resCOMMON_CANTREGLOAD = 2203
Public Const resCOMMON_CANTREGENTRY = 2204
Public Const resCOMMON_CANTREGREG = 2205
Public Const resCOMMON_INVALIDFILECHARS = 2209
Public Const resCOMMON_MULTDIRBASENAME = 2210
Public Const resCOMMON_CANTFINDSRCFILE = 2211
Public Const resCOMMON_CANTREGTLB = 2212
Public Const resCOMMON_RICHED32NOTCOPIED = 2213

181
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/setupres.h Normal file
View File

@@ -0,0 +1,181 @@
#include "commonrc.h" // Common to bootstrapper and setup1
//
//Global
//
#define resSETMSG 1
//
//frmBegin
//
#define resSPECDEST 100
#define resSPECNODEST 101
//
//frmWelcome
//
#define resWELCOME 200
//
//frmPath
//
#define resDESTPROMPT 301
#define resDESTDIR 302
#define resCREATE 303
#define resCHANGEDIR 304
//
//Setup1.Bas
//
#define resCALCSPACE 400
#define resDRVREAD 401
#define resDRVCHK 402
#define resCANTOPEN 403
#define resMAKEDIR 407
#define resASKEXIT 411
#define resINTERRUPTED 412
#define resCANRUN 413
#define resINCOMPLETE 414
#define resQUITNOW 415
#define resQUITSETUP 416
#define resSUCCESS 417
#define resERROR 418
#define resALLOCUNIT 419
#define resSAMEASSRC 420
#define resINSERT 423
#define resDISK 424
#define resINTO 425
#define resSECTNAME 426
#define resINVLINE 427
#define resDIRSPECIFIED 428
#define resDIRINVALID 429
#define resNOTEXIST 430
#define resDIRINVNAME 431
#define resWRITEPROT 432
#define resINUSE 433
#define resOUTOFSPACE 434
#define resACCESSVIOLATION 435
#define resSHARINGVIOLATION 436
#define resOUTOFMEMORY 437
#define resCANNOTCREATE 438
#define resCANNOTDELETE 439
#define resCANNOTRENAME 440
#define resCANNOTREADSRC 441
#define resCANNOTREADDST 442
#define resBUFFTOOSMALL 443
#define resNOINSTALL 444
#define resCHKCONNECT 445
#define resWARNIGNORE 446
#define resCANTREADUNC 449
#define resCHECKUNC 450
#define resCANTFINDAPPREMOVALLOG 451
#define resBADCOMMANDLINE 452
#define resCANTFINDAPPREMOVALEXE 453
#define resCANTREGISTERAPPREMOVER 455
#define resCHOOSENEWDEST 460
#define resERR_REG 462
#define resMICROSOFTSHARED 463
#define resCANTCREATEPROGRAMGROUP 465
#define resCANTCREATEPROGRAMICON 466
#define resCANTCOPYLOG 467
#define resCANTFINDREGFILE 468
#define resCANTRUNPROGRAM 469
#define resREMOTELINENOTFOUND 470
#define resCANTCOPYPATHTOOLONG 473
#define resCANTCREATEICONPATHTOOLONG 474
#define resICONMISSING 475
//
//frmSetup1
//
#define resBADDEFDIR 500
#define resDISKSPACE 501
#define resPROGMAN 502
#define resUPDATING 503
#define resSETUP 505
#define resNOSETUPLST 506
#define resUNEXPECTED 507
#define resSTILLWITHINACTION 509
#define resREMAUTGROUPNAME 510
#define resAUTMGR32ICON 511
#define resRACMGR32ICON 512
#define resINSTALLADO 514
#define resREBOOT 515
#define resREBOOTNO 516
//
//Common.Bas
//
#define resDISKSPCERR 600
//
//Forms/Controls
//
#define resBTNINSTALL 700
#define resFRMDIRECTORY 701
#define resBTNCHGDIR 702
#define resBTNEXIT 703
#define resLBLBEGIN 704
#define resBTNCANCEL 705
#define resLBLDESTFILE 706
#define resBTNINSTALLNOW 707
#define resBTNCHGDRV 708
#define resLBLDRIVE 709
#define resLBLAVAIL 710
#define resLBLNEEDED 711
#define resLBLREQUIRED 712
#define resLBLNOSPACE 713
#define resBTNOK 714
#define resLBLDRIVES 715
#define resLBLDIRS 716
#define resLBLPATH 717
#define resLBLRUNNING 718
#define resBTNTOOLTIPBEGIN 719
//
// Group.Frm
//
#define resGROUPFRM 800
#define resGROUPLBLMAIN 801
#define resGROUPLBLGROUP 802
#define resGROUPLBLGROUPS 803
#define resGROUPBTNCONTINUE 804
#define resGROUPINVALIDGROUPNAME 805
//
//ServerDt.Frm
//
#define resNETWORKADDRESS 900
#define resNETWORKPROTOCOL 901
#define resOK 902
#define resCANCEL 903
#define resREMOTESERVERDETAILSTITLE 904
#define resREMOTESERVERDETAILSLBL 905
#define resNOTEPROTOSEQNOTSUPPORTED 906
#define resNOTEPROTOSEQINVALID 907
#define resPROTOSEQUNEXPECTEDERR 908
#define resNOPROTOCOLSINSETUPLST 909
#define resNOPROTOCOLSSUPPORTED1 910
#define resNOPROTOCOLSSUPPORTED2 911
#define resSELECTEDPROTONOTSUPPORTED 912
// Starting new resources at 1000
#define resOVERWRITEFORM 1000
#define resOVERWRITEINFO 1001
#define resOVERWRITEFILE 1002
#define resOVERWRITEDESC 1003
#define resOVERWRITEVER 1004
#define resOVERWRITEKEEP 1005
#define resOVERNOTOALL 1006
#define resOVERYES 1007
#define resOVERNO 1008
// Note: commonrc.h starts with ID numbers at 2000

43
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/vbshell.odl Normal file
View File

@@ -0,0 +1,43 @@
[
uuid(78BF8D80-7B03-11d1-AAB1-00AA00BDD685),
version(1.0),
helpstring("VB-friendly Shell interfaces")
]
library VBShell
{
importlib("stdole2.tlb");
[
odl,
uuid(00000002-0000-0000-C000-000000000046),
version(1.0)
]
interface IVBMalloc : IUnknown
{
long Alloc([in] long cb);
long Realloc([in] long pv, [in] long cb);
void Free([in] long pv);
long GetSize([in] long pv);
long DidAlloc([in] long pv);
void HeapMinimize();
};
[
odl,
uuid(000214E6-0000-0000-C000-000000000046),
version(1.0)
]
interface IVBShellFolder : IUnknown
{
HRESULT ParseDisplayName([in] long hWndOwner, [in] long pbcReserved, [in] BSTR lpszDisplayName, [out] long* pchEaten, [out] long* ppidl, [in] long* pdwAttributes);
HRESULT EnumObjects(); //Placeholder: EnumObjects(HWND hwndOwner, DWORD grfFlags, LPENUMIDLIST * ppenumIDList);
HRESULT BindToObject(); //Placeholder: BindToObject(LPCITEMIDLIST pidl, LPBC pbcReserved, REFIID riid, LPVOID * ppvOut);
HRESULT BindToStorage(); //Placeholder: BindToStorage(LPCITEMIDLIST pidl, LPBC pbcReserved, REFIID riid, LPVOID * ppvObj);
HRESULT CompareIDs(); //Placeholder: CompareIDs(THIS_ LPARAM lParam, LPCITEMIDLIST pidl1, LPCITEMIDLIST pidl2);
HRESULT CreateViewObject(); //Placeholder: CreateViewObject(HWND hwndOwner, REFIID riid, LPVOID * ppvOut);
HRESULT GetAttributesOf(); //Placeholder: GetAttributesOf(UINT cidl, LPCITEMIDLIST * apidl, ULONG * rgfInOut);
HRESULT GetUIObjectOf(); //Placeholder: GetUIObjectOf(HWND hwndOwner, UINT cidl, LPCITEMIDLIST * apidl, REFIID riid, UINT * prgfInOut, LPVOID * ppvOut);
HRESULT GetDisplayNameOf(); //Placeholder: GetDisplayNameOf(LPCITEMIDLIST pidl, DWORD uFlags, LPSTRRET lpName);
HRESULT SetNameOf(); //Placeholder: SetNameOf(HWND hwndOwner, LPCITEMIDLIST pidl, LPCOLESTR lpszName, DWORD uFlags, LPITEMIDLIST * ppidlOut);
};
};

163
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/welcome.frm Normal file
View File

@@ -0,0 +1,163 @@
VERSION 5.00
Begin VB.Form frmWelcome
AutoRedraw = -1 'True
BorderStyle = 3 'Fixed Dialog
Caption = "#"
ClientHeight = 3255
ClientLeft = 540
ClientTop = 6000
ClientWidth = 6435
ClipControls = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
HasDC = 0 'False
Icon = "welcome.frx":0000
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
NegotiateMenus = 0 'False
ScaleHeight = 3255
ScaleWidth = 6435
ShowInTaskbar = 0 'False
Begin VB.CommandButton cmdExit
Cancel = -1 'True
Caption = "#"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 3705
MaskColor = &H00000000&
TabIndex = 1
Top = 2655
Width = 1440
End
Begin VB.CommandButton cmdOK
Caption = "#"
Default = -1 'True
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 1470
MaskColor = &H00000000&
TabIndex = 0
Top = 2655
Width = 1440
End
Begin VB.Image imgWelcome
Height = 480
Left = 630
Picture = "welcome.frx":0442
Top = 330
Width = 480
End
Begin VB.Label lblWelcome
AutoSize = -1 'True
Caption = "*"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 1305
TabIndex = 2
Top = 330
Width = 4800
WordWrap = -1 'True
End
Begin VB.Label lblRunning
AutoSize = -1 'True
Caption = "#"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 435
TabIndex = 3
Top = 915
Width = 5535
WordWrap = -1 'True
End
Begin VB.Shape shpWelcome
BorderColor = &H00000000&
BorderWidth = 2
Height = 2250
Left = 210
Top = 135
Width = 6015
End
End
Attribute VB_Name = "frmWelcome"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdExit_Click()
ExitSetup Me, gintRET_EXIT
End Sub
Private Sub cmdOK_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim nTop As Single
SetFormFont Me
cmdExit.Caption = ResolveResString(resBTNEXIT)
cmdOK.Caption = ResolveResString(resBTNOK)
lblRunning.Caption = ResolveResString(resLBLRUNNING)
Caption = gstrTitle
lblWelcome.Caption = ResolveResString(resWELCOME, gstrPIPE1, gstrAppName)
nTop = lblWelcome.Top + lblWelcome.Height
If nTop > lblRunning.Top Then
lblRunning.Top = nTop
End If
shpWelcome.Move (ScaleWidth - shpWelcome.Width) \ 2
cmdOK.Left = (ScaleWidth - cmdOK.Width * 1.5 - cmdExit.Width) \ 2
cmdExit.Left = cmdOK.Left + cmdOK.Width * 1.5
EtchedLine Me, shpWelcome.Left - 50, cmdOK.Top - cmdOK.Height \ 2, shpWelcome.Width + 100
CenterForm Me
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
HandleFormQueryUnload UnloadMode, Cancel, Me
End Sub

BIN
Library/dxx8/samples/Multimedia/VBSamples/Misc/DXSetup/welcome.frx Normal file
View File

Binary file not shown.

676
Library/dxx8/samples/Multimedia/VBSamples/Misc/PowerManagement/dolphin.frm Normal file
View File

@@ -0,0 +1,676 @@
VERSION 5.00
Object = "{1F6AF2BA-798F-4586-8F76-CD0DB05515D9}#1.0#0"; "vb_SubClass.ocx"
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 4290
ClientLeft = 60
ClientTop = 345
ClientWidth = 5580
LinkTopic = "Form1"
ScaleHeight = 286
ScaleMode = 3 'Pixel
ScaleWidth = 372
StartUpPosition = 3 'Windows Default
Begin vbSubClass.SubClasser oSubClass
Left = 120
Top = 3720
_ExtentX = 873
_ExtentY = 873
End
Begin VB.PictureBox Picture1
Height = 3615
Left = 0
ScaleHeight = 3555
ScaleWidth = 4635
TabIndex = 0
Top = 0
Width = 4695
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'-----------------------------------------------------------------------------
' File: Dolphin.cpp
'
' Desc: Sample of swimming dolphin
'
' Note: This code uses the D3D Framework helper library.
'
'
' Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
'-----------------------------------------------------------------------------
Option Explicit
'-----------------------------------------------------------------------------
' Globals variables and definitions
'-----------------------------------------------------------------------------
Private Const WM_POWERBROADCAST = &H218
Private Const PBT_APMQUERYSUSPEND = 0
Private Const PBT_APMRESUMESUSPEND = &H7
Private Const PBT_APMQUERYSTANDBY = &H1
Private Const PBT_APMRESUMESTANDBY = &H8
Private Const PBT_APMBATTERYLOW = &H9
Const WATER_COLOR = &H6688&
Const AMBIENT_COLOR = &H33333333
Const kMesh1 = 0
Const kMesh2 = 1
Const kMesh3 = 2
Private Type DOLPHINVERTEX
p As D3DVECTOR
n As D3DVECTOR
tu As Single
tv As Single
End Type
Const VertexFVF& = D3DFVF_XYZ Or D3DFVF_NORMAL Or D3DFVF_TEX1
Private Type MESHTOOL
VertB As Direct3DVertexBuffer8
NumVertices As Long
Vertices() As DOLPHINVERTEX
End Type
'Dolphin objects
Dim m_DolphinGroupObject As CD3DFrame
Dim m_DolphinObject As CD3DFrame
Dim m_DolphinMesh As CD3DMesh
Dim m_DolphinMesh01 As CD3DMesh
Dim m_DolphinMesh02 As CD3DMesh
Dim m_DolphinMesh03 As CD3DMesh
Dim m_DolphinTex As Direct3DTexture8
'Seafloor objects
Dim m_FloorObject As CD3DFrame
Dim m_SeaFloorMesh As CD3DMesh
Dim m_meshtool(3) As MESHTOOL
Dim m_dest As MESHTOOL
'Textures for the water caustics
Dim m_CausticTextures() As Direct3DTexture8
Dim m_CurrentCausticTexture As Direct3DTexture8
Dim m_media As String
Dim g_ftime As Single
Dim mfNotSuspended As Boolean
'-----------------------------------------------------------------------------
' Name: Form_Load()
' Desc:
'-----------------------------------------------------------------------------
Private Sub Form_Load()
Me.Show
DoEvents
oSubClass.Hook Me.hWnd
'setup defaults
Init
'setup d3d
D3DUtil_DefaultInitWindowed 0, Picture1.hWnd
m_media = FindMediaDir("dolphin_group.x")
D3DUtil_SetMediaPath m_media
InitDeviceObjects
RestoreDeviceObjects
DXUtil_Timer TIMER_START
mfNotSuspended = True
Do While mfNotSuspended
FrameMove
Render
D3DUtil_PresentAll 0
DoEvents
Loop
End Sub
Private Sub Form_Resize()
Picture1.width = Me.ScaleWidth
Picture1.height = Me.ScaleHeight
End Sub
'-----------------------------------------------------------------------------
' Name: Form_Unload()
' Desc:
'-----------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
DeleteDeviceObjects
oSubClass.UnHook
End
End Sub
Private Sub MESHTOOL_INIT(mt As MESHTOOL, m As D3DXMesh)
Set mt.VertB = m.GetVertexBuffer
mt.NumVertices = m.GetNumVertices
ReDim mt.Vertices(mt.NumVertices)
D3DVertexBuffer8GetData mt.VertB, 0, mt.NumVertices * Len(mt.Vertices(0)), 0, mt.Vertices(0)
End Sub
Private Sub MESHTOOL_DESTROY(mt As MESHTOOL)
Set mt.VertB = Nothing
ReDim mt.Vertices(0)
End Sub
Function FtoDW(f As Single) As Long
Dim buf As D3DXBuffer
Dim ret As Long
Set buf = g_d3dx.CreateBuffer(4)
g_d3dx.BufferSetData buf, 0, 4, 1, f
g_d3dx.BufferGetData buf, 0, 4, 1, ret
Set buf = Nothing
FtoDW = ret
End Function
'-----------------------------------------------------------------------------
' Name: Init()
' Desc: Constructor
'-----------------------------------------------------------------------------
Sub Init()
Me.Caption = "D3D Dolphin with Power Management Features"
ReDim m_CausticTextures(32)
End Sub
'-----------------------------------------------------------------------------
' Name: OneTimeSceneInit()
' Desc: Called during initial app startup, this function performs all the
' permanent initialization.
'-----------------------------------------------------------------------------
Sub OneTimeSceneInit()
End Sub
'-----------------------------------------------------------------------------
' Name: BlendMeshes()
' Desc: Does a linear interpolation between all vertex positions and normals
' in two source meshes and outputs the result to the destination mesh.
' Note: all meshes must contain the same number of vertices, and the
' destination mesh must be in device memory.
'-----------------------------------------------------------------------------
Sub BlendMeshes(ByVal fWeight As Single)
Dim fWeight1 As Single, fWeight2 As Single
Dim vTemp1 As D3DVECTOR, vTemp2 As D3DVECTOR
Dim i As Long, j As Long
If (fWeight < 0) Then
j = kMesh3
Else
j = kMesh1
End If
' compute blending factors
fWeight1 = fWeight
If fWeight < 0 Then fWeight1 = -fWeight1
fWeight2 = 1 - fWeight1
' Linearly Interpolate (LERP)positions and normals
For i = 0 To m_dest.NumVertices - 1
D3DXVec3Scale vTemp1, m_meshtool(kMesh2).Vertices(i).p, fWeight2
D3DXVec3Scale vTemp2, m_meshtool(j).Vertices(i).p, fWeight1
D3DXVec3Add m_dest.Vertices(i).p, vTemp1, vTemp2
D3DXVec3Scale vTemp1, m_meshtool(kMesh2).Vertices(i).n, fWeight2
D3DXVec3Scale vTemp2, m_meshtool(j).Vertices(i).n, fWeight1
D3DXVec3Add m_dest.Vertices(i).n, vTemp1, vTemp2
Next
'Set the data
D3DVertexBuffer8SetData m_dest.VertB, 0, m_dest.NumVertices * Len(m_dest.Vertices(0)), 0, m_dest.Vertices(0)
End Sub
'-----------------------------------------------------------------------------
' Name: FrameMove()
' Desc: Called once per frame, the call is the entry point for animating
' the scene.
'-----------------------------------------------------------------------------
Sub FrameMove()
g_ftime = DXUtil_Timer(TIMER_GETAPPTIME) * 0.9
Dim fKickFreq As Single, fPhase As Single, fBlendWeight As Single
fKickFreq = g_ftime * 2
fPhase = g_ftime / 3
fBlendWeight = Sin(fKickFreq)
' Blend the meshes (which makes the dolphin appear to swim)
Call BlendMeshes(fBlendWeight)
' Move the dolphin in a circle and have it undulate
Dim vTrans As D3DVECTOR
Dim qRot As D3DQUATERNION
Dim matDolphin As D3DMATRIX
Dim matTrans As D3DMATRIX, matRotate1 As D3DMATRIX, matRotate2 As D3DMATRIX
'Scale dolphin geometery to 1/100 original
D3DXMatrixScaling matDolphin, 0.01, 0.01, 0.01
'add up and down roation (since modeled along x axis)
D3DXMatrixRotationZ matRotate1, -Cos(fKickFreq) / 6
D3DXMatrixMultiply matDolphin, matDolphin, matRotate1
'add rotation to make dolphin point at tangent to the circle
D3DXMatrixRotationY matRotate2, fPhase
D3DXMatrixMultiply matDolphin, matDolphin, matRotate2
'add traslation to make the dolphin move in a circle and bob up and down
'in sync with its flippers
D3DXMatrixTranslation matTrans, -5 * Sin(fPhase), Sin(fKickFreq) / 2, 10 - 10 * Cos(fPhase)
'D3DXMatrixTranslation matTrans, 0, Sin(fKickFreq) / 2, 0
D3DXMatrixMultiply matDolphin, matDolphin, matTrans
m_DolphinObject.SetMatrix matDolphin
' Animate the caustic textures
Dim tex As Long
tex = CLng((g_ftime * 32)) Mod 32
Set m_CurrentCausticTexture = m_CausticTextures(tex)
End Sub
'-----------------------------------------------------------------------------
' Name: Render()
' Desc: Called once per frame, the call is the entry point for 3d
' rendering. This function sets up render states, clears the
' viewport, and renders the scene.
'-----------------------------------------------------------------------------
Sub Render()
Dim mat As D3DMATRIX
Dim mat2 As D3DMATRIX
Dim hr As Long
hr = g_dev.TestCooperativeLevel()
If hr = D3DERR_DEVICELOST Then
'If the device is lost, exit and wait for it to come back.
Exit Sub
ElseIf hr = D3DERR_DEVICENOTRESET Then
'The device became lost for some reason (probably an alt-tab) and now
'Reset() needs to be called to try and get the device back.
g_dev.Reset g_d3dpp
'Restore Device objects
RestoreDeviceObjects
End If
'Make sure the app isn't minimized.
If Me.WindowState = vbMinimized Then Exit Sub
' Clear the backbuffer
D3DUtil_ClearAll WATER_COLOR
With g_dev
.BeginScene
' Render the Seafloor. For devices that support one-pass multi-
' texturing, use the second texture stage to blend in the animated
' water caustics texture.
If (g_d3dcaps.MaxTextureBlendStages > 1) Then
' Set up the 2nd texture stage for the animated water caustics
.SetTexture 1, m_CurrentCausticTexture
.SetTextureStageState 1, D3DTSS_COLOROP, D3DTOP_MODULATE
.SetTextureStageState 1, D3DTSS_COLORARG1, D3DTA_TEXTURE
.SetTextureStageState 1, D3DTSS_COLORARG2, D3DTA_CURRENT
' Tell D3D to automatically generate texture coordinates from the
' model's position in camera space. The texture transform matrix is
' setup so that the 'x' and 'z' coordinates are scaled to become the
' resulting 'tu' and 'tv' texture coordinates. The resulting effect
' is that the caustic texture is draped over the geometry from above.
mat.m11 = 0.05: mat.m12 = 0#
mat.m21 = 0#: mat.m22 = 0#
mat.m31 = 0#: mat.m32 = 0.05
mat.m41 = Sin(g_ftime) / 8: mat.m42 = (Cos(g_ftime) / 10) - (g_ftime / 10)
.SetTransform D3DTS_TEXTURE1, mat
.SetTextureStageState 1, D3DTSS_TEXCOORDINDEX, D3DTSS_TCI_CAMERASPACEPOSITION
.SetTextureStageState 1, D3DTSS_TEXTURETRANSFORMFLAGS, D3DTTFF_COUNT2
End If
g_dev.SetRenderState D3DRS_AMBIENT, &HB0B0B0B0
' Finally, render the actual seafloor with the above states
m_FloorObject.Render g_dev
' Disable the second texture stage
If (g_d3dcaps.MaxTextureBlendStages > 1) Then
.SetTextureStageState 1, D3DTSS_COLOROP, D3DTOP_DISABLE
End If
' Render the dolphin in it's first pass.
.SetRenderState D3DRS_AMBIENT, AMBIENT_COLOR
m_DolphinObject.Render g_dev
' For devices that support one-pass multi-texturing, use the second
' texture stage to blend in the animated water caustics texture for
' the dolphin. This a little tricky because we only want caustics on
' the part of the dolphin that is lit from above. To acheive this
' effect, the dolphin is rendered alpha-blended with a second pass
' which has the caustic effects modulating the diffuse component
' which contains lighting-only information) of the geometry.
If (g_d3dcaps.MaxTextureBlendStages > 1) Then
' For the 2nd pass of rendering the dolphin, turn on the caustic
' effects. Start with setting up the 2nd texture stage state, which
' will modulate the texture with the diffuse component. This actually
' only needs one stage, except that using a CD3DFile object makes that
' a little tricky.
.SetTexture 1, m_CurrentCausticTexture
.SetTextureStageState 1, D3DTSS_COLOROP, D3DTOP_MODULATE
.SetTextureStageState 1, D3DTSS_COLORARG1, D3DTA_TEXTURE
.SetTextureStageState 1, D3DTSS_COLORARG2, D3DTA_DIFFUSE
' Now, set up D3D to generate texture coodinates. This is the same as
' with the seafloor the 'x' and 'z' position coordinates in camera
' space are used to generate the 'tu' and 'tv' texture coordinates),
' except our scaling factors are different in the texture matrix, to
' get a better looking result.
mat2.m11 = 0.5: mat2.m12 = 0#
mat2.m21 = 0#: mat2.m22 = 0#
mat2.m31 = 0#: mat2.m32 = 0.5
mat2.m41 = 0#: mat2.m42 = 0#
.SetTransform D3DTS_TEXTURE1, mat2
.SetTextureStageState 1, D3DTSS_TEXCOORDINDEX, D3DTSS_TCI_CAMERASPACEPOSITION
.SetTextureStageState 1, D3DTSS_TEXTURETRANSFORMFLAGS, D3DTTFF_COUNT2
' Set the ambient color and fog color to pure black. Ambient is set
' to black because we still have a light shining from above, but we
' don't want any caustic effects on the dolphin's underbelly. Fog is
' set to black because we want the caustic effects to fade out in the
' distance just as the model does with the WATER_COLOR.
.SetRenderState D3DRS_AMBIENT, &H0&
.SetRenderState D3DRS_FOGCOLOR, &H0&
' Set up blending modes to add this caustics-only pass with the
' previous pass.
.SetRenderState D3DRS_ALPHABLENDENABLE, 1 ' True
.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCCOLOR
.SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE
' Finally, render the caustic effects for the dolphin
m_DolphinObject.Render g_dev
' After all is well and done, restore any munged texture stage states
.SetTextureStageState 1, D3DTSS_COLOROP, D3DTOP_DISABLE
.SetRenderState D3DRS_AMBIENT, AMBIENT_COLOR
.SetRenderState D3DRS_FOGCOLOR, WATER_COLOR
.SetRenderState D3DRS_ALPHABLENDENABLE, 0 'False
End If
skipcaustic:
' End the scene.
.EndScene
End With
End Sub
'-----------------------------------------------------------------------------
' Name: InitDeviceObjects()
' Desc: Initialize scene objects.
'-----------------------------------------------------------------------------
Function InitDeviceObjects() As Boolean
Dim b As Boolean
Dim t As Long
Dim strName As String
Dim i As Long
'Set up textures for the water caustics
For t = 0 To 31
strName = m_media + "Caust" + Format$(t, "00") + ".tga"
Set m_CausticTextures(t) = D3DUtil_CreateTexture(g_dev, strName, D3DFMT_UNKNOWN)
If m_CausticTextures(t) Is Nothing Then
Debug.Print "Unable to find media " + strName
'End
End If
Next
' Load the file-based mesh objects
Set m_DolphinGroupObject = D3DUtil_LoadFromFile(m_media + "dolphin_group.x", Nothing, Nothing)
Set m_DolphinObject = D3DUtil_LoadFromFile(m_media + "dolphin.x", Nothing, Nothing)
Set m_FloorObject = D3DUtil_LoadFromFile(m_media + "seafloor.x", Nothing, Nothing)
' // Gain access to the meshes
Set m_DolphinMesh01 = m_DolphinGroupObject.FindChildObject("Dolph01", 0)
Set m_DolphinMesh02 = m_DolphinGroupObject.FindChildObject("Dolph02", 0)
Set m_DolphinMesh03 = m_DolphinGroupObject.FindChildObject("Dolph03", 0)
Set m_DolphinMesh = m_DolphinObject.FindChildObject("Dolph02", 0).GetChildMesh(0)
Set m_SeaFloorMesh = m_FloorObject.FindChildObject("SeaFloor", 0)
' Set the FVF type to something useful
Call m_DolphinMesh01.SetFVF(g_dev, VertexFVF)
Call m_DolphinMesh02.SetFVF(g_dev, VertexFVF)
Call m_DolphinMesh03.SetFVF(g_dev, VertexFVF)
Call m_DolphinMesh.SetFVF(g_dev, VertexFVF)
Call m_SeaFloorMesh.SetFVF(g_dev, VertexFVF)
Set m_DolphinTex = D3DUtil_CreateTexture(g_dev, m_media + "dolphin.bmp", D3DFMT_UNKNOWN)
' Scale the sea floor vertices, and add some bumpiness
Dim seafloortool As MESHTOOL
MESHTOOL_INIT seafloortool, m_SeaFloorMesh.mesh
For i = 0 To seafloortool.NumVertices - 1
seafloortool.Vertices(i).p.y = seafloortool.Vertices(i).p.y + Rnd(1) + Rnd(1) + Rnd(1)
seafloortool.Vertices(i).tu = seafloortool.Vertices(i).tu * 10
seafloortool.Vertices(i).tv = seafloortool.Vertices(i).tv * 10
Next
D3DVertexBuffer8SetData seafloortool.VertB, 0, Len(seafloortool.Vertices(0)) * seafloortool.NumVertices, 0, seafloortool.Vertices(0)
MESHTOOL_DESTROY seafloortool
MESHTOOL_INIT m_meshtool(kMesh1), m_DolphinMesh01.mesh
MESHTOOL_INIT m_meshtool(kMesh2), m_DolphinMesh02.mesh
MESHTOOL_INIT m_meshtool(kMesh3), m_DolphinMesh03.mesh
MESHTOOL_INIT m_dest, m_DolphinMesh.mesh
InitDeviceObjects = True
End Function
'-----------------------------------------------------------------------------
' Name: RestoreDeviceObjects()
' Desc: Restore device-memory objects and state after a device is created or
' resized.
'-----------------------------------------------------------------------------
Sub RestoreDeviceObjects()
m_DolphinGroupObject.RestoreDeviceObjects g_dev
m_DolphinObject.RestoreDeviceObjects g_dev
m_FloorObject.RestoreDeviceObjects g_dev
' Set miscellaneous render states
With g_dev
' Set world transform
Dim matWorld As D3DMATRIX
D3DXMatrixIdentity matWorld
.SetTransform D3DTS_WORLD, matWorld
' Set the app view matrix for normal viewing
Dim vEyePt As D3DVECTOR, vLookatPt As D3DVECTOR, vUpVec As D3DVECTOR
Dim matView As D3DMATRIX
vEyePt = vec3(0, 0, -5)
vLookatPt = vec3(0, 0, 0)
vUpVec = vec3(0, 1, 0)
D3DXMatrixLookAtLH matView, vEyePt, vLookatPt, vUpVec
.SetTransform D3DTS_VIEW, matView
' Set the projection matrix
Dim matProj As D3DMATRIX
Dim fAspect As Single
fAspect = 1
D3DXMatrixPerspectiveFovLH matProj, g_pi / 3, fAspect, 1, 10000
.SetTransform D3DTS_PROJECTION, matProj
.SetTextureStageState 0, D3DTSS_COLORARG1, D3DTA_TEXTURE
.SetTextureStageState 0, D3DTSS_COLORARG2, D3DTA_DIFFUSE
.SetTextureStageState 0, D3DTSS_COLOROP, D3DTOP_MODULATE
.SetTextureStageState 0, D3DTSS_MINFILTER, D3DTEXF_LINEAR
.SetTextureStageState 0, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
.SetTextureStageState 1, D3DTSS_MINFILTER, D3DTEXF_LINEAR
.SetTextureStageState 1, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
' Set default render states
.SetRenderState D3DRS_DITHERENABLE, 1 'True
.SetRenderState D3DRS_SPECULARENABLE, 0 'False
.SetRenderState D3DRS_ZENABLE, 1 'True
.SetRenderState D3DRS_NORMALIZENORMALS, 1 'True
' Turn on fog, for underwater effect
Dim fFogStart As Single
Dim fFogEnd As Single
fFogStart = 1
fFogEnd = 50
.SetRenderState D3DRS_FOGENABLE, 1 ' True
.SetRenderState D3DRS_FOGCOLOR, WATER_COLOR
.SetRenderState D3DRS_FOGTABLEMODE, D3DFOG_NONE
.SetRenderState D3DRS_FOGVERTEXMODE, D3DFOG_LINEAR
.SetRenderState D3DRS_RANGEFOGENABLE, 0 'False
.SetRenderState D3DRS_FOGSTART, FtoDW(fFogStart)
.SetRenderState D3DRS_FOGEND, FtoDW(fFogEnd)
' Create a directional light
Dim light As D3DLIGHT8
D3DUtil_InitLight light, D3DLIGHT_DIRECTIONAL, 0, -1, 0
.SetLight 0, light
.LightEnable 0, 1 'True
.SetRenderState D3DRS_LIGHTING, 1 'TRUE
.SetRenderState D3DRS_AMBIENT, AMBIENT_COLOR
End With
End Sub
'-----------------------------------------------------------------------------
' Name: InvalidateDeviceObjects()
' Desc: Called when the device-dependant objects are about to be lost.
'-----------------------------------------------------------------------------
Sub InvalidateDeviceObjects()
m_FloorObject.InvalidateDeviceObjects
m_DolphinGroupObject.InvalidateDeviceObjects
m_DolphinObject.InvalidateDeviceObjects
End Sub
'-----------------------------------------------------------------------------
' Name: DeleteDeviceObjects()
' Desc: Called when the app is exitting, or the device is being changed,
' this function deletes any device dependant objects.
'----------------------------------------------------------------------
Sub DeleteDeviceObjects()
m_FloorObject.Destroy
m_DolphinGroupObject.Destroy
m_DolphinObject.Destroy
MESHTOOL_DESTROY m_meshtool(0)
MESHTOOL_DESTROY m_meshtool(1)
MESHTOOL_DESTROY m_meshtool(2)
MESHTOOL_DESTROY m_dest
Set m_DolphinGroupObject = Nothing
Set m_DolphinObject = Nothing
Set m_DolphinMesh = Nothing
Set m_DolphinMesh01 = Nothing
Set m_DolphinMesh02 = Nothing
Set m_DolphinMesh03 = Nothing
Set m_FloorObject = Nothing
Set m_SeaFloorMesh = Nothing
End Sub
Private Sub oSubClass_WindowsMessage(ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
Select Case uMsg
Case WM_POWERBROADCAST 'Something is happening
Select Case wParam
Case PBT_APMQUERYSUSPEND, PBT_APMBATTERYLOW, PBT_APMQUERYSTANDBY
'We're going into Standby mode, or suspend mode, we need to pause the sample
mfNotSuspended = False 'Stop the render loop
DeleteDeviceObjects 'Delete everything
Case PBT_APMRESUMESUSPEND, PBT_APMRESUMESTANDBY
'We're returning, go ahead and restart the sample
'setup defaults
Init
'setup d3d
D3DUtil_DefaultInitWindowed 0, Picture1.hWnd
m_media = FindMediaDir("dolphin_group.x")
D3DUtil_SetMediaPath m_media
InitDeviceObjects
RestoreDeviceObjects
DXUtil_Timer TIMER_START
mfNotSuspended = True
End Select
End Select
End Sub

37
Library/dxx8/samples/Multimedia/VBSamples/Misc/PowerManagement/vb_power.vbp Normal file
View File

@@ -0,0 +1,37 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
Form=dolphin.frm
Module=D3DInit; ..\..\common\D3DInit.bas
Module=D3DUtil; ..\..\common\D3DUtil.bas
Class=CD3DMesh; ..\..\common\D3DMesh.cls
Class=CD3DFrame; ..\..\common\D3DFrame.cls
Class=CD3DAnimation; ..\..\common\D3DAnimation.cls
Module=MediaDir; ..\..\common\media.bas
Object={1F6AF2BA-798F-4586-8F76-CD0DB05515D9}#1.0#0; vb_SubClass.ocx
Startup="Form1"
Command32=""
Name="Project1"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1

43
Library/dxx8/samples/Multimedia/VBSamples/Misc/SubClass/SubClasser.ctl Normal file
View File

@@ -0,0 +1,43 @@
VERSION 5.00
Begin VB.UserControl SubClasser
CanGetFocus = 0 'False
ClientHeight = 495
ClientLeft = 0
ClientTop = 0
ClientWidth = 510
HasDC = 0 'False
InvisibleAtRuntime= -1 'True
Picture = "SubClasser.ctx":0000
ScaleHeight = 495
ScaleWidth = 510
ToolboxBitmap = "SubClasser.ctx":0442
End
Attribute VB_Name = "SubClasser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Private mlHwnd As Long
Private mfNeedUnhook As Boolean
Public Event WindowsMessage(ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
Public Sub Hook(ByVal hWnd As Long)
mlHwnd = hWnd
modWndProc.Hook mlHwnd, Me
mfNeedUnhook = True
End Sub
Public Sub UnHook()
modWndProc.UnHook mlHwnd
mfNeedUnhook = False
End Sub
Friend Sub GotMessage(ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
RaiseEvent WindowsMessage(uMsg, wParam, lParam)
End Sub
Private Sub UserControl_Terminate()
If mfNeedUnhook Then UnHook
End Sub

BIN
Library/dxx8/samples/Multimedia/VBSamples/Misc/SubClass/SubClasser.ctx Normal file
View File

Binary file not shown.

27
Library/dxx8/samples/Multimedia/VBSamples/Misc/SubClass/modWndProc.bas Normal file
View File

@@ -0,0 +1,27 @@
Attribute VB_Name = "modWndProc"
Option Explicit
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_WNDPROC = -4
Public lpPrevWndProc As Long
Private moControl As SubClasser
Public Sub Hook(ByVal lHwnd As Long, oCon As SubClasser)
lpPrevWndProc = SetWindowLong(lHwnd, GWL_WNDPROC, AddressOf WindowProc)
Set moControl = oCon
End Sub
Public Sub UnHook(ByVal lHwnd As Long)
Dim lngReturnValue As Long
lngReturnValue = SetWindowLong(lHwnd, GWL_WNDPROC, lpPrevWndProc)
End Sub
Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
moControl.GotMessage uMsg, wParam, lParam
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Function

BIN
Library/dxx8/samples/Multimedia/VBSamples/Misc/SubClass/vb_SubClass.bcf Normal file
View File

Binary file not shown.

35
Library/dxx8/samples/Multimedia/VBSamples/Misc/SubClass/vb_SubClass.vbp Normal file
View File

@@ -0,0 +1,35 @@
Type=Control
UserControl=SubClasser.ctl
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Module=modWndProc; modWndProc.bas
Startup="(None)"
HelpFile=""
ExeName32="vb_SubClass.ocx"
Command32=""
Name="vbSubClass"
HelpContextID="0"
CompatibleMode="2"
CompatibleEXE32="vb_SubClass.bcf"
VersionCompatible32="1"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=1
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
ThreadingModel=1