<node>Controls
<node>Calander Controls
<node>Date Range
<node>CheckBox
<node>Combo
<node>Command Dialog
<node>Crystal Reports
<node>Data Control
<node>buttons
<node>current record
<node>Error
<node>Properties
<node>Reposition
<node>Save
<node>Validate
<node>Data List,Combo,Grid Control
<node>Combo
<node>Grid
<node>Alignment
<node>Check Box Add
<node>Colors
<node>Column Order
<node>Columns
<node>After Column Update
<node>Combo In Field
<node>Events
<node>resize
<node>rowcolumnchange event
<node>unbound column
<node>SelectedBookmark
<node>Unbound column
<node>List
<node>row Change
<node>selection
<node>Selecting Records
<node>Dhtml Edit
<node>Faxman
<node>forms
<node>internet
<node>List box
<node>delete
<node>Selection
<node>picturebox
<node>Registry
<node>Reports
<node>Printer
<node>Sub Reports
<node>cancel
<node>In detail
<node>text box
<node>sum
<node>tool bar
<node>runtime
<node>TabPro
<node>Cancel tab switch
<node>Text Box
<node>Alpha Search
<node>Select Text
<node>size from record
<node>Database
<node>ADO
<node>Compact Database
<node>connect
<node>count
<node>Create Database
<node>index
<node>Relations
<node>startup
<node>Tables
<node>Database
<node>Delete
<node>Query
<node>Tables
<node>Fields
<node>Add Fields to Table
<node>Delete
<node>Filters
<node>Like
<node>No child records
<node>Indexes
<node>Locators
<node>open
<node>Queries
<node>Duplicate
<node>Missing Child
<node>sum
<node>table
<node>three level
<node>Rename
<node>Tables
<node>Sum Fields
<node>Update Query
<node>upgrade versions
<node>distribution
<node>email
<node>FileHandling
<node>clipboardcopy
<node>Controls
<node>Directory
<node>Drive
<node>File
<node>Pattern
<node>Create Directory
<node>Directory
<node>Drive Api
<node>File
<node>Api Copy
<node>Attribute
<node>Change File Date
<node>CombineFiles
<node>Copy
<node>Date/Time
<node>Delete
<node>Into Text Box
<node>Length
<node>pattern
<node>RENAME
<node>Seqential
<node>LongFileNames
<node>networkdrives
<node>Reading
<node>graphics
<node>IMAGE width/height
<node>Help
<node>internet
<node>email
<node>if connected
<node>Library
<node>App Path
<node>Arrays
<node>classHandle
<node>ClipBoard
<node>Codevb4
<hj-Treepad version 0.9>
<node>VisualBasic
0
Autorun.inf
To autostart a new CD you need these files:
autostart.inf
an Icon
Your Program
Set the autostart.inf file to point the system to your program by placing you program name after the open statement. Here is an example.
[autorun]
open=documents\htmlview.exe picture.html
icon=Commit.ico
This will run an exe in another directory and open the picture.html file
or
[autorun]
open=MyProgram.exe
icon=MyIcon.ico
delaytime=2000
The Icon (.ico file) will appear in the explorer window.
Add these files to the root directory of your CD.
Using a HTML Page to make your CD Trendy.
To make your CD automatically display an HTML page – perhaps giving the user some information on the CD – this is what you do.
Write a trendy HTML page for your CD.
Write a quick VB application using the code below.
This uses Microsoft Internet Explorers IWebBrowserApp interface.
Put this program, the HTML page plus the VB support DLL on to your CD in the root dir.
Configure your autostart.inf file to point to your VB program.
Burn your CD.
Sample Code:
Sub Main()
Dim web As Object
Dim strCurPath
Dim FileName As String
'Get the current file and path
strCurPath = CurDir
If Right(strCurPath, 1) = "\" Then
'make it in to a URL
FileName = strCurPath + "Index.htm"
Else
'make it in to a URL
FileName = strCurPath + "\Index.htm"
End If
On Error GoTo Fred
' fire up internet explorer
Set web = CreateObject("InternetExplorer.Application.1")
web.Visible = True 'make it visible
web.navigate (FileName) 'display the file
'Destroy the IWebBrowserApp object
Set web = Nothing
Fred:
End Sub
——————————————————————————–
[autorun]
open=AutoPlay.exe -c
icon=Acrobat.ico
How to Test Autorun.inf Files
4.00 WINDOWS kbmm
——————————————————————————–
The information in this article applies to:
Microsoft Win32 Software Development Kit (SDK), version 4.0, used with:
the operating system: Microsoft Windows 95
the operating system: Microsoft Windows 98
——————————————————————————–
SUMMARY
AutoPlay is enabled by the new 32-bit, protected-mode driver architecture in Microsoft Windows 95 and Microsoft Windows 98. Because the operating system can now detect the insertion of media in a CD-ROM drive, it has the opportunity to do some intelligent processing whenever this occurs.
By default, Windows 95 and Windows 98 only check for an Autorun.inf file when a CD-ROM disc is inserted into the CD-ROM drive. However, you may want to test for syntax and logic errors before burning a CD-ROM disc. This article explains how.
MORE INFORMATION
In Windows 9x, whenever a CD-ROM disc is inserted, the shell immediately checks to see if the CD-ROM disc has a PC filesystem. If it does, Windows 9x looks for a file named Autorun.inf. If the file exists, Windows 9x follows the instructions contained in the file, which usually involves running a setup application of some sort.
However, by changing a setting in the Windows 9x registry, you can have the Shell use AutoPlay on any media, including shared network drives and floppy disks.
The registry key that needs to be modified is:
HKEY_CURRENT_USER\
Software\
Microsoft\
Windows\
CurrentVersion\
Policies\
Explorer\
"NoDriveTypeAutoRun"
This key, which is of type REG_BINARY, consists of four bytes. The first byte is a bitmask defining which drive types should be AutoRun. The other three bytes should be set to zero (0).
The bits in the bitmask correspond to these constants:
Type Bit
DRIVE_UNKNOWN 0
DRIVE_NO_ROOT_DIR 1
DRIVE_REMOVABLE 2
DRIVE_FIXED 3
DRIVE_REMOTE 4
DRIVE_CDROM 5
DRIVE_RAMDISK 6
Setting a bit in the bitmask prevents you from using AutoPlay with the corresponding drive type. By default, the value in the registry is 0x95. Bits 0, 2, 4 and 7 are therefore set, which means that drive types DRIVE_UNKNOWN, DRIVE_REMOVEABLE, and DRIVE_REMOTE don't use AutoPlay information. (Bit 7 is set to cover future device types.) Altering this registry value thus allows you to test Autorun.inf files from a floppy disk (DRIVE_REMOVEABLE), network drive (DRIVE_REMOTE), and so on. For example, to be able to test AutoPlay from a floppy disk, set the value of the first byte to 0x91 to enable AutoPlay for floppy disks.
NOTE: Most floppy disk drive controllers do not currently recognize when a floppy disk has been inserted. To test AutoPlay on a floppy disk, first alter the registry setting so that bit DRIVE_REMOVEABLE is not set, start the Windows Explorer, insert the floppy disk, and press the F5 key to refresh the display.
To test the Autorun.inf file on a given disk, using the right mouse button, click the icon for the drive in the Windows Explorer. The effects of the Autorun.inf file should be visible in the context menu.
<end node> 5P9i0s8y19Z
<node>Controls
1
<end node> 5P9i0s8y19Z
<node>Calander Controls
2
[Calendar controls]
Sheridan presently required fiels
MFC40.DLL 4.1.6038 MFC support file
MFC42.DLL 6.00.8267.0 MFC support file
MFCO40.DLL 4.0.5157 MFC support file
MSVCRT.DLL 6.00.8267.0 VC++ run-time support file
MSVCRT40.DLL 4.00.5270 VC++ run-time support file
OLEAUT32.DLL 2.30.4261 32-bit OLE support file
OLEPRO32.DLL 5.0.4261 32-bit OLE support file
SSFM1032.DLL 1.0.0.10 32-bit support file
STDOLE2.TLB 2.20 32-bit OLE type library
<end node> 5P9i0s8y19Z
<node>Date Range
3
Date range]
coDateAccount(j).X.DayofWeek(1).Visible = False
coDateAccount(j).X.DayofWeek(7).Visible = False
coDateAccount(j).MaxDate = DateValue(Now) + 5 * 365
coDateAccount(j).MinDate = DateValue(Now) – 25 * 365
coDateAccount(j).DropDownWidth = coDateAccount(j).Width
<end node> 5P9i0s8y19Z
<node>CheckBox
2
Private Sub chBackup_Click(Index As Integer)
Select Case Index
Case Is = 0
WriteIni "Setup", "newfile", Str$(chBackup(0).Value), INI
Case Is = 2
WriteIni "Setup", "log", Str$(chBackup(2).Value), INI
Case Is = 3
WriteIni "Setup", "backup", Str$(chBackup(3).Value), INI
Case Is = 4
WriteIni "Setup", "changes", Str$(chBackup(4).Value), INI
End Select
End Sub
********Load boxes****************************
If A = "1" Then chBackup(0).Value = 1
A = GetIni("Setup", "log", INI)
If A = "1" Then chBackup(2).Value = 1
A = GetIni("Setup", "backup", INI)
If A = "1" Then chBackup(3).Value = 1
A = GetIni("Setup", "changes", INI)
If A = "1" Then chBackup(4).Value = 1
<end node> 5P9i0s8y19Z
<node>Combo
2
This example fills a ListBox control with employee names and fills the ItemData property array with employee numbers using the NewIndex property to keep the numbers synchronized with the sorted list. A Label control displays the name and number of an item when the user makes a selection. To try this example, paste the code into the Declarations section of a form that contains a ListBox and a Label. Set the Sorted property for the ListBox to True, and then press F5 and click the ListBox.
Itemdata is always integer
Private Sub Form_Load ()
' Fill List1 and ItemData array with
' corresponding items in sorted order.
List1.AddItem "Judy Phelps"
List1.ItemData(List1.NewIndex) = 42310
List1.AddItem "Chien Lieu"
List1.ItemData(List1.NewIndex) = 52855
List1.AddItem "Mauro Sorrento"
List1.ItemData(List1.NewIndex) = 64932
List1.AddItem "Cynthia Bennet"
List1.ItemData(List1.NewIndex) = 39227
End Sub
Private Sub List1_Click ()
' Append the employee number and the employee name.
Msg = List1.ItemData(List1.ListIndex) & " "
Msg = Msg & List1.List(List1.ListIndex)
Label1.Caption = Msg
End Sub
<end node> 5P9i0s8y19Z
<node>Command Dialog
2
[Command Dialog]
R$ = GetIni("Files", "database", INI)
Tree2 = SplitPath(R$)
If R$ = "none" Then R$ = "membership.mdb"
Set Db = OpenDatabase(Tree2 + "membership.mdb")
If Err = 3024 Then
Err = 0: 'Call NewDatabase
599 Di.InitDir = Tree
Di.CancelError = True
Di.FileName = R$
di.filter="Text (*.txt)|*.txt|Pictures (*.bmp;*.ico)|*.bmp;*.ico"
Di.Filter = "(" + "*.mdb" + ")|" + "*.mdb"
Di.FilterIndex = 1
Di.DialogTitle = "Select the " + "*.mdb" + " file"
Di.Action = 1
If Err = 32755 Then
Err = 0
m% = MsgBox("Permission to Create New Database", 33, "No Database Expected")
If m% <> 2 Then Call NewDatabase Else GoTo 599
End If
f$ = Di.FileName
a$ = Dir(f$): If a$ = "" Then MsgBox ("Press Cancel to Create Database"): GoTo 599
i% = WriteIni("Files", "database", f$, INI)
Tree2 = SplitPath(f$)
End If
Screen.MousePointer = 0
[ Example 2]
Private Sub btmerge_Click()
On Error GoTo btmergeerr
Call get_ini("Files", "merge", r$)
If r$ = "none" Then r$ = "tmp.txt"
di.initDir=tree
di.CancelError = True
di.filename = r$
di.filter = "(" + "*.txt" + ")|" + "*.txt"
di.FilterIndex = 1
di.DialogTitle = "Select the " + "*.txt" + " file"
di.Action = 1
f$ = di.filename
btmergeerr:
If Err = 32755 Then Resume 770
resume next
end sub
advanced filter
.Filter = "Access Database(*.mdb;*.mda;*.mde;*.mdw)|*.mdb; *.mda; *.mde; *.mdw|All(*.*)|*.*"
<end node> 5P9i0s8y19Z
<node>Crystal Reports
2
[[Crystal Reports]
reDb.ReportFileName = Tree + "mem1.rpt"
reDb.Destination = crptToWindow
'reDb.PrintFileName = Tree + "dog.rtf"
'reDb.PrintFileType = crptRTF
reDb.Action = 1
<end node> 5P9i0s8y19Z
<node>Data Control
2
Data Control]
.connect=";PWD=LoneRanger"
Occurs before a different record becomes the current record; before the Update method (except when data is saved with the UpdateRecord method); and before a Delete, Unload, or Close operation.
Syntax
Private Sub object_Validate ([ index As Integer,] action As Integer, save As Integer)
The Validate event syntax has these parts:
Part Description
object An object expression that evaluates to an object in the Applies To list.
index Identifies the control if it's in a control array.
action An integer that indicates the operation causing this event to occur, as described in Settings.
save A Boolean expression specifying whether bound data has changed, as described in Settings.
Settings
The settings for action are:
Constant Value Description
vbDataActionCancel 0 Cancel the operation when the Sub exits
vbDataActionMoveFirst 1 MoveFirst method
vbDataActionMovePrevious 2 MovePrevious method
vbDataActionMoveNext 3 MoveNext method
vbDataActionMoveLast 4 MoveLast method
vbDataActionAddNew 5 AddNew method
vbDataActionUpdate 6 Update operation (not UpdateRecord)
vbDataActionDelete 7 Delete method
vbDataActionFind 8 Find method
vbDataActionBookmark 9 The Bookmark property has been set
vbDataActionClose 10 The Close method
vbDataActionUnload 11 The form is being unloaded
The settings for save are:
Setting Description
True Bound data has changed
False Bound data has not changed
<end node> 5P9i0s8y19Z
<node>buttons
3
[[ buttons]
Private Sub btCompDb_Click(Index As Integer)
On Error Resume Next
Select Case Index
Case Is = 0
datPrimaryRS.Recordset.AddNew
Case Is = 1
With datPrimaryRS.Recordset
.Delete
.MoveNext
If .EOF Then .MoveLast
End With
Case Is = 2
datPrimaryRS.Refresh
Case Is = 3
datPrimaryRS.UpdateRecord
datPrimaryRS.Recordset.Bookmark = datPrimaryRS.Recordset.LastModified
Case Is = 4
datPrimaryRS.UpdateControls
'datPrimaryRS.Recordset.Bookmark = datPrimaryRS.Recordset.LastModified
Case Is = 5 'start individual
Data2.UpdateControls
'data2.Recordset.Bookmark = data2.Recordset.LastModified
Case Is = 6
Data2.Recordset.Fields("memberid") = datPrimaryRS.Recordset.Fields("memberid")
Data2.UpdateRecord
Data2.Recordset.Bookmark = Data2.Recordset.LastModified
Case Is = 7
Data2.Refresh
Case Is = 8
With Data2.Recordset
.Delete
.MoveNext
If .EOF Then .MoveLast
End With
Case Is = 9
Data2.Recordset.AddNew
End Select
End Sub
<end node> 5P9i0s8y19Z
<node>current record
3
[ Current Record]
Private Sub data2_Reposition()
Data2.Caption = "Record: " & (Data2.Recordset.AbsolutePosition + 1)
End Sub
<end node> 5P9i0s8y19Z
<node>Error
3
Error]
Private Sub datPrimaryRS_Error(DataErr As Integer, Response As Integer)
'This is where you would put error handling code
'If you want to ignore errors, comment out the next line
'If you want to trap them, add code here to handle them
MsgBox "Data error event hit err:" & Error$(DataErr)
Response = 0 'Throw away the error
End Sub
<end node> 5P9i0s8y19Z
<node>Properties
3
With dataStats
.DatabaseName = Tree2 + "ODBCTraverse.mdb"
.Connect = ";PWD=LoneRanger"
.Options = dbSeeChanges
.RecordSource = "SELECT * FROM dbo_tblBrBank"
End With
Returns or sets a value that specifies one or more characteristics of the Recordset object in the control's Recordset property.
object.Options [ = value ]
The Options property syntax has these parts:
Use one or more of the following values to set the Options property. If you use more than one option, you must add their values:
Constant Value Description
dbDenyWrite 1 In a multi-user environment, other users can't make changes to records in the Recordset.
dbDenyRead 2 In a multi-user environment, other users can't read records (table-type Recordset only).
dbReadOnly 4 You can't make changes to records in the Recordset.
dbAppendOnly 8 You can add new records to the Recordset, but you can't read existing records.
dbInconsistent 16 Updates can apply to all fields of the Recordset, even if they violate the join condition.
dbConsistent 32 (Default) Updates apply only to those fields that don't violate the join condition.
dbSQLPassThrough 64 When using Data controls with an SQL statement in the RecordSource property, sends the SQL statement to an ODBC database, such as a SQL Server or Oracle database, for processing.
dbForwardOnly 256 The Recordset object supports forward-only scrolling. The only move method allowed is MoveNext. This option cannot be used on Recordset objects manipulated with the Data control.
dbSeeChanges 512 Generate a trappable error if another user is changing data you are editing.
Remarks
For example, to set both dbAppendOnly and dbInconsistent you can use this code:
Data1.Options = dbAppendOnly + dbInconsistent
To determine if the property contains a specific value, you can use the And operator. For example, to find out if the Recordset is open for read-only access, you could use this code:
If Data1.Options And dbReadOnly Then…
Using both dbInconsistent and dbConsistent results in consistent updates, the default for Recordset objects.
Note The dbSQLPassThrough option can only be used when creating dynaset- or snapshot-type Recordset objects and is supported only to provide compatibility with previous versions. For better performance and functionality, you should use a previously created SQL PassThrough QueryDef object and set the Data control's Recordset property to a Recordset object created with the QueryDef.
Note If you attempt to access a SQL Server 6.0 table that includes an identity column, you can trigger an erroneous 3622 error. To prevent this problem, use the dbSeeChanges option with the Options property or OpenRecordset method.
Data Type
Integer
<end node> 5P9i0s8y19Z
<node>Reposition
3
[ Reposition]
Private Sub datPrimaryRS_Reposition()
Dim sqq$, id As Long, bk As String, rst As Recordset
On Error GoTo Data2RepostionErr
Screen.MousePointer = vbDefault
'This will display the current record position for dynasets and snapshots
id = datPrimaryRS.Recordset.Fields("memberid")
sqq = "Select * from individual where memberid= " + Str$(id) + ";"
Data2.RecordSource = sqq
Data2.Refresh
datPrimaryRS.Caption = "Record: " & (datPrimaryRS.Recordset.AbsolutePosition + 1)
552 Exit Sub
Data2RepostionErr:
Resume Next
End Sub
<end node> 5P9i0s8y19Z
<node>Save
3
[ Save]
Private Sub data2_Validate(Action As Integer, Save As Integer)
If Save = True Then Data2.Recordset.Fields("memberid") = datPrimaryRS.Recordset.Fields("memberid")
End Sub
<end node> 5P9i0s8y19Z
<node>Validate
3
Validate event
Private Sub datPrimaryRS_Validate(Action As Integer, Save As Integer)
'This is where you put validation code
'This event gets called when the following actions occur
Select Case Action
Case vbDataActionMoveFirst
Case vbDataActionMovePrevious
Case vbDataActionMoveNext
Case vbDataActionMoveLast
Case vbDataActionAddNew
Case vbDataActionUpdate
Case vbDataActionDelete
Case vbDataActionFind
Case vbDataActionBookmark
Case vbDataActionClose
'Stop
Screen.MousePointer = vbDefault
End Select
'Screen.MousePointer = vbHourglass
End Sub
<end node> 5P9i0s8y19Z
<node>Data List,Combo,Grid Control
2
Current Controls are Appex
Using tdb5 use the right mouse button to populate the grid with fields.
<end node> 5P9i0s8y19Z
<node>Combo
3
[[ Selections]
Private Sub dbc_Click(Area As Integer)
Dim rs As Recordset
Set rs = Data1.Recordset.Clone
rs.Bookmark = dbc.SelectedItem
txDb = rs.Fields("nameid")
End Sub
With coShow
.DropdownHeight = 4000
.DropdownWidth = 3000
.AlternatingRowStyle = True
.AutoCompletion = True
End With
<end node> 5P9i0s8y19Z
<node>Grid
3
[
[Dbgrid]
True data base grid. May be different form standard grid.
[ Locked]
Syntax object.Locked = boolean
Read/Write at run time and design time.
Property applies to Column object.
Description This property returns or sets a value indicating whether an
object can be edited.
1.If True, the user cannot modify data in the column.
If False (the default), the user can modify data in the column.
2.If the TDBGridS control's AllowUpdate property is set to False,
then editing is disabled for the entire grid regardless of the Locked property
setting for individual columns.
3.If AllowUpdate is True, then the Locked property can be used to control the
editability of individual columns.
Note!The default value of the Locked property for a column is not derived from the
DataUpdatable property for the underlying field. If both properties are False for
a column, then an error will occur when the grid attempts to write changed data to
the database.
<end node> 5P9i0s8y19Z
<node>Alignment
4
[ Alignment]
Syntax object.Alignment = value
Read/Write at run time and design time.
Property applies to Column object.
Values:
0 – Left (default)
1 – Right
2 – Center
3 – General
Description The Alignment property returns or sets a value that determines the
horizontal alignment of the values in a grid column object.
The General setting means that text will be left-aligned and
numbers will be right-aligned. This setting is only useful in bound mode,
where the grid can query the data source to determine the data types
of individual columns.
<end node> 5P9i0s8y19Z
<node>Check Box Add
4
[ Check box add]
Dim Item As New ValueItem
With TDBGrid1.Columns(3).ValueItems
Item.Value = 0
Item.DisplayValue = LoadPicture("C:\Program
Files\TDBG5\Bitmaps\Chkoff1.bmp")
.Add Item
Item.Value = -1
Item.DisplayValue = LoadPicture("C:\Program
Files\TDBG5\Bitmaps\Chkon1.bmp")
.Add Item
.Translate = True
.CycleOnClick = True
End With
he following code will allow the user to use the spacebar or a double
click to toggle the checkboxes on and off.
' Toggle check box on DblClick or a space bar
' Don 't forget to lock this column
Private Sub TDBGrid1_DblClick()
If TDBGrid1.Col = 3 Then ToggleVal
End Sub
Private Sub TDBGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeySpace And TDBGrid1.Col = 3 Then
ToggleVal
End If
End Sub
Private Sub ToggleVal()
With TDBGrid1
Select Case .Columns(3).Value
Case "0"
.Columns(3).Value = "-1"
Case "-1"
.Columns(3).Value = "0"
End Select
'.Update ' Optional
End With
End Sub
<end node> 5P9i0s8y19Z
<node>Colors
4
[ Colors]
get rid of grey
True DBGrid Pro 5.0 has a property that implements the behavior described above. Instead of using the API call mentioned
above, just set the grid's EmptyRows property to True.
got gocus
dbgA.BackColor = QBColor(10)
lost focus
dbgA.BackColor = QBColor(15)
enabled=false
dbgA.BackColor = QBColor(7)
end
Sub ColorRefresh(index As Integer)
TDB1.BackColor = &H80000005
TDB2.BackColor = &H80000005
TDB3.BackColor = &H80000005
TDB4.BackColor = &H80000005
TDB5.BackColor = &H80000005
Select Case index
Case Is = 1
TDB1.BackColor = &H80000001
Case Is = 2
TDB2.BackColor = &H80000001
Case Is = 3
TDB3.BackColor = &H80000001
Case Is = 4
TDB4.BackColor = &H80000001
Case Is = 5
TDB5.BackColor = &H80000001
End Select
End Sub
<end node> 5P9i0s8y19Z
<node>Column Order
4
[ Column order]
Original order: 0 1 2 3 4
TDBGrid1.Columns(3).Order = 0
New order: 3 1 2 0 4
TDBGrid1.Columns(2).Order = 1
New order: 3 2 1 0 4
TDBGrid1.Columns(4).Order = 2
New order: 3 2 4 1 0
TDBGrid1.Columns(0).Order = 3
New order: 3 2 4 0 1
TDBGrid1.Columns(1).Order = 4
New order: 3 2 4 0 1
—————————–
Final Result: 3 2 4 0 1
<end node> 5P9i0s8y19Z
<node>Columns
4
[ Columns]
i=tgdb1.columns.count
TDBGridS1.Columns(0).Caption = "Last Name"
<end node> 5P9i0s8y19Z
<node>After Column Update
5
[ After Column update]
'This fixes null dates or assigns calculated date
Dim v%, DD As Date
v = DBG1.Columns(2).Value
Select Case ColIndex
Case Is = 2
If v = -1 Then
frAccounting(1).Visible = True
DD = CalculateDate(Now, mBillDate)
If DBG1.Columns(3).Value = "" Then DBG1.Columns(3).Value = DD
coDate(1).Date = DD
coDate(1).SetFocus
Else
frAccounting(1).Visible = False
DBG1.Columns(3).Text = Null
End If
Case Is = 3
End Select
<end node> 5P9i0s8y19Z
<node>Combo In Field
4
[ Combo in field]
DBG1.Columns(1).ValueItems.Presentation = 2
To populate the grid's built-in combo box with the contents of a database table or recordset object, you will need to add items to the
ValueItems collection at run-time, via the collection's Add method. It is not possible to "bind" the built-in combo box directly to a database
table or data control.
This example assumes that column 2 will have the drop-down combo, and there is a data control, Data2, bound to a database table which
contains the data to populate the combo box. Also, assume that the underlying database value for each item is found in the "Code" field of the
recordset and the display value is found in the "Description" field.
Dim rs As Recordset
Data2.Refresh
Set rs = Data2.Recordset.Clone()
Dim VItem As New ValueItem
Dim VItems As ValueItems
Set VItems = TDBGrid1.Columns(2).ValueItems
rs.MoveFirst
While Not rs.Eof
VItem.Value = rs("Code")
VItem.DisplayValue = rs("Description")
VItems.Add VItem
rs.MoveNext
Wend
VItems.Translate = True
VItems.Presentation = dbgComboBox
<end node> 5P9i0s8y19Z
<node>Events
4
<end node> 5P9i0s8y19Z
<node>resize
5
Private Sub dbgC_RowResize(Cancel As Integer)
Cancel = True
End Sub
<end node> 5P9i0s8y19Z
<node>rowcolumnchange event
5
[ RowColumnChange_event]
Private Sub DBG1A_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
On Error Resume Next
DBG1A.SelBookmarks.Remove 0
If DBG1A.Col < 4 Then DBG1A.SelBookmarks.Add DBG1A.Bookmark
If DBG1A.Row = 0 Then DBG1A.Scroll 0, -2
If DBG1A.Columns(3).Text = "" Then DBG1A.Columns(3).Text = Null
If DBG1A.Columns(2).Value = -1 Then
frAccounting(0).Visible = True
coDate(0).Date = DBG1A.Columns(3).Text
coDate(0).SetFocus: DBG1A.SetFocus
If DBG1A.Col = 3 Then coDate(0).SetFocus
Else
frAccounting(0).Visible = False
End If
End Sub
[ Example]
dbgr.Columns(0).width = 3500: dbgr.Columns(0).Locked = True
dbgr.Columns(1).width = 0: dbgr.Columns(1).Locked = True
dbgr.Columns(2).width = 1200: dbgr.Columns(2).Alignment = 1: dbgr.Columns(2).Locked = True
dbgr.Columns(3).width = 500: dbgr.Columns(3).Alignment = 2
dbgr.Columns(4).width = 500: dbgr.Columns(4).Alignment = 2: dbgr.Columns(4).Locked = True
dbgr.Columns(5).width = 1000: dbgr.Columns(6).width = 3000
dbgr.Columns(7).width = 0: dbgr.Columns(7).Locked = True
<end node> 5P9i0s8y19Z
<node>unbound column
5
Private Sub TDBGrid1_UnboundColumnFetch(Bookmark As Variant, _
ByVal Col As Integer, Value As Variant)
RSClone.Bookmark = Bookmark
Value = RSClone.AbsolutePosition + 1
End Sub
[ Example 2 ]
Clone the data source the grid is bound too.
column 0 is unbound here
——
Private Sub DBG1_UnboundColumnFetch(Bookmark As Variant, ByVal Col As Integer, Value As Variant)
On Error Resume Next
Select Case Col
Case Is = 0
With mCLData4
.Bookmark = Bookmark
Value = .Fields("lastname") + ", " + .Fields("firstname")
End With
End Select
End Sub
Also, you may wish to turn off the RecordSelectors for a more "spreadsheet-like" appearance.
<end node> 5P9i0s8y19Z
<node>SelectedBookmark
4
LMultiple = DBG1.SelBookmarks.COUNT – 1
For LF = 0 To LMultiple
DBG1.Bookmark = DBG1.SelBookmarks.Item(LF)
With Data4.Recordset
.Bookmark = DBG1.Bookmark
.Delete
.MovePrevious
If Err <> 0 Then Err = 0: .MoveNext
End With
Next
<end node> 5P9i0s8y19Z
<node>Unbound column
4
[ Unbound column fetch]
Clone the recordset if information is needed to get a result. Set the VALUE = to the results.
[ Unbound column with bound column]
A clever way to do this in bound mode is to use the AbsolutePosition property of a recordset clone together with an unbound column to display
the row numbers. In your UnboundColumnFetch event, the Bookmark parameter gives you the bookmark of the row that the event is firing for.
Position the recordset clone to that bookmark and then query the AbsolutePosition (i.e., record number) of the current record in the clone. You
can then assign the value of the AbsolutePosition property to the Value argument of UnboundColumnFetch. Note that the data control
maintains the AbsolutePosition property itself, so when you add or delete a record, the AbsolutePosition of the records will still be correct
because the data control will do the necessary renumbering.
Special note: AbsolutePosition is zero-based, so if you want your row numbers to start with 1, then you need to add one to AbsolutePosition to
get your row number — this is done in the example below.
Dim RSClone As Recordset
<end node> 5P9i0s8y19Z
<node>List
3
[Td Data List]
mMultiple = dbCo1.SelBookmarks.Count – 1
For Lf = 0 To mMultiple
dbCo1.Bookmark = dbCo1.SelBookmarks.Item(Lf)
With Data1.Recordset
.Bookmark = dbCo1.Bookmark
frmDirectory.txtDirectory = .Fields("path")
frmDirectory.cmdChangeDir_Click
frmFileTransfers.txtGetSrcFilename = .Fields("exe")
Tree2 = .Fields("drivepath")
lafile(1) = .Fields("exe")
End WitH
NEXT
sample 2 is two data control link
sample 7 is triangle with column sort
<end node> 5P9i0s8y19Z
<node>row Change
4
[ rowchange]
liReservation (0)
If .Row = 0 Then .Scroll 0, -2
End With
'note moves cloned recordset and assign modular variable
With mCLData5
.Bookmark = liReservation(0).Bookmark
mReservId = .Fields("reservationid")
End With
<end node> 5P9i0s8y19Z
<node>selection
4
LMultiple = liIndivall.SelBookmarks.Count – 1
For lF = LMultiple To 0 Step -1
liIndivall.Bookmark = liIndivall.SelBookmarks.Item(lF)
mCLData6.Bookmark = liIndivall.Bookmark
LIndid = mCLData6(cIndId)
With Data7.Recordset
.AddNew
.Fields("committeeid") = mComId
.Fields(cIndId) = LIndid
.Fields("billable") = LBill
.Update
End With
liIndivall.SelBookmarks.Remove lF
Next
<end node> 5P9i0s8y19Z
<node>Selecting Records
3
[ Selecting record]
Private Sub DBG1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
On Error Resume Next
DBG1.SelBookmarks.Remove 0
DBG1.SelBookmarks.Add DBG1.Bookmark
If DBG1.Row = 0 Then DBG1.Scroll 0, -2
End Sub
<end node> 5P9i0s8y19Z
<node>Dhtml Edit
2
[ctrl]
A=SELECT ALL
B=BOLD
F=FIND
I=ITALICS
L=HYPERLINK
P=PRINT
T=INDENT
Z=UNDO
<end node> 5P9i0s8y19Z
<node>Faxman
2
Long File names are not allowed in print drivers.
AutoReceive – Default is OFF. When set to ON, the server will prepare each receive-enabled
faxmodem to receive faxes. The only practical side-effect to having this ON is that
each port setup for reception will be inaccessible to any other application. Note that if this
setting is changed from ON to OFF, all receive ports will be reset at the first opportunity,
making the ports available (if a fax is actually being received when this is toggled, it will NOT
be cancelled; the port will be freed when the receive process is complete).
ReceivePath – Default is the directory containing the FaxMan server (FAXMAN.EXE). This
should be set to the path in which the user wants all received faxes to be placed. If the path
is invalid, the faxes will be placed in the FaxMan server directory.
BannerFont – BannerFont is set to the name of the typeface to use for the banner. For
example BannerFont=Arial, Courier, Times New Roman, etc. This property is implemented
in the 32-bit server only.
BannerSize – BannerSize allows the user to specify the size of the BannerFont. BannerSize
is set to the height of the font in 200 dpi units, for example a value of 20 would be 1/10" tall.
This property is implemented in the 32-bit server only.
Hidden – Set to TRUE or ON to force the server to always startup in hidden mode.
Note: We have implemented a very handy, new feature in Version 3.x and later. We now
have the ability to write all the debug information from each attached device to its own
unique file. To take advantage of this new feature, you will need to make changes to the
fm3032.ini file, using the three options below, under the required additional section name
[Debug]
SingleSession – "ON" or "YES" or "TRUE" FaxMan will erase any current debug logs when
it starts. Otherwise, FaxMan will continue appending to any existing debug logs giving you
the ability to log the debug information across multiple FaxMan sessions.
SplitPorts – "ON" or "YES" or "TRUE" debug output for each attached device will be written
to its own individual log. The files are named portNN.log where NN corresponds to the comm
port number (01 through 20) on which the device is attached. These files are written in the
same directory where the FaxMan exe is running.
MaxFileSize – specifies the maximum file size, in bytes, that a log can acquire before it is
erased and a new debug log will be started.
A sample fm3032.ini file contents:
[FaxGeneral]
AutoShutdown=ON
AutoReceive=OFF
[Debug]
SingleSession=YES
SplitPorts=YES
MaxFileSize=100000
<end node> 5P9i0s8y19Z
<node>forms
2
Gradient Background
If you look at any modern application's installation routine, you will notice that the main background of the install system consists of a graduated color running from blue at the top to black at the bottom. Note: An exception to this rule are most Microsoft install screens, which are a solid green color (boring!).
Many applications can benefit from an injection of vibrant color to the form, so let's take a look at the code used to create a crazy gradient background.
Step 1: Open Visual Basic
Step 2: Set the "AutoRedraw" property of Form 1 to True
Step 3: Add the following code to the load event of Form 1
Dim intY As Integer
Form1.Scale (0, 0)-(500, 500)
For intY = 0 To 500
Form1.Line (0, intY)-(500, intY), RGB(0, 0, CInt((intY / 500) * 255))
Next
Step 4: Run the program!
Voila – a form should appear that looks something like this:
Let's take a look at how this code works, line by line.
Form1.Scale (0, 0)-(500, 500)
This is used to set the scale on the form. After executing this line, the top left hand pixel of the form will be at coordinates (0,0) and the bottom right pixel will be (500,500).
Form1.Line (0, intY)-(500, intY), RGB(0, 0, CInt((intY / 500) * 255))
This code is executed 500 times, with the intY variable incremented by one each time. This line of code draws a horizontal line from the left hand side of the form to the right, in a color calculated by the RGB function. The RGB function accepts three values – Red, Green and Blue. In this case, the blue value is calculated by taking a ratio of the intY variable compared to the maximum height of the form (500), and multiplying by 255 (the maximum color code possible.)
Customising Code
If you just want to create an installation program with the standard black to blue background, you can stop reading now. However, if you would like to create something altogether more funky… take a look at this code that allows you to specify the start and end colors of the gradient.
Dim intY As Integer
Dim intStartRed As Integer
Dim intStartGreen As Integer
Dim intStartBlue As Integer
Dim intEndRed As Integer
Dim intEndGreen As Integer
Dim intEndBlue As Integer
Dim sngStepRed As Single
Dim sngStepGreen As Single
Dim sngStepBlue As Single
Dim intRed As Integer
Dim intGreen As Integer
Dim intBlue As Integer
intStartRed = 0
intStartBlue = 0
intStartGreen = 0
intEndRed = 255
intEndBlue = 255
intEndGreen = 255
sngStepRed = ((intEndRed – intStartRed) / 500)
sngStepGreen = (intEndGreen – intStartGreen) / 500
sngStepBlue = (intEndBlue – intStartBlue) / 500
Form1.Scale (0, 0)-(500, 500)
For intY = 0 To 500
intRed = intStartRed + (sngStepRed * intY)
intGreen = intStartGreen + (sngStepGreen * intY)
intBlue = intStartBlue + (sngStepBlue * intY)
Form1.Line (0, intY)-(500, intY), RGB(intRed, intGreen, intBlue)
Next
Phew! That's quite a lot of code to just create a fancy background color, but this code give you the flexibility to choose the start and end colors. In this case, the gradient goes from Red=0, Green=0 and Blue=0 to Red=255, Green=255 and Blue = 255. In other words, this code creates a gradient that goes from Black to White. It's possible to create pretty much any gradient with this code, so have a play!
<end node> 5P9i0s8y19Z
<node>internet
2
shdocvw.dll
Option Explicit
Public StartingAddress As String
Dim mbDontNavigateNow As Boolean
Private Sub Form_Load()
On Error Resume Next
Me.Show
tbToolBar.Refresh
Form_Resize
cboAddress.Move 50, lblAddress.Top + lblAddress.Height + 15
If Len(StartingAddress) > 0 Then
cboAddress.Text = StartingAddress
cboAddress.AddItem cboAddress.Text
'try to navigate to the starting address
timTimer.Enabled = True
brwWebBrowser.Navigate StartingAddress
End If
End Sub
Private Sub brwWebBrowser_DownloadComplete()
On Error Resume Next
Me.Caption = brwWebBrowser.LocationName
End Sub
Private Sub brwWebBrowser_NavigateComplete(ByVal URL As String)
Dim i As Integer
Dim bFound As Boolean
Me.Caption = brwWebBrowser.LocationName
For i = 0 To cboAddress.ListCount – 1
If cboAddress.List(i) = brwWebBrowser.LocationURL Then
bFound = True
Exit For
End If
Next i
mbDontNavigateNow = True
If bFound Then
cboAddress.RemoveItem i
End If
cboAddress.AddItem brwWebBrowser.LocationURL, 0
cboAddress.ListIndex = 0
mbDontNavigateNow = False
End Sub
Private Sub cboAddress_Click()
If mbDontNavigateNow Then Exit Sub
timTimer.Enabled = True
brwWebBrowser.Navigate cboAddress.Text
End Sub
Private Sub cboAddress_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = vbKeyReturn Then
cboAddress_Click
End If
End Sub
Private Sub Form_Resize()
cboAddress.Width = Me.ScaleWidth – 100
brwWebBrowser.Width = Me.ScaleWidth – 100
brwWebBrowser.Height = Me.ScaleHeight – (picAddress.Top + picAddress.Height) – 100
End Sub
Private Sub timTimer_Timer()
If brwWebBrowser.Busy = False Then
timTimer.Enabled = False
Me.Caption = brwWebBrowser.LocationName
Else
Me.Caption = "Working…"
End If
End Sub
Private Sub tbToolBar_ButtonClick(ByVal Button As Button)
On Error Resume Next
timTimer.Enabled = True
Select Case Button.Key
Case "Back"
brwWebBrowser.GoBack
Case "Forward"
brwWebBrowser.GoForward
Case "Refresh"
brwWebBrowser.Refresh
Case "Home"
brwWebBrowser.GoHome
Case "Search"
brwWebBrowser.GoSearch
Case "Stop"
timTimer.Enabled = False
brwWebBrowser.Stop
Me.Caption = brwWebBrowser.LocationName
End Select
End Sub
<end node> 5P9i0s8y19Z
<node>List box
2
<end node> 5P9i0s8y19Z
<node>delete
3
Private Sub liFiles_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 46 Then
m% = MsgBox("Confirm Entry Delete", 33, "File Names Only")
If m% = 2 Then Exit Sub
NU% = liFiles.ListCount – 1
For I% = NU% To 0 Step -1
If liFiles.Selected(I%) = True Then
liFiles.RemoveItem (I%)
End If
Next
End If
End Sub
<end node> 5P9i0s8y19Z
<node>Selection
3
Selection]
nu% = file1.ListCount – 1
For i% = 0 To nu%
If file1.Selected(i%) = True Then
a$ = file1.List(i%)
End If
Next
<end node> 5P9i0s8y19Z
<node>picturebox
2
paint image on the form
Public Sub ResizeImage()
On Error GoTo errorHandler
ScaleRatio = Image1.ScaleWidth / Image1.ScaleHeight
If Image1.Height < Me.Height And Image1.Width < Me.Width Then Me.PaintPicture Image1, 0, 0, Image1.Width, Image1.Height: Exit Sub
If Image1.Height < Me.Height Then GoTo 743
Me.Width = ScaleRatio * Me.Height
If Me.Width > Main.Width – Me.Left Then
Me.Width = Main.Width – Me.Left
Me.Height = Me.Width / ScaleRatio
End If
'Calculates width based on the form height
743 SWidth = Me.ScaleHeight * ScaleRatio
'This removes the picture trail that is created when the form height
'is reduced. Setting the autodraw property to true will also do this
'but increases the drawtime dramatically. Clearing the screen completely
'causes flickering. This technique provides a fast smooth transition.
Me.Line (X1, 0)-(SWidth, Y1), Me.BackColor, BF
'Draws proportionate picture
Me.PaintPicture Image1, 0, 0, SWidth, Me.ScaleHeight
'Stores Clipping area width and height
X1 = Me.ScaleHeight * ScaleRatio
Y1 = Me.ScaleHeight
errorHandler:
Exit Sub
End Sub
<end node> 5P9i0s8y19Z
<node>Registry
2
SaveSetting
GetSetting
<end node> 5P9i0s8y19Z
<node>Reports
2
[Report]
Private Sub PageFooter_Format()
lblpage = "Page: " & Str$(Me.pageNumber)
End Sub
[ Alpha break]
'global rst and Letter
dim rst as recordset,Letter$
'add last two line code
Private Sub ActiveReport_ReportStart()
Dim sq$
rpData1.DatabaseName = Tree2 + "membership.mdb"
sq = "SELECT Reservation.reservationid,Reservation.description, membership.memberid, membership.CompanyName "
sq = sq + "FROM Reservation INNER JOIN (membership INNER JOIN (Individual INNER JOIN ReservationAssign ON Individual.individualid = ReservationAssign.individualid) ON membership.memberid = Individual.memberid) ON Reservation.reservationid = ReservationAssign.reservationid "
sq = sq + "Where reservation.reservationid=" + Str$(gResId)
sq = sq + " UNION SELECT Reservation.reservationid,Reservation.description, membership.memberid, membership.CompanyName "
sq = sq + "FROM membership INNER JOIN (Reservation INNER JOIN ResNonMemberAssign ON Reservation.reservationid = ResNonMemberAssign.reservationid) ON membership.memberid = ResNonMemberAssign.memberid "
sq = sq + "Where reservation.reservationid=" + Str$(gResId)
sq = sq + " ORDER BY membership.CompanyName"
rpData1.RecordSource = sq
rpData1.Refresh
Set rst = rpData1.Recordset.Clone
rst.MoveFirst: Letter = Left$(rst("companyname"), 1)
.
'Access detail format add detail.newpage
Private Sub Detail_Format()
On Error GoTo detailerr
gMemberId = rpData1.Recordset.Fields("memberid")
Set srptMember.object = New rptResMember
Set srptGuest.object = New rptResGuests
Detail.NewPage = ddNPNone
With rpData1.Recordset
rst.MoveNext
If Letter <> Left$(rst.Fields("companyname"), 1) Then Detail.NewPage = ddNPAfter
Letter = Left$(rst.Fields("companyname"), 1)
End With
Detail.PrintSection
Exit Sub
detailerr:
End Sub
<end node> 5P9i0s8y19Z
<node>Printer
3
[[ Printer]
With rptPermit1
.PrintWidth = 7.5 * 1440
.PageLeftMargin = 0.3 * 1440
.PageRightMargin = 0 * 1440
End With
With rptPermit1.Printer
.PaperWidth = 8 * 1440
End With
<end node> 5P9i0s8y19Z
<node>Sub Reports
3
<end node> 5P9i0s8y19Z
<node>cancel
4
[ Cancel sub report]
Private Sub ActiveReport_ReportStart()
Dim sq$
rpdata1.DatabaseName = Tree2 + "membership.mdb"
sq = "SELECT ResNonMemberAssign.memberid," 'ResNonMemberAssign.member,"
sq = sq + "ResNonMemberAssign.Name, membership.CompanyName, ResNonMemberAssign.Description, ResNonMemberAssign.Cost, ResNonMemberAssign.Method "
sq = sq + "FROM membership INNER JOIN ResNonMemberAssign ON membership.memberid = ResNonMemberAssign.memberid"
sq = sq + " Where resnonmemberassign.reservationid=" + Str$(gResId) + " AND ResNonMemberAssign.memberid=" + Str$(gMemberId)
sq = sq + " Order by resnonmemberassign.name"
rpdata1.RecordSource = sq
rpdata1.Refresh
' This code does it here
If rpdata1.Recordset.EOF = True And rpdata1.Recordset.BOF = True Then
GroupHeader1.Height = 0: Detail.Height = 0
End If
End Sub
<end node> 5P9i0s8y19Z
<node>In detail
4
Private Sub Detail_Format()
Static bPrinted As Boolean
If Not bPrinted Then ' Print it once
' Adjust the database Name
Set srptTop10Products.object = New rptTop10Products
srptTop10Products.object.dcRptData.DatabaseName = m_sDBName
Set srptTop10Customers.object = New rptTop10Customers
srptTop10Customers.object.dcRptData.DatabaseName = m_sDBName
Detail.PrintSection
bPrinted = True
End If
<end node> 5P9i0s8y19Z
<node>text box
3
<end node> 5P9i0s8y19Z
<node>sum
4
[ text box sum]
With Field16
.DataField = "Total": .Alignment = ddTXRight: .Font.Size = Lsize
.SummaryGroup = GroupHeader1: .SummaryRunning = ddSRGroup: .SummaryType = ddSMSubTotal
End With
<end node> 5P9i0s8y19Z
<node>tool bar
3
[ Tool bar]
ARViewer2.ToolBar.Tools.Add "Stop"
Private Sub ARViewer2_ToolbarClick(ByVal tool As DDActiveReportsViewerCtl.DDTool)
If tool.Caption = "Stop" Then
If Not ARViewer2.ReportSource Is Nothing Then
ARViewer2.ReportSource.Stop
MsgBox "Report Stopped"
End If
End If
End Sub
*********************
ARViewer1.ToolBar.Tools.Add "Wide"
ARViewer1.ToolBar.Tools.Add "Stop"
'******
Private Sub ARViewer1_ToolbarClick(ByVal tool As DDActiveReportsViewerCtl.DDTool)
With ARViewer1
Select Case tool.Caption
Case Is = "Stop"
If Not .ReportSource Is Nothing Then
.ReportSource.Stop
MsgBox "Report Stopped"
End If
Case Is = "Wide"
.Left = 0
tool.Caption = "Back"
.Zoom = 100
Hold 5
.Visible = False
.Width = Me.Width
.Visible = True
Case Is = "Back"
.Left = paAction(2).Left + paAction(2).Width
tool.Caption = "Wide"
.Zoom = 75
Hold 5
.Visible = False
.Width = Me.Width – ARViewer1.Left
.Visible = True
End Select
Hold 10
End With
End Sub
<end node> 5P9i0s8y19Z
<node>runtime
2
Option Explicit
Private WithEvents NewTextBox As TextBox
Private WithEvents NewCommandButton As CommandButton
Private Sub Form_Load()
Set NewTextBox = Controls.Add(“VB.textbox”, “textbox”)
Set NewCommandButton = Controls.Add(“VB.commandbutton”,
“commandbutton”)
NewTextBox.Visible = True
NewTextBox.Width = 2000
NewTextBox.Text = “This is created by sidhu”
NewTextBox.Top = 200
NewTextBox.Left = 1000
NewCommandButton.Visible = True
NewCommandButton.Width = 2000
NewCommandButton.Caption = “I m New”
NewCommandButton.Top = 1000
NewCommandButton.Left = 1000
End Sub
<end node> 5P9i0s8y19Z
<node>TabPro
2
[Alpha Tab]
Private Sub tabAlpha_TabPageShown(ActiveTab As Integer, ActivePage As Integer)
Dim a$
On Error Resume Next
Screen.MousePointer = 11
a$ = Chr$(ActiveTab + 65)
With Data1(0).Recordset
.MoveFirst
.FindFirst "companyname like('" + a$ + "*')"
liCompany.Bookmark = .Bookmark
End With
With Data1(1).Recordset
.MoveFirst
.FindFirst "othername like('" + a$ + "*')"
liMisc.Bookmark = .Bookmark
End With
With txAlpha(0)
.Text = UCase$(a$)
.SelStart = 1
.SetFocus
End With
Screen.MousePointer = 0
End Sub
<end node> 5P9i0s8y19Z
<node>Cancel tab switch
3
To prevent moving to another tab set the TabToActivate parameter in the
TabActivate event to -1. This will prevent the switching of tabs. We have
had problems with the Sheridan panels before. I would suggest using the
Imprint control that ships with TabPro as there won't be any conflicts.
Private Sub tabReservation_TabActivate(TabToActivate As Integer)
If TabToActivate = 2 Then If mBlock = 0 Then TabToActivate = -1
End Sub
<end node> 5P9i0s8y19Z
<node>Text Box
2
<end node> 5P9i0s8y19Z
<node>Alpha Search
3
Alpha Text]
Private Sub txAlpha_Change(Index As Integer)
Dim tx As TextBox
On Error Resume Next
Set tx = txAlpha(Index)
Screen.MousePointer = 11
If Right$(tx, 1) = " " Then tx = ""
Select Case Index
Case Is = 0
With Data1(0).Recordset
If Len(tx) < 2 Then
.MoveFirst
.FindFirst "companyname like('" + tx + "*')"
Else
.FindNext "companyname like('" + tx + "*')"
End If
liCompany.Bookmark = .Bookmark
End With
With Data1(1).Recordset
If Len(tx) < 2 Then
.MoveFirst
.FindFirst "othername like('" + tx + "*')"
Else
.FindNext "othername like('" + tx + "*')"
End If
liMisc.Bookmark = .Bookmark
End With
Case Is = 1
With Data2.Recordset
If Len(tx) < 2 Then
.MoveFirst
.FindFirst "transactionnumber =" + tx
Else
.FindNext "transactionnumber =" + tx
End If
End With
End Select
Screen.MousePointer = 0
End Sub
<end node> 5P9i0s8y19Z
<node>Select Text
3
[ select text]
With txChargeS
.SelStart = 0: .SelLength = Len(.Text)
End With
<end node> 5P9i0s8y19Z
<node>size from record
3
Text box]
preload size from table information
dim tbl as tabledef
Set tbl = mDb.TableDefs("cashreceipts")
With txCash(0)
.DataField = "Check"
.MaxLength = tbl.Fields("Check").Size
End With
With txCash(1)
.DataField = "Amount"
.MaxLength = 10
End With
[ move next]
If KeyAscii = 13 Then SendKeys "{tab}", True: KeyAscii = 0
<end node> 5P9i0s8y19Z
<node>Database
1
Option Explicit
Private daoDB36 As Database
Private rs As DAO.Recordset
Dim sPath As String
Private Sub Form_Load()
sPath = _
"C:\Program Files\Microsoft Office\Office\Samples\Northwind.mdb"
Set daoDB36 = DBEngine(0).OpenDatabase(sPath)
Set rs = daoDB36.OpenRecordset("Customers")
Set Data1.Recordset = rs
End Sub
dao360.dll 3.60.3714.5 557,328
msexch40.dll 4.0.4331.7 512,272
msexcl40.dll 4.0.4331.3 319,760
msjet40.dll 4.0.4431.1 1,503,504
msjetoledb40.dll 4.0.4331.4 348,432
msjtes40.dll 4.0.4229.0 241,936
msltus40.dll 4.0.4331.3 213,264
mspbde40.dll 4.0.4331.6 348,432
msrd3x40.dll 4.0.4325.0 315,664
msrepl40.dll 4.0.4331.0 553,232
msrpfs40.dll 4.0.4314.0 74,000
mstext40.dll 4.0.4331.5 254,224
mstrai40.exe 4.0.3714.0 37,136
mstran40.exe 4.0.3714.0 45,328
msxbde40.dll 4.0.4331.6 344,336
NOTE
<end node> 5P9i0s8y19Z
<node>ADO
2
Note! the ADO data objects 2.5 library need to be selected
Dim WithEvents adoPrimaryRS As Recordset
Dim mbChangedByCode As Boolean
Dim mvBookMark As Variant
Dim mbEditFlag As Boolean
Dim mbAddNewFlag As Boolean
Dim mbDataChanged As Boolean
Private Sub Form_Load()
Dim db As Connection
Set db = New Connection
db.CursorLocation = adUseClient
db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=D:\dev\vb6files\test\laura2\THursday's Homewrok\IGA.mdb;"
Set adoPrimaryRS = New Recordset
adoPrimaryRS.Open "select fldCategoryID,fldEmployeeID,fldHireDate,fldHourlyWage,fldName from tblPayrollMaster", db, adOpenStatic, adLockOptimistic
Dim oText As TextBox
'Bind the text boxes to the data provider
For Each oText In Me.txtFields
Set oText.DataSource = adoPrimaryRS
Next
mbDataChanged = False
End Sub
'******************************************************************************
Private Sub Form_Load()
With ADODC1
.ConnectionString = "driver={SQL Server};" & _
"server=bigsmile;uid=sa;pwd=pwd;database=pubs"
.RecordSource = "Select * From Titles Where AuthorID = 7"
End With
Set Text1.DataSource = ADODC1
Text1.DataField = "Title"
End Sub
The ADO Data control features several events that you can program. The table below shows the events and when they occur; however the table is not meant to be a complete list all of the conditions when the events occur. For complete information, see the reference topic for the individual event.
Event Occurs
WillMove
On Recordset.Open, Recordset.MoveNext, Recordset.Move, Recordset.MoveLast, Recordset.MoveFirst, Recordset.MovePrevious, Recordset.Bookmark, Recordset.AddNew, Recordset.Delete, Recordset.Requery, Recordset.Resync
—————————-
MoveComplete
After WillMove
—————————
WillChangeField
Before the Value property changes
————————————
FieldChangeComplete
After WillChangeField
————
WillChangeRecord
On Recordset.Update, Recordset.Delete, Recordset.CancelUpdate, Recordset.UpdateBatch, Recordset.CancelBatch
————————-
RecordChangeComplete
After WillChangeRecord
——-
WillChangeRecordset
On Recordset.Requery, Recordset.Resync, Recordset.Close, Recordset.Open, Recordset.Filter
—————–
RecordsetChangeComplete
After WillChangeRecordset
—–
InfoMessage
When the data provider returns a result
****************************************************
Dim WithEvents adoPrimaryRS As Recordset
Dim mbChangedByCode As Boolean
Dim mvBookMark As Variant
Dim mbEditFlag As Boolean
Dim mbAddNewFlag As Boolean
Dim mbDataChanged As Boolean
Dim db As Connection
Set db = New Connection
db.CursorLocation = adUseClient
db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=D:\dev\vb6files\test\laura2\THursday's Homewrok\IGA.mdb;"
Set adoPrimaryRS = New Recordset
adoPrimaryRS.Open "select fldCategoryID,fldEmployeeID,fldHireDate,fldHourlyWage,fldName from tblPayrollMaster", db, adOpenStatic, adLockOptimistic
Dim oText As TextBox
'Bind the text boxes to the data provider
For Each oText In Me.txtFields
Set oText.DataSource = adoPrimaryRS
Next
mbDataChanged = False
**********************************************
Dim myConnection As ADODB.Connection
Dim myRecordset As ADODB.Recordset
Set myConnection = New ADODB.Connection
Set myRecordset = New ADODB.Recordset
myConnection.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=c:\BegDB\Biblio.mdb"
'-Open the connection —
myConnection.Open
'Determine if we conected.
If myConnection.State = adStateOpen Then
myRecordset.Open "SELECT * FROM TITLES", myConnection, _
adOpenDynamic, adLockOptimistic, adCmdTable
Else
MsgBox "The connection could not be made."
myConnection.Close
Exit Sub
End If
'-just to be sure —
myRecordset.MoveFirst
On Error GoTo transError
'-here is the top of the transaction sandwich —
myConnection.BeginTrans
While Not myRecordset.EOF
mcounter = mcounter + 1
myRecordset!Title = myRecordset!Title & "" 'so we don't really change it
myRecordset.Update
myRecordset.MoveNext
Wend
'-if we got here ok, then everything is written at once
myConnection.CommitTrans
myRecordset.Close
myConnection.Close
Exit Sub
transError:
myConnection.RollBack
myRecordset.Close
myConnection.Close
MsgBox Err.Description
<end node> 5P9i0s8y19Z
<node>Compact Database
2
screen.MousePointer = 11
CompactDatabase tree + "Bratton.MDB", tree + "Bratton2.MDB"
Kill tree + "bratton.mdb"
Name tree + "bratton2.mdb" As tree + "bratton.mdb"
screen.MousePointer = 0
R = GetIni("Database", "fix", Tree2 + INN): If R = "none" Then R = DateValue(Now): WriteIni "Database", "fix", R, Tree2 + INN
A = GetIni("Database", "days", Tree2 + INN)
Select Case Val(A)
Case Is = 0
A = "30": WriteIni "Database", "days", A, Tree2 + INN
Case Is > 120
A = "120": WriteIni "Database", "days", A, Tree2 + INN
End Select
If DateValue(Now) – DateValue(R) > Val(A) And Dir(Tree2 + "west.ldb") = "" Then
DBEngine.RepairDatabase Tree2 + "membership.mdb"
CompactDatabase Tree2 + "west.mdb", Tree2 + "west2.mdb"
Kill Tree2 + "west.mdb"
Name Tree2 + "west2.mdb" As Tree2 + "west.mdb"
WriteIni "Database", "fix", DateValue(Now), Tree2 + INN
Screen.MousePointer = 0
End If
<end node> 5P9i0s8y19Z
<node>connect
2
'Enter this code in the form load 🙂
With data1
.Connect = "Access 2000;"
.Refresh
.Connect = ";Pwd=" & "password"
.DatabaseName = App.path & "/database.mdb"
.RecordSource = "MyTable"
.Refresh
End With
<end node> 5P9i0s8y19Z
<node>count
2
SELECT Count(Individual.LastName) AS people, membership.CompanyName
FROM membership left JOIN Individual ON membership.memberid = Individual.memberid
WHERE (((membership.Roster)=-1))
GROUP BY membership.CompanyName, Individual.Roster
HAVING (((Individual.Roster)=-1));
sum boolean field to get a count
SELECT Sum(Individual.Roster) AS people, membership.CompanyName
FROM membership INNER JOIN Individual ON membership.memberid = Individual.memberid
WHERE (((membership.Roster)=-1))
GROUP BY membership.CompanyName
ORDER BY Sum(Individual.Roster) DESC , membership.CompanyName;
<end node> 5P9i0s8y19Z
<node>Create Database
2
Note I discovered that creating new fields did not work until I placed rst in with rst:end with levels
<end node> 5P9i0s8y19Z
<node>index
3
Set rst = db!GLDistribution
With rst
Set iddx = .CreateIndex("ChargeCodeIdKey")
iddx.Fields.Append .CreateField("ChargeCodeId")
.Indexes.Append iddx
Set iddx = .CreateIndex("ChargeCodeNumKey")
iddx.Fields.Append .CreateField("ChargeCodeId")
iddx.Fields.Append .CreateField("Number")
iddx.Unique = True
.Indexes.Append iddx
End With
<end node> 5P9i0s8y19Z
<node>Relations
3
[ Relations]
Set RstPr = Db![Form]: Set Rst = Db![Tab]
Set rel = Db.CreateRelation("formidlink", RstPr.Name, Rst.Name, dbRelationDeleteCascade)
rel.Fields.Append rel.CreateField("formid")
rel.Fields![formid].ForeignName = "formid"
Db.Relations.Append rel
<end node> 5P9i0s8y19Z
<node>startup
3
Dim wrk As Workspace, Rst As TableDef, RstPr As TableDef, que As QueryDef, rel As Relation
Dim iddx As index, noundx As index, idnoun As index, Rst1 As Recordset, idMark As Long
Screen.MousePointer = 11
On Error GoTo newdatabaseerr
'Create Database******************************************
Set wrk = DBEngine.Workspaces(0)
Set Db = wrk.CreateDatabase(Tree + "tablebuild.mdb", dbLangGeneral)
or Set db = wrk.CreateDatabase(Tree2 + "UserList.mdb", dbLangGeneral & ";pwd=LoneRanger")
'db.NewPassword "", "dirt"
<end node> 5P9i0s8y19Z
<node>Tables
3
[ Tables]
Set Rst = Db.CreateTableDef("form")
With Rst
.Fields.Append .CreateField("formid", dbLong)
![formid].Attributes = dbAutoIncrField
.Fields.Append .CreateField("order", dbInteger)
.Fields.Append .CreateField("FormName", dbText, 25)
.Fields.Append .CreateField("RelatedInfo", dbText, 255)
.Fields.Append .CreateField("memo", dbMemo)
End With
Db.TableDefs.Append Rst
<end node> 5P9i0s8y19Z
<node>Database
2
[Locators]
[ Increment]
Private Sub txLoc_Change()
Dim rst As Recordset
Set rst = Data1.Recordset.Clone
With rst
If Len(txLoc) < 2 Then
.MoveFirst
.FindFirst "name like('" + txLoc + "*')"
Else
.FindNext "name like('" + txLoc + "*')"
End If
If .NoMatch = True Then Exit Sub
Data1.Recordset.Bookmark = rst.Bookmark
End With
End Sub
[ Range Fill]
Private Sub txLoc_Change()
Call AlphaChange(txLoc)
End Sub
Sub AlphaChange(abc$)
Static lv$
Dim sqq$, l%, ap$, af$, rst As Recordset
On Error Resume Next
abc = UCase$(abc)
l = Asc(abc)
If lv$ = abc Then Exit Sub
lv$ = abc
ap = abc: af = Chr$(l + 1)
''phone is example table
Select Case abc
Case Is = "*"
sqq = "select * from phone"
Case Is = "Z"
sqq = "select * from phone where name >= 'z'"
Case Else
sqq = "select * from phone where name between '" + ap + "' and '" + af + "'"
End Select
Data1.RecordSource = sqq
Data1.Refresh
Set rst = Data1.Recordset.Clone
rst.MoveFirst
List1.Clear: List2.Clear
Do
List1.AddItem rst.Fields("name")
rst.MoveNext
Loop Until rst.EOF
[Patching existing database]
Sub PatchMemberDatabase()
Dim rst As TableDef, pDB As Database, fld As Field, rct As Recordset, pErr As Boolean
Dim iddx As Index, rel As Relation, RstPr As TableDef, rstMem As Recordset
On Error Resume Next
Set pDB = OpenDatabase(Tree2 + "membership.mdb")
Set rst = pDB.TableDefs!Individual
rst.Indexes.Delete "hbanokey"
Set fld = rst.Fields("Charge")
If Err = 0 Then
With rst
.Fields.Delete ("Charge")
If Err > 0 Then pErr = True
End With
End If ''delete charge
Err = 0
Set fld = rst.Fields("BillCycle")
If Err > 0 Then
Err = 0
With rst
.Fields.Append .CreateField("BillCycle", dbByte) 'months
.Fields.Append .CreateField("DueDays", dbByte) 'days
.Fields.Append .CreateField("RecordType", dbByte) '0-3 pe mi
End With
If Err > 0 Then pErr = True
Err = 0
End If
Set rst = pDB.TableDefs!chargecodes
Set fld = rst.Fields("month")
If Err = 0 Then rst.Fields.Delete ("month")
Err = 0
Set rst = pDB.TableDefs!ChapterMailList
If Err = 0 Then
pDB.TableDefs.Delete "ChapterMailList"
If Err <> 0 Then pErr = True
pDB.TableDefs.Delete "Individualchaptermaillink"
End If
Set rst = pDB.TableDefs!ChapterMailList
If Err > 0 Then
Err = 0
Set rst = pDB.CreateTableDef("ChapterMailList")
With rst
.Fields.Append .CreateField("Individualid", dbLong)
.Fields.Append .CreateField("chapterid", dbLong)
End With
pDB.TableDefs.Append rst
Set rst = pDB!ChapterMailList
With rst
Set iddx = .CreateIndex("chapteridkey")
iddx.Fields.Append .CreateField("chapterid")
.Indexes.Append iddx
Set iddx = .CreateIndex("IndivChapterkey")
iddx.Fields.Append .CreateField("individualid")
iddx.Fields.Append .CreateField("chapterid")
.Indexes.Append iddx
End With
Select Case Err
Case Is > 0
pErr = True
Case Else
End Select
End If
Err = 0
Set RstPr = pDB!Individual: Set rst = pDB!ChapterMailList
Set rel = pDB.CreateRelation("Individualchaptermaillink", RstPr.Name, rst.Name, dbRelationDeleteCascade)
rel.Fields.Append rel.CreateField("Individualid")
rel.Fields![Individualid].ForeignName = "Individualid"
pDB.Relations.Append rel
Select Case Err
Case Is = 0
Case Is = 3012
Case Else
pErr = True
End Select
Select Case pErr
Case Is = True
MsgBox "All conversions have not been made due to locked tables. Have network users close applications on the network now and run program again.", vbCritical, "Incomplete"
Exit Sub
Case Is = False
Set rct = pDB.OpenRecordset("sw082857id", dbOpenTable)
With rct
.Edit
.Fields("Version") = "CD"
.Update
End With
End Select
End Sub
[Updating Using Seek records]
orgsplit.Edit
orgsplit.amountusedaccount = orgsplit.amountusedaccount – alloc
orgsplit.Update
org.Edit
org.amountusedsum = org.amountusedsum – alloc
org.Update
orgsplit.index = "organizationkey"
orgsplit.Seek "=", Me.organizeid, accou1
orgsplit.Edit
orgsplit.amountusedaccount = orgsplit.amountusedaccount + Me.allocate
orgsplit.Update
org.index = "PrimaryKey"
org.Seek "=", Me.organizeid
org.Edit
org.amountusedsum = org.amountusedsum + Me.allocate
org.Update
[Summing Records]
Dim alloc1 As Recordset, MyDB1 As Database
Set MyDB1 = DBEngine.Workspaces(0).Databases(0)
sql1$ = "select [allocate] from allocate_q "
sql1$ = sql1$ + "where allocate_q.organizeid=" + Me.organizeid + " and allocate_q.accountno=" + Str(accou1) + ";"
Set alloc1 = MyDB1.OpenRecordset(sql1$)
Do Until alloc1.eof
sum = sum + alloc1.allocate
alloc1.MoveNext
Loop
alloc1.Close
<end node> 5P9i0s8y19Z
<node>Delete
2
<end node> 5P9i0s8y19Z
<node>Query
3
Note * which defines the records in the InvGhost to be deleted based on the date in the invoice table.
MULTIPLE TABLE
DELETE InvGhost.*, Invoice.Debit
FROM Invoice INNER JOIN InvGhost ON Invoice.InvoiceId = InvGhost.InvoiceId
WHERE ((invoice.debit=[invoice].[credit]));
SINGLE TABLE
DELETE * FROM Invoice where debit = credit
Must have at least one field in delete so use the * symbol
<end node> 5P9i0s8y19Z
<node>Tables
3
Tables
dim db as database
db.TableDefs.Delete "tbl"
<end node> 5P9i0s8y19Z
<node>Fields
2
<end node> 5P9i0s8y19Z
<node>Add Fields to Table
3
Dim dbs As Database, rst As Recordset, tbl As TableDef, fld As Field, que As QueryDef
On Error Resume Next
Set dbs = OpenDatabase(Tree2 + Dbase)
Set tbl = dbs.TableDefs!phone 'NOTE EXCLAMATION
Set fld = tbl.Fields("person")
If Err > 0 Then
With tbl
.Fields.Append .CreateField("Person", dbText, 40)
End With
Set que = dbs.QueryDefs!phone_'NOTE EXCLAMATION
que.SQL = "Select * from Phone order by name,person"
Exit Sub
<end node> 5P9i0s8y19Z
<node>Delete
3
Sub PatchMemberDatabase()
Dim rst As TableDef, pDB As Database, fld As Field, rct As Recordset, pErr As Boolean
Dim iddx As Index, rel As Relation, RstPr As TableDef, rstMem As Recordset
On Error Resume Next
Set pDB = OpenDatabase(Tree2 + "membership.mdb")
Set rst = pDB.TableDefs!Individual
rst.Indexes.Delete "hbanokey"
Set fld = rst.Fields("Charge")
If Err = 0 Then
With rst
.Fields.Delete ("Charge")
If Err > 0 Then pErr = True
End With
End If ''delete charge
Err = 0
<end node> 5P9i0s8y19Z
<node>Filters
2
<end node> 5P9i0s8y19Z
<node>Like
3
Like
remember to place in the * after the term
SELECT membership.CompanyName, membership.JoinDate, Invoice.Description, Invoice.InvType, Invoice.InvoiceNumber, Invoice.DatePaid, Invoice.Debit, Invoice.Credit
FROM Invoice INNER JOIN membership ON Invoice.memberid = membership.memberid
WHERE (((Invoice.Description) Like 'SMC*'))
ORDER BY membership.CompanyName;
Like Operator
The Like operator syntax has these parts:
Part Description
expression SQL expression used in a WHERE clause.
pattern String or character string literal against which expression is compared.
Remarks
You can use the Like operator to find values in a field that match the pattern you specify. For pattern, you can specify the complete value (for example, Like "Smith"), or you can use wildcard characters to find a range of values (for example, Like "Sm*").
In an expression, you can use the Like operator to compare a field value to a string expression. For example, if you enter Like "C*" in an SQL query, the query returns all field values beginning with the letter C. In a parameter query, you can prompt the user for a pattern to search for.
The following example returns data that begins with the letter P followed by any letter between A and F and three digits:
Like "P[A-F]###"
The following table shows how you can use Like to test expressions for different patterns.
Kind of match Pattern Match (returns True) No match (returns False)
Multiple characters a*a aa, aBa, aBBBa aBC
*ab* abc, AABB, Xab aZb, bac
Special character a[*]a a*a aaa
Multiple characters ab* abcdefg, abc cab, aab
Single character a?a aaa, a3a, aBa aBBBa
Single digit a#a a0a, a1a, a2a aaa, a10a
Range of characters [a-z] f, p, j 2, &
Outside a range [!a-z] 9, &, % b, a
Not a digit [!0-9] A, a, &, ~ 0, 1, 9
Combined a[!b-m]# An9, az0, a99 abc, aj0
<end node> 5P9i0s8y19Z
<node>No child records
3
SELECT invoicenumber FROM Invoice LEFT JOIN InvoiceGl ON invoice.invoiceid=invoicegl.invoiceid where invoicegl.invoiceid is null and invtype=3
<end node> 5P9i0s8y19Z
<node>Indexes
2
[kill index)
Set rst = pDb.TableDefs!Individual
rst.Indexes.Delete "hbanokey"
<end node> 5P9i0s8y19Z
<node>Locators
2
SEEK
orgsplit.index = "organizationkey"
orgsplit.Seek "=", Me.organizeid, accou1
<end node> 5P9i0s8y19Z
<node>open
2
gpassword=":pwd="+password
Set dbo = OpenDatabase(Tree2 + "memberother.mdb", False, False, gPassword)
<end node> 5P9i0s8y19Z
<node>Queries
2
Use Distinct after Select to filter out duplicate records
<end node> 5P9i0s8y19Z
<node>Duplicate
3
SELECT membership.CompanyName, membership.MemberNu, First(Accounts.memberid) AS [memberid Field], Count(Accounts.memberid) AS NumberOfDups
FROM membership INNER JOIN Accounts ON membership.memberid = Accounts.memberid
GROUP BY membership.CompanyName, membership.MemberNu, Accounts.memberid
HAVING (((Count(Accounts.memberid))>1));
<end node> 5P9i0s8y19Z
<node>Missing Child
3
SELECT membership.MemberNu, membership.CompanyName, Accounts.accountsid, Accounts.BillAddress1, Accounts.BillAddress2, Accounts.City
FROM membership LEFT JOIN Accounts ON membership.memberid = Accounts.memberid
WHERE (((Accounts.accountsid) Is Null));
<end node> 5P9i0s8y19Z
<node>sum
3
SELECT membership.MemberNu, membership.CompanyName, Sum(Permits.Unit) AS memberunits
FROM membership INNER JOIN Permits ON membership.memberid = Permits.memberid
WHERE (((membership.Builders)=1) AND ((Permits.Date)>#1/1/2005# And (Permits.Date)<#12/31/2005#))
GROUP BY membership.MemberNu, membership.CompanyName
ORDER BY Sum(Permits.Unit),membership.CompanyName;
<end node> 5P9i0s8y19Z
<node>table
3
'ALTER TABLE distributors
'ALTER COLUMN address TYPE varchar(80),
'ALTER COLUMN name TYPE varchar(100);
<end node> 5P9i0s8y19Z
<node>three level
3
FROM (membership INNER JOIN Accounts ON membership.memberid = Accounts.memberid) INNER JOIN Individual ON membership.memberid = Individual.memberid"
FROM (calendarevent INNER JOIN activity ON calendarevent.activityid = activity.activityid) INNER JOIN popup ON activity.popupid = popup.popupid"
<end node> 5P9i0s8y19Z
<node>Rename
2
<end node> 5P9i0s8y19Z
<node>Tables
3
pDb.TableDefs.Delete "buildingdepartment"
Set rst = pDb.TableDefs!Buildingdepartment2
With rst
.Name = "buildingdepartment"
End With
<end node> 5P9i0s8y19Z
<node>Sum Fields
2
SELECT [Account Types].AccountType, Accounts.AccountNumber, Accounts.AccountName, Sum(Transactions.WithdrawalAmount) as s1, sum(Transactions.DepositAmount)as s2
FROM ([Account Types] INNER JOIN Accounts ON [Account Types].AccountTypeID = Accounts.AccountTypeID) Inner JOIN Transactions ON Accounts.AccountID = Transactions.AccountID
WHERE Transactions.TransactionDate Between #1/1/2001# And #12/31/2001#
group BY [Account Types].AccountType, Accounts.AccountNumber, Accounts.AccountName;
<end node> 5P9i0s8y19Z
<node>Update Query
2
SINGLE TABLE
gODb.Execute "update invghost Set period=" + Str$(pP) + " where period=20"
Two table
gODb.Execute "DELETE InvGhost.*, Invoice.Debit FROM Invghost INNER JOIN Invoice ON Invghost.InvoiceId = Invoice.InvoiceId Where invoice.debit=Invoice.credit"
<end node> 5P9i0s8y19Z
<node>upgrade versions
2
Sub Form_Click()
Dim db As DAO.Database
Set db = DBEngine(0).OpenDatabase("D:\Program Files\Microsoft Visual Studio\VB98\Biblio.mdb")
Debug.Print db.Version
db.Close
dbPath = "D:\Program Files\Microsoft Visual Studio\VB98\"
DBEngine.CompactDatabase "D:\Program Files\Microsoft Visual Studio\VB98\Biblio.mdb", _
"D:\Program Files\Microsoft Visual Studio\VB98\Biblio2k.mdb", _
dbLangGeneral, dbVersion40, dbLangGeneral
Set db = DBEngine(0).OpenDatabase("D:\Program Files\Microsoft Visual Studio\VB98\Biblio2k.mdb")
Debug.Print db.Version
db.Close
MsgBox "Conversion Done!"
End Sub
<end node> 5P9i0s8y19Z
<node>distribution
1
[Bootstrap Files]
File1=@COMCAT.DLL,$(WinSysPathSysFile),$(DLLSelfRegister),,5/31/98 12:00:00 AM,22288,4.71.1460.1
File2=@STDOLE2.TLB,$(WinSysPathSysFile),$(TLBRegister),,6/3/99 12:00:00 AM,17920,2.40.4275.1
File3=@ASYCFILT.DLL,$(WinSysPathSysFile),,,3/8/99 12:00:00 AM,147728,2.40.4275.1
File4=@OLEPRO32.DLL,$(WinSysPathSysFile),$(DLLSelfRegister),,3/8/99 12:00:00 AM,164112,5.0.4275.1
File5=@OLEAUT32.DLL,$(WinSysPathSysFile),$(DLLSelfRegister),,4/12/00 12:00:00 AM,598288,2.40.4275.1
File6=@msvbvm60.dll,$(WinSysPathSysFile),$(DLLSelfRegister),,8/21/00 12:00:00 AM,1388544,6.0.89.64
File7=@VB6STKIT.DLL,$(WinSysPathSysFile),,,6/1/99 12:00:00 AM,101888,6.0.84.50
File3=@VB5DB.DLL,$(WinSysPath),,$(Shared),6/18/98 12:00:00 AM,89360,6.0.81.69
File4=@msjtes40.dll,$(WinSysPathSysFile),$(DLLSelfRegister),,5/4/01 12:05:02 PM,241936,4.0.4229.0
File5=@msjint40.dll,$(WinSysPathSysFile),,,5/4/01 12:05:02 PM,151824,4.0.2927.2
File6=@msjter40.dll,$(WinSysPathSysFile),,,5/4/01 12:05:02 PM,53520,4.0.2927.2
File7=@msrepl40.dll,$(WinSysPathSysFile),,,5/4/01 12:05:02 PM,553232,4.0.4331.0
File8=@msrd3x40.dll,$(WinSysPathSysFile),$(DLLSelfRegister),,5/4/01 12:05:02 PM,315664,4.0.4325.0
File9=@msrd2x40.dll,$(WinSysPathSysFile),$(DLLSelfRegister),,5/4/01 12:05:02 PM,422160,4.0.2927.2
File10=@mswdat10.dll,$(WinSysPathSysFile),,,5/4/01 12:05:02 PM,831760,4.0.3829.2
File11=@mswstr10.dll,$(WinSysPathSysFile),,,5/4/01 12:05:02 PM,614672,4.0.3829.2
File12=@expsrv.dll,$(WinSysPathSysFile),,,5/4/01 12:05:02 PM,379152,6.0.0.8540
File13=@vbajet32.dll,$(WinSysPathSysFile),,,5/4/01 12:05:02 PM,30992,6.0.1.8268
File14=@msjet40.dll,$(WinSysPathSysFile),$(DLLSelfRegister),,5/4/01 12:05:02 PM,1503504,4.0.4431.3
File15=@dao360.dll,$(MSDAOPath),$(DLLSelfRegister),$(Shared),5/4/01 12:05:02 PM,557328,3.60.3714.5
Install Fullaccessfile.zip
<end node> 5P9i0s8y19Z
<node>email
1
This article shows how to create a simple MAPI client program. The article also demonstrates how to display existing messages and how to create and send new messages.
MORE INFORMATIONThrough the use of MAPI controls in Visual Basic, it is relatively easy to create a MAPI Client. The following instructions and code show you how:
Start up Visual Basic and select a Standard EXE project. On the Project menu, click Components, and select Microsoft MAPI Controls. There are two new icons displayed on the toolbar. Both icons have envelopes; one with a key, the other with a paperclip. These are your MAPI controls.
Add these MAPI controls to your form.
Add the following items to the form:
Four Labels
Four CommandButtons
Four TextBoxes
The label captions are as follows:
Label1.Caption = "To:"
Label2.Caption = "SUBJECT:"
Label3.Caption = "FROM:"
Label4.Caption = "MESSAGE:"
Place the TextBoxes in numerical sequence with these labels (side-by- side for labels 1 thru 3, and below for label 4).
Label the CommandButtons as follows:
Command1.Caption = "<<"
Command2.Caption = ">>"
Command3.Caption = "Connect"
Command4.Caption = "Send"
Command5.Caption = "Close Session"
Add the following code to your form:
Option Explicit
Dim X As Long
Private Sub Command1_Click()
If X – 1 < 0 Then
Else
X = X – 1
MAPIMessages1.MsgIndex = X
Text1.Text = MAPIMessages1.RecipDisplayName
Text2.Text = MAPIMessages1.MsgSubject
Text3.Text = MAPIMessages1.MsgOrigDisplayName
Text4.Text = MAPIMessages1.MsgNoteText
End If
End Sub
Private Sub Command2_Click()
If X + 1 > MAPIMessages1.MsgCount Then
X = MAPIMessages1.MsgCount
Else
X = X + 1
MAPIMessages1.MsgIndex = X
Text1.Text = MAPIMessages1.RecipDisplayName
Text2.Text = MAPIMessages1.MsgSubject
Text3.Text = MAPIMessages1.MsgOrigDisplayName
Text4.Text = MAPIMessages1.MsgNoteText
End If
End Sub
Private Sub Command3_Click()
MAPISession1.SignOn
MAPIMessages1.SessionID = MAPISession1.SessionID
MAPIMessages1.Fetch
If MAPIMessages1.MsgCount > 0 Then
Text1.Text = MAPIMessages1.RecipDisplayName
Text2.Text = MAPIMessages1.MsgSubject
Text3.Text = MAPIMessages1.MsgOrigDisplayName
Text4.Text = MAPIMessages1.MsgNoteText
Command4.Enabled = True
Else
MsgBox "No messages to fetch"
MAPISession1.SignOff
Command4.Enabled = False
End If
End Sub
Private Sub Command4_Click()
MAPIMessages1.Compose
MAPIMessages1.RecipDisplayName = Text1.Text
MAPIMessages1.MsgSubject = Text2.Text
MAPIMessages1.MsgNoteText = Text4.Text
MAPIMessages1.ResolveName
MAPIMessages1.Send
End Sub
Private Sub Command5_Click()
MAPISession1.SignOff
Unload Me
End Sub
<end node> 5P9i0s8y19Z
<node>FileHandling
1
<end node> 5P9i0s8y19Z
<node>clipboardcopy
2
' #VBIDEUtils#************************************************************
' * Programmer Name : Karl E. Peterson
' * Web Site : http://www.mvps.org/vb
' * E-Mail : waty.thierry@usa.net
' * Date : 11/11/98
' * Time : 12:40
' * Module Name : MClipFileCopy
' * Module Filename : MClipFileCopy.bas
' **********************************************************************
' * Comments :
' *
' *
' * Copyright (C)1995-98,
' *
' * Author grants royalty-free rights to use this code within
' * compiled applications. Selling or otherwise distributing
' * this source code is not allowed without author's express
' * permission.
' *************************************************************
Option Explicit
' Required data structures
Private Type POINTAPI
x As Long
y As Long
End Type
' Clipboard Manager Functions
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
' Other required Win32 APIs
Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
Private Declare Function DragQueryPoint Lib "shell32.dll" (ByVal hDrop As Long, lpPoint As POINTAPI) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
' Predefined Clipboard Formats
Private Const CF_TEXT = 1
Private Const CF_BITMAP = 2
Private Const CF_METAFILEPICT = 3
Private Const CF_SYLK = 4
Private Const CF_DIF = 5
Private Const CF_TIFF = 6
Private Const CF_OEMTEXT = 7
Private Const CF_DIB = 8
Private Const CF_PALETTE = 9
Private Const CF_PENDATA = 10
Private Const CF_RIFF = 11
Private Const CF_WAVE = 12
Private Const CF_UNICODETEXT = 13
Private Const CF_ENHMETAFILE = 14
Private Const CF_HDROP = 15
Private Const CF_LOCALE = 16
Private Const CF_MAX = 17
' New shell-oriented clipboard formats
Private Const CFSTR_SHELLIDLIST As String = "Shell IDList Array"
Private Const CFSTR_SHELLIDLISTOFFSET As String = "Shell Object Offsets"
Private Const CFSTR_NETRESOURCES As String = "Net Resource"
Private Const CFSTR_FILEDESCRIPTOR As String = "FileGroupDescriptor"
Private Const CFSTR_FILECONTENTS As String = "FileContents"
Private Const CFSTR_FILENAME As String = "FileName"
Private Const CFSTR_PRINTERGROUP As String = "PrinterFriendlyName"
Private Const CFSTR_FILENAMEMAP As String = "FileNameMap"
' Global Memory Flags
Private Const GMEM_FIXED = &H0
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_NOCOMPACT = &H10
Private Const GMEM_NODISCARD = &H20
Private Const GMEM_ZEROINIT = &H40
Private Const GMEM_MODIFY = &H80
Private Const GMEM_DISCARDABLE = &H100
Private Const GMEM_NOT_BANKED = &H1000
Private Const GMEM_SHARE = &H2000
Private Const GMEM_DDESHARE = &H2000
Private Const GMEM_NOTIFY = &H4000
Private Const GMEM_LOWER = GMEM_NOT_BANKED
Private Const GMEM_VALID_FLAGS = &H7F72
Private Const GMEM_INVALID_HANDLE = &H8000
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)
Private Type DROPFILES
pFiles As Long
pt As POINTAPI
fNC As Long
fWide As Long
End Type
'**************************************************************************
Public Function ClipboardCopyFiles(Files() As String) As Boolean
' * Procedure Name : ClipboardCopyFiles
' * Parameters :
' * Files() As String
' **********************************************************************
' * Comments : Copy files to the clipboard
' * Like in Explorer or something similar. You can paste them
' * in explorer.
' *
' **********************************************************************
Dim data As String
Dim df As DROPFILES
Dim hGlobal As Long
Dim lpGlobal As Long
Dim i As Long
' Open and clear existing crud off clipboard.
If OpenClipboard(0&) Then
Call EmptyClipboard
' Build double-null terminated list of files.
For i = LBound(Files) To UBound(Files)
data = data & Files(i) & vbNullChar
Next
data = data & vbNullChar
' Allocate and get pointer to global memory,
' then copy file list to it.
hGlobal = GlobalAlloc(GHND, Len(df) + Len(data))
If hGlobal Then
lpGlobal = GlobalLock(hGlobal)
' Build DROPFILES structure in global memory.
df.pFiles = Len(df)
Call CopyMem(ByVal lpGlobal, df, Len(df))
Call CopyMem(ByVal (lpGlobal + Len(df)), ByVal data, Len(data))
Call GlobalUnlock(hGlobal)
' Copy data to clipboard, and return success.
If SetClipboardData(CF_HDROP, hGlobal) Then
ClipboardCopyFiles = True
End If
End If
' Clean up
Call CloseClipboard
End If
End Function
Public Function ClipboardPasteFiles(Files() As String) As Long
' #VBIDEUtils#************************************************************
' * Programmer Name : Karl E. Peterson
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : waty.thierry@usa.net
' * Date : 24/11/98
' * Time : 13:07
' * Module Name : ClipboardFiles_Module
' * Module Filename : ClipboardFiles.bas
' * Procedure Name : ClipboardPasteFiles
' * Parameters :
' * Files() As String
' **********************************************************************
' * Comments : Paste file coming from the clipboard
' * Those files have been added by Explorer or something similar
' *
' **********************************************************************
Dim hDrop As Long
Dim nFiles As Long
Dim i As Long
Dim desc As String
Dim filename As String
Dim pt As POINTAPI
Const MAX_PATH As Long = 260
' Insure desired format is there, and open clipboard.
If IsClipboardFormatAvailable(CF_HDROP) Then
If OpenClipboard(0&) Then
' Get handle to Dropped Filelist data, and number of files.
hDrop = GetClipboardData(CF_HDROP)
nFiles = DragQueryFile(hDrop, -1&, "", 0)
' Allocate space for return and working variables.
ReDim Files(0 To nFiles – 1) As String
filename = Space(MAX_PATH)
' Retrieve each filename in Dropped Filelist.
For i = 0 To nFiles – 1
Call DragQueryFile(hDrop, i, filename, Len(filename))
Files(i) = TrimNull(filename)
Next
' Clean up
Call CloseClipboard
End If
' Assign return value equal to number of files dropped.
ClipboardPasteFiles = nFiles
End If
End Function
Private Function TrimNull(ByVal sTmp As String) As String
Dim nNul As Long
'
' Truncate input sTmpg at first Null.
' If no Nulls, perform ordinary Trim.
'
nNul = InStr(sTmp, vbNullChar)
Select Case nNul
Case Is > 1
TrimNull = Left(sTmp, nNul – 1)
Case 1
TrimNull = ""
Case 0
TrimNull = Trim(sTmp)
End Select
End Function
<end node> 5P9i0s8y19Z
<node>Controls
2
<end node> 5P9i0s8y19Z
<node>Directory
3
[ Directory]
Sub Dir1_Change ()
file1.Path = dir1.Path
End Sub
Sub Dir1_Click ()
dir1.Path = dir1.List(dir1.ListIndex)
file1.Path = dir1.Path
End Sub
Sub Dir1_KeyPress (keyascii As Integer)
If keyascii = 13 Then
keyascii = 0
dir1.Path = dir1.List(dir1.ListIndex)
End If
End Sub
<end node> 5P9i0s8y19Z
<node>Drive
3
[Drive]
Sub dr2_Change ()
dir2.Path = dr2.Drive
End Sub
<end node> 5P9i0s8y19Z
<node>File
3
[ Process files]
If file1.FileName = "" Then MsgBox ("Please select file first."): Exit Sub
nu% = file1.ListCount – 1
b1$ = "": If Right$(dir1.Path, 1) <> "\" Then b1$ = "\"
For i% = 0 To nu%
If file1.Selected(i%) = True Then
a$ = file1.List(i%): a$ = dir1.Path + b1$ + a$
s = s + a$ + " "
If Len(s) > 200 Then GoSub zipit
If m% = 2 Or key = "exit" Then Exit For
'DoEvents
End If
Next
<end node> 5P9i0s8y19Z
<node>Pattern
3
[ Pattern]
Determines which file names are displayed in a file list box at run time.
[form.]filelistbox.Pattern[ = display ]
Sub File1_PatternChange ()
dir1.Path = dir1.List(dir1.ListIndex)
file1.Path = dir1.Path
End Sub
Sub Combo2_Change ()
file1.Pattern = combo2.Text
End Sub
1.Here is a listing of patterns
1=*.*
2=*.app;*.dct;*.tps;*.cla;*.k??
3=*.bat;*.txt
4=*.xl?
5=*.dat;*.exe
6=*.k??;*.cla
7=*.frm;*.bas;*.mak;*.txt;*.exe
8=*.exe;*.dat;*.pif;*.bat
9=*.tps
10=*.ini
11=*.grp
<end node> 5P9i0s8y19Z
<node>Create Directory
2
Create Directory]
Include full path name.
If Err = 76 Then MkDir Tree + "txt\": Resume Next
<end node> 5P9i0s8y19Z
<node>Directory
2
[Dir]
'make sure that the path has an \ on the end
Dim MyFile, MyPath, MyName
' Returns "WIN.INI" if it exists.
MyFile = Dir("C:\WINDOWS\WIN.INI")
' Returns filename with specified extension. If more than one *.ini
' file exists, the first file found is returned.
MyFile = Dir("C:\WINDOWS\*.INI")
' Call Dir again without arguments to return the next *.INI file in the
' same directory.
MyFile = Dir
' Return first *.TXT file with a set hidden attribute.
MyFile = Dir("*.TXT", vbHidden)
' Display the names in C:\ that represent directories.
MyPath = "c:\" ' Set the path.
MyName = Dir(MyPath, vbDirectory) ' Retrieve the first entry.
Do While MyName <> "" ' Start the loop.
' Ignore the current directory and the encompassing directory.
If MyName <> "." And MyName <> ".." Then
' Use bitwise comparison to make sure MyName is a directory.
If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
Debug.Print MyName ' Display entry only if it
End If ' it represents a directory.
End If
MyName = Dir ' Get next entry.
Loop
<end node> 5P9i0s8y19Z
<node>Drive Api
2
[[ Drive Information]
1. Place the following code into a module.
Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Declare Function GetLogicalDrives& Lib "kernel32" ()
Declare Function GetDriveType& Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String)
'ndrive must contain letter+":\" in order to work
Declare Function GetDiskFreeSpace& Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long)
Public vararyDriveInfo(26, 11) ' a Variant Array to hold the info
' ************************************************************************************
2. This is a sub that can be called from a form loading or from a command button.
Sub getDriveInfo()
' *****************************************
' SUB: This sub will get all the drive
' info for all the hard drives and
' network drives.
' 2/19/95
'
' There is a array named vararyDriveInfo that
' holds all the info for up to 26 drives (A-Z).
'
' Array Format:
' x,1 = Is there a drive for this letter
' x,2 = Drive Letter
' x,3 = Drive Type 2=Floppy, 3=Disk Fixed (local) 4=Disk Remote (Network)
' x,4 = Sectors
' x,5 = Bytes / Sector
' x,6 = Number of free sectors
' x,7 = Total Clusters
' x,8 = Total Bytes
' x,9 = Free Bytes
' x,10 = Percent of Free Bytes
' x,11 = Vol Name
'
' *********************************************************************
Dim ournum As Long
Dim rv As Long
Dim DriveType As Long
Dim c As Long
Dim d As Long
Dim e As Long
Dim f As Long
Dim h As Long
Dim Counter As Integer
Dim CompareTo
Dim tmpDrvLet As String
Dim SectorsPerCluster&, BytesPerSector&, NumberOfFreeClustors&, TotalNumberOfClustors&
Dim BytesFreeas, BytesTotal, FreeBytes, TotalBytes As Variant
Dim dl&, lpVolumeSerialNumber&, lpMaximumComponentLength&, lpFileSystemFlags&
Dim lpVolumeNameBuffer As String
Dim rc
Dim A As String
Dim b As String
Dim g As String
Dim s$, sz&
' *** get the logical Drives
rv = 0
rv = GetLogicalDrives&()
If rv = 0 Then
MsgBoxText = "No Logical Drives Found. Program will stop."
MsgBoxButton = MB_OK + MB_ICONSTOP
MsgBoxTitle = "Error"
MsgBox MsgBoxText, MsgBoxButton, MsgBoxTitle
Stop
Exit Sub
End If
' *** clear the VarArray
Erase vararyDriveInfo
' *** set the var
b = String$(255, 0)
c = 200
g = String$(255, 0)
h = 100
For Counter = 1 To 26
CompareTo = (2 ^ (Counter – 1))
If (rv And CompareTo) <> 0 Then
vararyDriveInfo(Counter, 1) = True ' Found a drive
tmpDrvLet = Chr(Counter + 64) ' Build a drive letter
vararyDriveInfo(Counter, 2) = tmpDrvLet ' Save the drive letter
tmpDrvLet = tmpDrvLet & ":\" ' Add the root stuff
DriveType = GetDriveType&(tmpDrvLet) ' Get the drive type
vararyDriveInfo(Counter, 3) = DriveType ' Save the drive type
If DriveType = 3 Or DriveType = 4 Then ' local or network drives only
' *** get the vol name
A = tmpDrvLet 'DriveLtr & "\:"
rc = GetVolumeInformation(A, b, c, d, e, f, g, h)
vararyDriveInfo(Counter, 11) = b
' *** let's get the Drive info for this HardDrive
dl& = GetDiskFreeSpace(tmpDrvLet, SectorsPerCluster, BytesPerSector, _
NumberOfFreeClustors, TotalNumberOfClustors)
vararyDriveInfo(Counter, 4) = Format(SectorsPerCluster, "#,0")
vararyDriveInfo(Counter, 5) = Format(BytesPerSector, "#,0")
vararyDriveInfo(Counter, 6) = Format(NumberOfFreeClustors, "#,0")
vararyDriveInfo(Counter, 7) = Format(TotalNumberOfClustors, "#,0")
TotalBytes = (TotalNumberOfClustors / 100) * (SectorsPerCluster / 100) * (BytesPerSector / 100)
vararyDriveInfo(Counter, 8) = Format(TotalBytes, "#,0")
FreeBytes = (NumberOfFreeClustors / 100) * (SectorsPerCluster / 100) * (BytesPerSector / 100)
vararyDriveInfo(Counter, 9) = Format(FreeBytes, "#,0")
vararyDriveInfo(Counter, 10) = Format(FreeBytes / TotalBytes, "Percent")
End If
Else
' *** no drive? then set to false
vararyDriveInfo(Counter, 1) = False
End If
Next Counter
End Sub
<end node> 5P9i0s8y19Z
<node>File
2
File Manager Commands
Change Directory ChDir "c:\path"
Make Directory MkDir "c:\path"
Remove Directory RmDir "c:\path"
Change Drive ChDrive "d"
Rename a File Name "test.txt" as "string.tst"
(May fail if directories are not specified)
Delete a File Kill "c:\*.tst"
Search for File temp$ = Dir ("c:\*.tst")
Current Drirectory temp$ = CurDir ("d") ' Drive letter is optional
Get File Attributes temp = GetAttr ("c:\filename.tst")
Get File Mode temp = FileAttr ("c:\filename.tst", attributes)
Set File Attributes SetAttr "c:\filename.tst", vbReadOnly
Get File Length FileLen ("c:\filename.tst")
Get File Date/Time tempDate = FileDateTime ("c:\filename.tst")
Set File Date/Time ????
——————————————————————————–
<end node> 5P9i0s8y19Z
<node>Api Copy
3
Public Const FO_MOVE As Long = &H1
Public Const FO_COPY As Long = &H2
Public Const FO_DELETE As Long = &H3
Public Const FO_RENAME As Long = &H4
Public Const FOF_MULTIDESTFILES As Long = &H1
Public Const FOF_CONFIRMMOUSE As Long = &H2
Public Const FOF_SILENT As Long = &H4
Public Const FOF_RENAMEONCOLLISION As Long = &H8
Public Const FOF_NOCONFIRMATION As Long = &H10
Public Const FOF_WANTMAPPINGHANDLE As Long = &H20
Public Const FOF_CREATEPROGRESSDLG As Long = &H0
Public Const FOF_ALLOWUNDO As Long = &H40
Public Const FOF_FILESONLY As Long = &H80
Public Const FOF_SIMPLEPROGRESS As Long = &H100
Public Const FOF_NOCONFIRMMKDIR As Long = &H200
Public Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Long
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String
End Type
Public Declare Function SHFileOperation Lib "Shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Sub Backup()
On Error Resume Next
Dim result As Long, fileop As SHFILEOPSTRUCT
Kill Tree2 + "backup\Copy of*.*"
With fileop
.hWnd = Main.hWnd
.wFunc = FO_COPY
.pFrom = Tree2 + cMdb & vbNullChar & Tree2 + cOMdb & vbNullChar & vbNullChar
.pTo = Tree2 + "backup\" & vbNullChar & vbNullChar
.fFlags = FOF_SIMPLEPROGRESS Or FOF_RENAMEONCOLLISION Or FOF_NOCONFIRMATION
End With
result = SHFileOperation(fileop)
End Sub
<end node> 5P9i0s8y19Z
<node>Attribute
3
Attribute]
b$ = FileDateTime(a$)
If DateValue(b$) < DateValue(Now – Val(txday)) Then 999
<end node> 5P9i0s8y19Z
<node>Change File Date
3
Option Explicit
Private Type FILETIME
dwLowDate As Long
dwHighDate As Long
End Type
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMillisecs As Integer
End Type
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const GENERIC_WRITE = &H40000000
Private Declare Function CreateFile Lib "kernel32" Alias _
"CreateFileA" (ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) _
As Long
Private Declare Function LocalFileTimeToFileTime Lib _
"kernel32" (lpLocalFileTime As FILETIME, _
lpFileTime As FILETIME) As Long
Private Declare Function SetFileTime Lib "kernel32" _
(ByVal hFile As Long, ByVal MullP As Long, _
ByVal NullP2 As Long, lpLastWriteTime _
As FILETIME) As Long
Private Declare Function SystemTimeToFileTime Lib _
"kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime _
As FILETIME) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Public Function SetFileDateTime(ByVal FileName As String, _
ByVal TheDate As String) As Boolean
'************************************************
'PURPOSE: Set File Date (and optionally time)
' for a given file)
'PARAMETERS: TheDate — Date to Set File's Modified Date/Time
' FileName — The File Name
'Returns: True if successful, false otherwise
'************************************************
If Dir(FileName) = "" Then Exit Function
If Not IsDate(TheDate) Then Exit Function
Dim lFileHnd As Long
Dim lRet As Long
Dim typFileTime As FILETIME
Dim typLocalTime As FILETIME
Dim typSystemTime As SYSTEMTIME
With typSystemTime
.wYear = Year(TheDate)
.wMonth = Month(TheDate)
.wDay = Day(TheDate)
.wDayOfWeek = Weekday(TheDate) – 1
.wHour = Hour(TheDate)
.wMinute = Minute(TheDate)
.wSecond = Second(TheDate)
End With
lRet = SystemTimeToFileTime(typSystemTime, typLocalTime)
lRet = LocalFileTimeToFileTime(typLocalTime, typFileTime)
lFileHnd = CreateFile(FileName, GENERIC_WRITE, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, _
OPEN_EXISTING, 0, 0)
lRet = SetFileTime(lFileHnd, ByVal 0&, ByVal 0&, _
typFileTime)
CloseHandle lFileHnd
SetFileDateTime = lRet > 0
End Function
<end node> 5P9i0s8y19Z
<node>CombineFiles
3
Open cd1.filename For Binary As #1
Label3.Caption = cd1.filename
c = String(LOF(2), " ")
Get #2, , c
d = String(LOF(3), " ")
Get #3, , d
Put #1, , c
Put #1, , d
Close #1, #2, #3
<end node> 5P9i0s8y19Z
<node>Copy
3
[ Copy]
FileCopy from path +name, to path + name
<end node> 5P9i0s8y19Z
<node>Date/Time
3
Date and time]
MyStamp = FileDateTime("TESTFILE")
' Returns "2/12/93 4:35:47 PM".
<end node> 5P9i0s8y19Z
<node>Delete
3
Private Sub File1_KeyDown(KeyCode As Integer, Shift As Integer)
Dim NU%, I%, Mark%
If KeyCode = 46 Then
NU% = File1.ListCount – 1
Mark = File1.ListIndex
For I% = NU% To 0 Step -1
If File1.Selected(I%) = True Then
Kill mPath + File1.List(I)
End If
Next
With File1
.Refresh
If .ListCount – 1 > Mark Then File1.ListIndex = Mark Else File1.ListIndex = File1.ListCount – 1
End With
End If
End Sub
<end node> 5P9i0s8y19Z
<node>Into Text Box
3
both reads and information.
Text box]
Dim FileName As String
Dim f As Integer
FileName = "C:\VB\README.TXT"
F = FreeFile 'Get a file handle
Open FileName For Input As F 'Open the file
Text1.Text = Input$(LOF(F), F) 'Read entire file into text box
Close F 'Close the file.
<end node> 5P9i0s8y19Z
<node>Length
3
Length
c$ = Str$(FileLen(a$))
<end node> 5P9i0s8y19Z
<node>pattern
3
File1.Pattern = "*.html;*.htm"
<end node> 5P9i0s8y19Z
<node>RENAME
3
Kill Tree2 + "membership.mdb"
Name Tree2 + "membershiptemp.mdb" As Tree2 + "membership.mdb"
FileCopy Tree2 + "memberother.mdb", Tree2 + "memberotherold.mdb"
CompactDatabase Tree2 + "memberother.mdb", Tree2 + "memberothertemp.mdb", , , gPassword
Kill Tree2 + "memberother.mdb"
Name Tree2 + "memberothertemp.mdb" As Tree2 + "memberother.mdb"
<end node> 5P9i0s8y19Z
<node>Seqential
3
[ Reads Sequential]
Example 1: Sequential read of a text file
Open tree + "convert.txt" For Input As #1
Do Until EOF(1)
Line Input #1, a$
<end node> 5P9i0s8y19Z
<node>LongFileNames
2
Long File Names Can Be Confusing
If you want to open Paint with a file from your application, it's better to convert the path of the file you want to open from long to short
names. Doing so is wise because in some situations-if your path contains spaces, for example-Paint may refuse to work properly. Before
passing a file name to Paint, convert it to short names with this routine, which takes advantage of the Win32 API:
Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathName" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Function ShortName(LongPath As String) As String
Dim ShortPath As String
Const MAX_PATH = 260
Dim ret&
ShortPath = Space$(MAX_PATH)
ret& = GetShortPathName(LongPath, ShortPath, MAX_PATH)
If ret& Then
ShortName = Left$(ShortPath, ret&)
End If
End Function
This trick may prove useful with any application you pass file names to. It would be smart to try passing "strange" file names/paths to
make sure.
<end node> 5P9i0s8y19Z
<node>networkdrives
2
' #VBIDEUtils#************************************************************
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : waty.thierry@usa.net
' * Date : 25/09/98
' * Time : 11:18
' * Module Name : class_NetUse
' * Module Filename : NetUse.cls
' **********************************************************************
' * Comments : Connect/Disconnect shared network drives
' *
' *
' **********************************************************************
Option Explicit
Private Declare Function WNetAddConnection Lib "mpr.dll" Alias "WNetAddConnectionA" (ByVal lpszNetPath As String, ByVal lpszPassword As String, ByVal lpszLocalName As String) As Long
Private Declare Function WNetCancelConnection Lib "mpr.dll" Alias "WNetCancelConnectionA" (ByVal lpszName As String, ByVal bForce As Long) As Long
Const WN_Success = &H0
Const WN_Not_Supported = &H1
Const WN_Net_Error = &H2
Const WN_Bad_Pointer = &H4
Const WN_Bad_NetName = &H32
Const WN_Bad_Password = &H6
Const WN_Bad_Localname = &H33
Const WN_Access_Denied = &H7
Const WN_Out_Of_Memory = &HB
Const WN_Already_Connected = &H34
'– Error number and message
Public ErrorNum As Long
Public ErrorMsg As String
Public rc As Long
Private Const ERROR_NO_CONNECTION = 8
Private Const ERROR_NO_DISCONNECT = 9
Private Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As String
lpRemoteName As String
lpComment As String
lpProvider As String
End Type
'———————————————-
'WNetAddConnection2
'Allows the caller to redirect (connect) a local
'device to a network resource. It is similar to
'WNetAddConnection, except that it takes a pointer
'to a NETRESOURCE structure to describe the network
'resource to connect to. It also takes the addition
'parameters lpUserID and dwFlags.
'lpNetResource
'Specifies the network resource to connect to.
'The following fields must be set when making a
'connection, the others are ignored.
' lpRemoteName: Specifies the network resource
' to connect to. This is limited
' to MAX_PATH.
' lpLocalName: This specifies the name of a local
' device to be redirected, such as "F:"
' or "LPT1". The string is treated in a
' case insensitive manner, and may be
' the empty string (or NULL) in which
' case a connection to the network resource
' is made without making a redirection.
' lpProvider: Specifies the NP to connect to. If NULL
' or empty string, Windows will try each
' NP in turn. The caller should set
' lpProvider only if it knows for sure
' which network it wants. Otherwise, it
' is preferable to let Windows determine
' which NP the network name maps to.
' If this is non NULL, Windows will try
' the named NP and no other.
' dwType: Specifies the type of resource to connect to.
' It must be RESOURCETYPE_DISK or RESOURCETYPE_PRINT
' if lpLocalName is not the empty string. It may
' also be RESOURCETYPE_ANY if lpLocalName is the
' empty string.
'lpPassword
'Specifies the password to be used in making the
'connection, normally the password associated with
'lpUserID. A NULL value or string may be passed in
'to indicate to the function to use the current
'default password.
'
'lpUserID
'This specifies the identity of the user needed to
'make the connection. If NULL, a default will be
'applied. This is used when the user wishes to connect
'to a resource, but has a different user name or
'account assigned to him for that resource. This
'identification represents a security context, and
'is NP specific.
'
'dwFlags
'This is a bit mask which may have any of the
'following bits set:
'
' CONNECT_UPDATE_PROFILE: If the connection should
' be made persistent. If set,
' Windows automatically restores
' this connection when the user
' logs on to the network. A connection
' is only made persistent if the
' connection was successful.
Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
Private Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, ByVal fForce As Long) As Long
Private Declare Function WNetConnectionDialog Lib "mpr.dll" (ByVal hWnd As Long, ByVal dwType As Long) As Long
Private Declare Function WNetDisconnectDialog Lib "mpr.dll" (ByVal hWnd As Long, ByVal dwType As Long) As Long
'Public Const RESOURCE_CONNECTED = &H1
'Public Const RESOURCE_REMEMBERED = &H3
'Public Const RESOURCEDISPLAYTYPE_DOMAIN = &H1
'Public Const RESOURCEDISPLAYTYPE_GENERIC = &H0
'Public Const RESOURCEDISPLAYTYPE_SERVER = &H2
'Public Const RESOURCEUSAGE_CONTAINER = &H2
Const NO_ERROR = 0
Const CONNECT_UPDATE_PROFILE = &H1
Const RESOURCETYPE_DISK = &H1
Const RESOURCETYPE_PRINT = &H2
Const RESOURCETYPE_ANY = &H0
Const RESOURCE_GLOBALNET = &H2
Const RESOURCEDISPLAYTYPE_SHARE = &H3
Const RESOURCEUSAGE_CONNECTABLE = &H1
Public Sub Connect(sDrive As String, sService As String, Optional sPassword As String = "")
On Error GoTo Err_Connect
Me.ErrorNum = 0
Me.ErrorMsg = ""
rc = WNetAddConnection(sService & Chr(0), sPassword & Chr(0), sDrive & Chr(0))
If rc <> 0 Then GoTo Err_Connect
Exit Sub
Err_Connect:
Me.ErrorNum = rc
Me.ErrorMsg = WnetError(rc)
End Sub
Public Sub DisConnect(sDrive As String)
On Error GoTo Err_DisConnect
Me.ErrorNum = 0
Me.ErrorMsg = ""
rc = WNetCancelConnection(sDrive + Chr(0), 0)
If rc <> 0 Then GoTo Err_DisConnect
Exit Sub
Err_DisConnect:
Me.ErrorNum = rc
Me.ErrorMsg = WnetError(rc)
End Sub
Private Function WnetError(Errcode As Long) As String
Select Case Errcode
Case WN_Not_Supported:
WnetError = "Function is not supported."
Case WN_Out_Of_Memory:
WnetError = "Out of Memory."
Case WN_Net_Error:
WnetError = "An error occurred on the network."
Case WN_Bad_Pointer:
WnetError = "The Pointer was Invalid."
Case WN_Bad_NetName:
WnetError = "Invalid Network Resource Name."
Case WN_Bad_Password:
WnetError = "The Password was Invalid."
Case WN_Bad_Localname:
WnetError = "The local device name was invalid."
Case WN_Access_Denied:
WnetError = "A security violation occurred."
Case WN_Already_Connected:
WnetError = "The local device was connected to a remote resource."
Case Else:
WnetError = "Unrecognized Error " + Str(Errcode) + "."
End Select
End Function
Public Function ConnectNetworkDialog() As Long
' *** Show the dialog to map a drive
'If the function succeeds, the return value is
'NO_ERROR (0). If the user cancels out of the
'dialog box, it is &HFFFFFFFF.
ConnectNetworkDialog = WNetConnectionDialog(0&, RESOURCETYPE_DISK)
End Function
Public Function DisconnectNetworkDialog() As Long
' *** Show the dialog to disconnect mapped a drive
'If the function succeeds, the return value is
'NO_ERROR (0). If the user cancels out of the
'dialog box, it is &HFFFFFFFF.
DisconnectNetworkDialog = WNetDisconnectDialog(0&, RESOURCETYPE_DISK)
End Function
Public Function ConnectPrintDialog() As Long
' *** Show the dialog to map a network printer, Windows
'If the function succeeds, the return value is
'NO_ERROR (0). If the user cancels out of the
'dialog box, it is &HFFFFFFFF.
ConnectPrintDialog = WNetConnectionDialog(0&, RESOURCETYPE_PRINT)
End Function
Public Function DisconnectPrintDialog() As Long
' *** Show the dialog to disconnect network printer
'If the function succeeds, the return value is
'NO_ERROR (0). If the user cancels out of the
'dialog box, it is &HFFFFFFFF.
DisconnectPrintDialog = WNetDisconnectDialog(0&, RESOURCETYPE_PRINT)
End Function
Public Function ConnectUserPassword(sDrive As String, sService As String, Optional sUser As String = "", Optional sPassword As String = "") As Boolean
' *** Connect to a network drive
'attempts to connect to the passed network
'connection to the specified drive.
'ErrInfo=NO_ERROR if successful.
Dim NETR As NETRESOURCE
Dim errInfo As Long
With NETR
.dwScope = RESOURCE_GLOBALNET
.dwType = RESOURCETYPE_DISK
.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
.dwUsage = RESOURCEUSAGE_CONNECTABLE
.lpRemoteName = sDrive
.lpLocalName = sService
End With
errInfo = WNetAddConnection2(NETR, sPassword, sUser, CONNECT_UPDATE_PROFILE)
ConnectUserPassword = errInfo = NO_ERROR
End Function
<end node> 5P9i0s8y19Z
<node>Reading
2
Line Input #1, A 'This reads one line of a text file at a time.
<end node> 5P9i0s8y19Z
<node>graphics
1
Public Function Load_Image_To_Clipboard(file As String)
Clipboard.SetData LoadPicture(file)
End Function
Public Function Save_Image_From_Clipboard(file As String)
SavePicture Clipboard.GetData, file
End Function
Public Function send_Text_File_To_Clipboard(file As String)
On Error GoTo error
Open file For Input As #1
Clipboard.SetText Input(LOF(1), 1)
Close #1
Exit Function
error:
y = MsgBox("File Not Found", vbOKOnly, "Error")
End Function
Public Function recive_Text_From_Clipboard_to(file As String)
On Error GoTo error
Open file For Output As #1
a$ = Clipboard.GetText
Print #1, a$
Close 1
Exit Function
error:
x = MsgBox("There has been a error!", vbOKOnly, "Error")
End Function
<end node> 5P9i0s8y19Z
<node>IMAGE width/height
2
Option Explicit
Public Type ImageSize
Width As Long
Height As Long
End Type
Public Function GetImageSize(sFileName As String) As ImageSize
On Error Resume Next 'you'll want to change this
Dim iFN As Integer
Dim bTemp(3) As Byte
Dim lFlen As Long
Dim lPos As Long
Dim bHmsb As Byte
Dim bHlsb As Byte
Dim bWmsb As Byte
Dim bWlsb As Byte
Dim bBuf(7) As Byte
Dim bDone As Byte
Dim iCount As Integer
lFlen = FileLen(sFileName)
iFN = FreeFile
Open sFileName For Binary As iFN
Get #iFN, 1, bTemp()
'PNG file
If bTemp(0) = &H89 And bTemp(1) = &H50 And bTemp(2) = &H4E _
And bTemp(3) = &H47 Then
Get #iFN, 19, bWmsb
Get #iFN, 20, bWlsb
Get #iFN, 23, bHmsb
Get #iFN, 24, bHlsb
GetImageSize.Width = CombineBytes(bWlsb, bWmsb)
GetImageSize.Height = CombineBytes(bHlsb, bHmsb)
End If
'GIF file
If bTemp(0) = &H47 And bTemp(1) = &H49 And bTemp(2) = &H46 _
And bTemp(3) = &H38 Then
Get #iFN, 7, bWlsb
Get #iFN, 8, bWmsb
Get #iFN, 9, bHlsb
Get #iFN, 10, bHmsb
GetImageSize.Width = CombineBytes(bWlsb, bWmsb)
GetImageSize.Height = CombineBytes(bHlsb, bHmsb)
End If
'JPEG file
If bTemp(0) = &HFF And bTemp(1) = &HD8 And bTemp(2) = &HFF Then
Debug.Print "JPEG"
lPos = 3
Do
Do
Get #iFN, lPos, bBuf(1)
Get #iFN, lPos + 1, bBuf(2)
lPos = lPos + 1
Loop Until (bBuf(1) = &HFF And bBuf(2) <> &HFF) Or lPos > lFlen
For iCount = 0 To 7
Get #iFN, lPos + iCount, bBuf(iCount)
Next iCount
If bBuf(0) >= &HC0 And bBuf(0) <= &HC3 Then
bHmsb = bBuf(4)
bHlsb = bBuf(5)
bWmsb = bBuf(6)
bWlsb = bBuf(7)
bDone = 1
Else
lPos = lPos + (CombineBytes(bBuf(2), bBuf(1))) + 1
End If
Loop While lPos < lFlen And bDone = 0
GetImageSize.Width = CombineBytes(bWlsb, bWmsb)
GetImageSize.Height = CombineBytes(bHlsb, bHmsb)
End If
Close iFN
End Function
Private Function CombineBytes(lsb As Byte, msb As Byte) As Long
CombineBytes = CLng(lsb + (msb * 256))
End Function
<end node> 5P9i0s8y19Z
<node>Help
1
All Windows help requests are handled by one API function buried within the Winhelp.exe file. Here's the declaration:
Declare Function WinHelp Lib "user32" Alias "WinHelpA" _
(ByVal hwnd As Long, ByVal lpHelpFile As String, ByVal wCommand _
As Long, ByVal dwData As Any) As Long
By passing certain parameters to this API function, you can determine which help file to use, and what functions to launch. In part 2 of this article, we'll be looking at how to use this API function to various types of help Windows.
Note: Be sure to include the API declaration listed on the previous page in your project before attempting any of the following examples. Also, change the "c:\windows\help\freecell.hlp" to point to your own application's help file.
TOC
This code is used to display the help file table of contents (specified in the CNT file):
Call WinHelp(Me.hwnd, "c:\windows\help\freecell.hlp", 11, "")
When this line of code is executed, this help Window should appear:
Jump To Topic 1
If you would like to launch a help window displaying a particular topic id, use this code:
Call WinHelp(Me.hwnd, "c:\windows\help\freecell.hlp", _
1, ByVal lngContextID)
— Where lngContextID is a long value of the topic you wish to show.
Topic Pop-up 8
Similar to the Jump to topic code is the following snippet – which launched the topic specified in the lngContextID in a pop-up window instead of the standard Windows help interface:
Call WinHelp(Me.hwnd, "c:\windows\help\freecell.hlp", _
8, ByVal lngContextID)
Searching Help 257
Finally, let's look at a code snippet that allows you to display the topic that contains a certain text string (specified in the strSearch variable):
Call WinHelp(Me.hwnd, "c:\windows\help\freecell.hlp", _
257, ByVal strsearch)
Conclusion
<end node> 5P9i0s8y19Z
<node>internet
1
<end node> 5P9i0s8y19Z
<node>email
2
' 1) Open a new project in Visual Basic.
' 2) On the Tools menu, choose References and select the Microsoft CDO 1.21 Library.
' 3) Add a CommandButton to the default form. Accept the default name, Command1.
' 4) Copy the following code into the General Declarations section of the default form:
Option Explicit
Private Sub Command1_Click()
Dim objSession As Object
Dim objMessage As Object
Dim objRecipient As Object
'Create the Session Object
Set objSession = CreateObject("mapi.session")
'Logon using the session object
'Specify a valid profile name if you want to
'Avoid the logon dialog box
objSession.Logon profileName:="MS Exchange Settings"
'Add a new message object to the OutBox
Set objMessage = objSession.Outbox.Messages.Add
'Set the properties of the message object
objMessage.subject = "This is a test."
objMessage.Text = "This is the message text."
'Add a recipient object to the objMessage.Recipients collection
Set objRecipient = objMessage.Recipients.Add
'Set the properties of the recipient object
objRecipient.Name = "John Doe" '<—Replace this with a valid
'display name or e-mail alias
objRecipient.Type = mapiTo
objRecipient.Resolve
'Send the message
objMessage.Send showDialog:=False
MsgBox "Message sent successfully!"
'Logoff using the session object
objSession.Logoff
End Sub
*******************************************************************************
'you MUST put the Winsock1 control on your form
'and this will work VERY quickly!!
'heinlein@execpc.com (write me and thank me later! hehe)
'-I-[]v[]oUsE-I- []nDuSt[]2iEs (C)1999 IDK
Dim Response As String, Reply As Integer, DateNow As String
Dim first As String, Second As String, Third As String
Dim Fourth As String, Fifth As String, Sixth As String
Dim Seventh As String, Eighth As String
Dim Start As Single, Tmr As Single
Sub SendEmail(MailServerName As String, FromName As String, FromEmailAddress As String, ToName As String, ToEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String)
Winsock1.LocalPort = 0 ' Must set local port to 0 (Zero) or you can only send 1 e-mail pre program start
If Winsock1.State = sckClosed Then ' Check to see if socet is closed
DateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0600"
first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf ' Get who's sending E-Mail address
Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf ' Get who mail is going to
Third = "Date:" + Chr(32) + DateNow + vbCrLf ' Date when being sent
Fourth = "From:" + Chr(32) + FromName + vbCrLf ' Who's Sending
Fifth = "To:" + Chr(32) + ToNametxt + vbCrLf ' Who it going to
Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf ' Subject of E-Mail
Seventh = EmailBodyOfMessage + vbCrLf ' E-mail message body
Ninth = "mouse mailer" + vbCrLf ' What program sent the e-mail, customize this
Eighth = Fourth + Third + Ninth + Fifth + Sixth ' Combine for proper SMTP sending
Winsock1.Protocol = sckTCPProtocol ' Set protocol for sending
Winsock1.RemoteHost = MailServerName ' Set the server address
Winsock1.RemotePort = 25 ' Set the SMTP Port
Winsock1.Connect ' Start connection
WaitFor ("220")
StatusTxt.Caption = "Connecting…."
StatusTxt.Refresh
Winsock1.SendData ("HELO worldcomputers.com" + vbCrLf)
WaitFor ("250")
StatusTxt.Caption = "Connected"
StatusTxt.Refresh
Winsock1.SendData (first)
StatusTxt.Caption = "Sending Message"
StatusTxt.Refresh
WaitFor ("250")
Winsock1.SendData (Second)
WaitFor ("250")
Winsock1.SendData ("data" + vbCrLf)
WaitFor ("354")
Winsock1.SendData (Eighth + vbCrLf)
Winsock1.SendData (Seventh + vbCrLf)
Winsock1.SendData ("." + vbCrLf)
WaitFor ("250")
Winsock1.SendData ("quit" + vbCrLf)
StatusTxt.Caption = "Disconnecting"
StatusTxt.Refresh
WaitFor ("221")
Winsock1.Close
Else
MsgBox (Str(Winsock1.State))
End If
End Sub
Sub WaitFor(ResponseCode As String)
Start = Timer ' Time event so won't get stuck in loop
While Len(Response) = 0
Tmr = Start – Timer
DoEvents ' Let System keep checking for incoming response **IMPORTANT**
If Tmr > 50 Then ' Time in seconds to wait
MsgBox "SMTP service error, timed out while waiting for response", 64, MsgTitle
Exit Sub
End If
Wend
While Left(Response, 3) <> ResponseCode
DoEvents
If Tmr > 50 Then
MsgBox "SMTP service error, impromper response code. Code should have been: " + ResponseCode + " Code recieved: " + Response, 64, MsgTitle
Exit Sub
End If
Wend
Response = "" ' Sent response code to blank **IMPORTANT**
End Sub
Private Sub Command1_Click()
SendEmail txtEmailServer.Text, txtFromName.Text, txtFromEmailAddress.Text, txtToEmailAddress.Text, txtToEmailAddress.Text, txtEmailSubject.Text, txtEmailBodyOfMessage.Text
'MsgBox ("Mail Sent")
StatusTxt.Caption = "Mail Sent"
StatusTxt.Refresh
Beep
Close
End Sub
Private Sub Command2_Click()
End
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData Response ' Check for incoming response *IMPORTANT*
End Sub
<end node> 5P9i0s8y19Z
<node>if connected
2
Public Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long
Public Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long
'
Public Const RAS95_MaxEntryName = 256
Public Const RAS95_MaxDeviceType = 16
Public Const RAS95_MaxDeviceName = 32
'
Public Type RASCONN95
dwSize As Long
hRasCon As Long
szEntryName(RAS95_MaxEntryName) As Byte
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
'
Public Type RASCONNSTATUS95
dwSize As Long
RasConnState As Long
dwError As Long
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
'A call to the function IsConnected returns true if the computer has established a connection to the internet.
****************************
Public Function IsConnected() As Boolean
Dim TRasCon(255) As RASCONN95
Dim lg As Long
Dim lpcon As Long
Dim RetVal As Long
Dim Tstatus As RASCONNSTATUS95
'
TRasCon(0).dwSize = 412
lg = 256 * TRasCon(0).dwSize
'
RetVal = RasEnumConnections(TRasCon(0), lg, lpcon)
If RetVal <> 0 Then
MsgBox "ERROR"
Exit Function
End If
'
Tstatus.dwSize = 160
RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)
If Tstatus.RasConnState = &H2000 Then
IsConnected = True
Else
IsConnected = False
End If
End Function
<end node> 5P9i0s8y19Z
<node>Library
1
<end node> 5P9i0s8y19Z
<node>App Path
2
App object]
code: app.path
Exename-returns name of program
Path-returns path of exe
PrevInstance-True or False. Tell if there is a copy already running.
Use this code in the form_load.
Title-Icon title
<end node> 5P9i0s8y19Z
<node>Arrays
2
Function PermitSql(Level%, ParamArray sqlVar()) As String
<end node> 5P9i0s8y19Z
<node>classHandle
2
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Const SW_HIDE = 0
Private Const SW_SHOW = 5
Private Const SW_MAXIMIZE = 3
Private Const SW_MINIMIZE = 6
Private Const SW_NORMAL = 1
'================================
Private Sub Command1_Click()
Dim retval As Long, retval1 As Long
Dim s As String
s = Space(255)
retval = FindWindow(vbNullString, Text1.Text)
retval1 = GetClassName(retval, s, 255)
List1.AddItem "Window name: " & Text1.Text
List1.AddItem "Window Hwnd: " & retval
List1.AddItem "Classname: " & s
List1.AddItem "Characters: " & retval1
End Sub
Private Sub Form_Load()
Command1.Default = True
End Sub
Private Sub Option1_Click(Index As Integer)
Dim retval As Long, retval1 As Long, retval2 As Long
s = Space(255)
retval = FindWindow(vbNullString, Text1.Text)
retval1 = GetClassName(retval, s, 255)
If Option1.Item(0) Then
retval2 = ShowWindow(retval, SW_SHOW)
End If
If Option1.Item(1) Then
retval2 = ShowWindow(retval, SW_MINIMIZE)
End If
If Option1.Item(2) Then
retval2 = ShowWindow(retval, SW_HIDE)
End If
If Option1.Item(3) Then
retval2 = ShowWindow(retval, SW_MAXIMIZE)
End If
End Sub
<end node> 5P9i0s8y19Z
<node>ClipBoard
2
[Clipboard]
Retrieving text from clipboard.
txentered = clipboard.GetText()
Saving to the clipboard.
clipboard.SetText (txanswere)
<end node> 5P9i0s8y19Z
<node>Codevb4
2
[api]
Declare Function GetWindowsDirectory Lib "Kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function GetSystemDirectory Lib "Kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function GetDriveType32 Lib "Kernel32" Alias "GetDriveTypeA" (ByVal strWhichDrive As String) As Long
[Dial Phone]
FINO = FREEFILE
OPEN "Com2:2400,N,8,1,RS,DS" FOR RANDOM AS #FINO LEN = 40
'— Dial 999 9999 NB: please substitute this phone number
' it's my friend's and he won't like it if you call
' commas give the phone some time to respond before cutting off
PRINT #FINO, "ATDT 560 6441,,,,,,,,,,,,,"
PRINT "Press any key to hang up…"
k$ = INPUT$(1)
'— Hang up the line
PRINT #FINO, "ATH+++"
CLOSE #FINO
[Find directorises]
MyPath = "c:\" ' Set the path.
MyName = Dir(MyPath, vbDirectory) ' Retrieve the first entry.
Do While MyName <> "" ' Start the loop.
' Ignore the current directory and the encompassing directory.
If MyName <> "." And MyName <> ".." Then
' Use bitwise comparison to make sure MyName is a directory.
If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
Debug.Print MyName ' Display entry only if it
End If ' it represents a directory.
End If
MyName = Dir ' Get next entry.
Loop
[ Doapath]
Private Function strGetDAOPath() As String
Const strMSAPPS$ = "MSAPPS\"
Const strDAO3032$ = "DAO3032.DLL"
'For Win32, first look in the registry
Const strKey = "SOFTWARE\Microsoft\Shared Tools\DAO"
Const strValueName = "Path"
Dim hkey As Long
Dim strPath As String
If RegOpenKey(HKEY_LOCAL_MACHINE, strKey, hkey) Then
RegQueryStringValue hkey, strValueName, strPath
RegCloseKey hkey
End If
If strPath <> "" Then
strPath = GetPathName(strPath)
AddDirSep strPath
strGetDAOPath = strPath
Exit Function
End If
'It's not yet in the registry, so we need to decide
'where the directory should be, and then need to place
'that location in the registry.
If TreatAsWin95() Then
'For Win95, use "Common Files\Microsoft Shared\DAO"
strPath = strGetCommonFilesPath() & ResolveResString(resMICROSOFTSHARED) & "DAO\"
Else
'Otherwise use Windows\MSAPPS\DAO
strPath = gstrWinDir & strMSAPPS & "DAO\"
End If
'Place this information in the registry (note that we point to DAO3032.DLL
'itself, not just to the directory)
If RegCreateKey(HKEY_LOCAL_MACHINE, strKey, "", hkey) Then
RegSetStringValue hkey, strValueName, strPath & strDAO3032, False
RegCloseKey hkey
End If
strGetDAOPath = strPath
#End If
End Function
[Form Background]
1.Place an image on the form
2. Use this load event
Private Sub Form_Load()
Dim intX As Integer
Dim intY As Integer
Dim sngWidth As Single
Dim sngHeight As Single
sngWidth = Image1.Width
sngHeight = Image1.Height
For intX = 0 To Int(ScaleWidth / sngWidth)
For intY = 0 To Int(ScaleHeight / sngHeight)
PaintPicture Image1.Picture, intX * sngWidth, intY * sngHeight, sngWidth, sngHeight, 0, 0
Next
Next
End Sub
[Format]
MyTime = #17:04:23#
MyDate = #January 27, 1993#
' Returns current system time in the system-defined long time format.
MyStr = Format(Time, "Long Time")
' Returns current system date in the system-defined long date format.
MyStr = Format(Date, "Long Date")
MyStr = Format(MyTime, "h:m:s") ' Returns "17:4:23".
MyStr = Format(MyTime, "hh:mm:ss AMPM") ' Returns "05:04:23 PM".
MyStr = Format(MyDate, "dddd, mmm d yyyy") ' Returns "Wednesday,
' Jan 27 1993".
' If format is not supplied, a string is returned.
MyStr = Format(23) ' Returns "23".
' User-defined formats.
MyStr = Format(5459.4, "##,##0.00") ' Returns "5,459.40".
MyStr = Format(334.9, "###0.00") ' Returns "334.90".
MyStr = Format(5, "0.00%") ' Returns "500.00%".
MyStr = Format("HELLO", "<") ' Returns "hello".
MyStr = Format("This is it", ">") ' Returns "THIS IS IT".
The following table identifies characters you can use to create user-defined
date/time formats:
Character Description
: Time separator. In some locales, other characters may be used to represent the
time separator. The time separator separates hours, minutes, and seconds
when time values are formatted. The actual character used as the time separator
in formatted output is determined by your system settings.
/ Date separator. In some locales, other characters may be used to represent
the date separator. The date separator separates the day, month, and year
when date values are formatted. The actual character used as the date separator
in formatted output is determined by your system settings.
c Display the date as ddddd and display the time as t t t t t, in that order.
Display only date information if there is no fractional part to the
date serial number; display only time information if there is no integer portion.
d Display the day as a number without a leading zero (131).
dd Display the day as a number with a leading zero (0131).
ddd Display the day as an abbreviation (SunSat).
dddd Display the day as a full name (SundaySaturday).
ddddd Display the date as a complete date (including day, month, and year),
formatted according to your system's short date format setting.
The default short date format is m/d/yy.
dddddd Display a date serial number as a complete date (including day, month, and year)
formatted according to the long date setting recognized by your system.
The default long date format is mmmm dd, yyyy.
w Display the day of the week as a number (1 for Sunday through 7 for Saturday).
ww Display the week of the year as a number (153).
m Display the month as a number without a leading zero (112).
If m immediately follows h or hh, the minute rather than the month is displayed.
mm Display the month as a number with a leading zero (0112).
If m immediately follows h or hh, the minute rather than the month is displayed.
mmm Display the month as an abbreviation (JanDec).
mmmm Display the month as a full month name (JanuaryDecember).
q Display the quarter of the year as a number (14).
y Display the day of the year as a number (1366).
yy Display the year as a 2-digit number (0099).
yyyy Display the year as a 4-digit number (1009999).
h Display the hour as a number without leading zeros (023).
hh Display the hour as a number with leading zeros (0023).
n Display the minute as a number without leading zeros (059).
nn Display the minute as a number with leading zeros (0059).
s Display the second as a number without leading zeros (059).
ss Display the second as a number with leading zeros (0059).
t t t t t Display a time as a complete time (including hour, minute, and second), formatted using the time separator defined by the time format recognized by your system. A leading zero is displayed if the leading zero option is selected and the time is before 10:00 A.M. or P.M. The default time format is h:mm:ss.
AM/PM Use the 12-hour clock and display an uppercase AM with any hour before noon; display an uppercase PM with any hour between noon and 11:59 P.M.
am/pm Use the 12-hour clock and display a lowercase AM with any hour before noon; display a lowercase PM with any hour between noon and 11:59 P.M.
A/P Use the 12-hour clock and display an uppercase A with any hour before noon; display an uppercase P with any hour between noon and 11:59 P.M.
a/p Use the 12-hour clock and display a lowercase A with any hour before noon; display a lowercase P with any hour between noon and 11:59 P.M.
AMPM Use the 12-hour clock and display the AM string literal as defined by your system with any hour before noon; display the PM string literal as defined by your system with any hour between noon and 11:59 P.M. AMPM can be either uppercase or lowercase, but the case of the string displayed matches the string as defined by your system settings. The default format is AM/PM.
[Get ini]
Sub get_ini(section As String, l As String, r As String)
Dim x As Long, fil$
On Error Resume Next
r = Space(50): l = LTrim$(l)
fil = tree + "fpmon.ini"
If Left$(section, 1) = "@" Then
fil = GetWindowsDir() + "pimsys.ini"
Open fil For Input As #4
If Err <> 0 Then Open fil For Output As #4
Close 4
section = Right$(section, Len(section) – 1)
End If
x = GetPrivateProfileString(section, l, "none", r, 50, fil)
r = Trim(r): r = Left$(r, Len(r) – 1)
End Sub
[Logerror]
Sub logerror(e As String)
If Logerr = False Then Exit Sub
Close 4
Open Tree + "logerror.txt" For Append As #4
Print #4, Str$(Date) + " " + Str$(Time)
Print #4, "error at;" + e + ". " + "Message type " + Str$(Err) + " occuring at " + Str$(Erl)
Print #4, " "; Error$(Err)
Close 4
End Sub
[Logerror setup]
1. Set up menu controls.
Private Sub mnlog_Click()
If mnlog.Caption = "Logerror OFF" Then
mnlog.Caption = "Logerror ON"
Logerr = True
Else
mnlog.Caption = "Logerror OFF"
Logerr = False
End If
Call write_ini("Setup", "logerror", Str$(Logerr))
End Sub
2. Add this form event.
Private Sub Form_Activate()
Dim MyStamp$, Size As Long
On Error Resume Next
Call get_ini("Setup", "logerror", r$)
If Val(r$) = 0 Then
Logerr = False: mnlog.Caption = "Logerror OFF"
MyStamp$ = FileDateTime(Tree + "logerror.txt")
If Format$(MyStamp$, "mmm d yyyy") <> Format$(Now(), "mmm d yyyy") Then Kill Tree + "logerror.txt"
Else
Logerr = True: mnlog.Caption = "Logerror ON"
Size = FileLen(Tree + "logerror.txt")
If Size > 10000 Then m% = MsgBox("Logerror file at 10k+. If there are no problems, permission to delete file.", 36, "Logerror File")
If m% = 6 Then Kill Tree + "logerror.txt"
End If
End Sub
3. Add a error trap.
formloaderr:
If Err = 94 Then Resume Next
Call logerror("fpmon formload")
Resume Next
[Position Form in midi]
Member.Top = 0
Member.Left = Button.Width
Member.Height = Main.Height – 475
Member.Width = Main.Width – Button.Width – 175
[Split path and file]
Function splitpath(p As String)
dim j%
j = 1
Do Until Mid$(p, Len(p) – j, 1) = "\" Or j = Len(p)
j = j + 1
Loop
splitpath = Left$(p, Len(p) – j)
End Function
Function splitfile(p As String)
dim j%
j = 1
Do Until Mid$(p, Len(p) – j, 1) = "\" Or j = Len(p)
j = j + 1
Loop
splitfile = right$(p,j)
End Function
[String Speed]
(c) 1998 VISUAL BASIC PROGRAMMER'S JOURNAL
FAWCETTE TECHNICAL PUBLICATIONS
FILE NAME: BBAp97L3.doc
ISSUE: April 1998
SECTION: Black Belt column
EDITOR: LT
[ Listing 1] VB5
Private Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (dest As Any, source As Any, _
ByVal numBytes As Long)
' insert a new item in a given position of a string array
Sub InsertStringItem(strArr() As String, _
ByVal index As Long, ByVal newItem As String)
Dim lastItem As Long, saveAddr As Long
lastItem = UBound(strArr)
' save descriptor of the last item before it gets
' overwritten
saveAddr = StrPtr(strArr(lastItem))
' shift all the items in one operation
CopyMemory ByVal VarPtr(strArr(index + 1)), _
ByVal VarPtr(strArr(index)), _
(lastItem – index) * 4
' overwrite the descriptor at strArr(index)
' with the last item's descriptor
CopyMemory ByVal VarPtr(strArr(index)), saveAddr,4
' now we can safely replace it with the new string
strArr(index) = newItem
End Sub
' delete an element of a string array, and shift all the
' subsequent items towards lower indexes
Sub DeleteStringItem(strArr() As String, _
ByVal index As Long)
Dim lastItem As Long, saveAddr As Long
lastItem = UBound(strArr)
' save the descriptor of strArr(index)
' before it gets overwritten
saveAddr = StrPtr(strArr(index))
' shift all the items in one operation
CopyMemory ByVal VarPtr(strArr(index)), ByVal _
VarPtr(strArr(index + 1)), (lastItem – index)*4
' overwrite the descriptor of last array item
' with the saved descriptor
CopyMemory ByVal VarPtr(strArr(lastItem)), _
saveAddr, 4
' now we can safely delete the last item
strArr(lastItem) = vbNullString
End Sub
[ Listing 2] VB5
Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (dest As Any, source As Any, _
ByVal numBytes As Long)
Declare Sub ZeroMemory Lib "kernel32" Alias _
"RtlZeroMemory" (dest As Any, ByVal numBytes As Long)
Sub MoveStringArray(source() As String, dest() As String)
Dim firstEl As Long, lastEl As Long, numBytes As Long
firstEl = LBound(source)
lastEl = UBound(source)
numBytes = (lastEl – firstEl + 1) * 4
' start with fresh new array (it clears all its
' descriptors)
ReDim dest(firstEl To lastEl) As String
' copy all the descriptors from source() to dest()
CopyMemory ByVal VarPtr(dest(firstEl)), _
ByVal VarPtr(source(firstEl)), numBytes
' manually clear all the descriptors in source()
ZeroMemory ByVal VarPtr(source(firstEl)), numBytes
End Sub
FBNo96T3.doc 02/03/98 4:48 PM 1
[Trace]
To use enter in the line:
Trc("This is my first line check")
In global section add:
global Trc as integer,Tree as string
In modual add this proceedure:
Sub Trc(e As String)
Static Dt$
If Trc = False Then Exit Sub
Open Tree + "trace.txt" For Append As #4
If Dt$ <> date$ then Dt$=Date$: Print #4, Str$(Date) + " " + Str$(Time)
Print #4, e
Close 4
End Sub
[Track ini setup]
1. Add to bas modual
Declare Function GetWindowsDirectory Lib "Kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
2. Add to form load.
dim h$
h = App.HelpFile
ap$ = App.EXEName
Call get_ini("@" + ap$, "path", r$)
If r$ = "none" Or r$ <> tree Then
rt& = Shell("winhelp.exe" + h,1)
Call write_ini("@" + ap$, "path", tree)
Call write_ini("@" + ap$, "version", Version_no)
If r$ <> Tree Then Call write_ini("@" + ap$, "last path", r$)
Else
Call get_ini("@" + ap$, "version", r$,1)
If r$ <> Version_no Then
rt& = Shell("winhelp.exe" + h)
Call write_ini("@" + ap$, "version", Version_no)
end if
End If
3. Add both the write and get ini.
[Tree]
dim Tree$
Tree = App.Path: If Right$(Tree, 1) <> "\" Then Tree = Tree + "\"
[Version check]
Dim ap$, VersionNo$
VersionNo=GetMyVersion()
ap$ = App.EXEName
'app.helpfile=Tree+"filehere"
'h = App.HelpFile
Call get_ini("@" + ap$, "path", r$)
If r$ = "none" Or r$ <> Tree Then
Call write_ini("@" + ap$, "path", Tree)
Call write_ini("@" + ap$, "version", VersionNo)
If r$ <> Tree Then Call write_ini("@" + ap$, "last path", r$)
Else
Call get_ini("@" + ap$, "version", r$)
If r$ <> VersionNo Then
Call write_ini("@" + ap$, "version", VersionNo)
'rt& = Shell("winhelp.exe " + h, 1)
end if
End If
[Version number]
Public Function GetMyVersion() As String
' Turn version info into something
' like "1.02.0001"
Static strMyVer As String
If strMyVer = "" Then
' Only call once for performance
strMyVer = Trim$(Str$(App.Major)) & "." & Format$(App.Minor, "##00") & "." Format$(App.Revision, "000")
End If
GetMyVersion = strMyVer
End Function
[Write to ini]
Sub write_ini(section$, l$, r$)
Dim x As Long, fil$
On Error Resume Next
l$ = Trim$(l$)
fil = tree + "fpmon.ini"
If Left$(section, 1) = "@" Then
fil = GetWindowsDir() + "pimsys.ini"
Open fil For Input As #4
If Err <> 0 Then Open fil For Output As #4
Close 4
section = Right$(section, Len(section) – 1)
End If
x = WritePrivateProfileString(section$, l$, r$, fil)
End Sub
<end node> 5P9i0s8y19Z
<node>Colors
2
[Colors]
Blue
&HFF0000
Black
&H404040
Cyan
&H00FFFFC0&
Green
&H0080FF80&
White
&H00FFFFFF&
NumberColor NumberColor
0Black &h0 8Gray
1Blue 9Light Blue
2Green 10Light Green
3Cyan 11Light Cyan
4Red &hff 12Light Red
5Magenta 13Light Magenta
6Yellow 14Light Yellow
7White 15Bright White
<end node> 5P9i0s8y19Z
<node>date
2
If Not IsDate(txDir(4).Text) Then MsgBox "Invalid Date", vbCritical, "Try Again": txDir(4).SetFocus: Exit Sub
<end node> 5P9i0s8y19Z
<node>Error trap
2
3265 Item not found in this collection. DAO
[Sub logerror (e As String, m As Integer)]
Call errormess(m)
Open tree + "logerror.txt" For Append As #4
Print #4, Str$(Date) + " " + Str$(Time)
Print #4, "error at;" + e + ". " + "Message type " + Str$(Err) + " occuring at " + Str$(Erl)
Close 4
End Sub
<end node> 5P9i0s8y19Z
<node>Error
3
[form errors]
Sub Form_Error (dataerr As Integer, response As Integer)
If dataerr = 3201 Then
SendKeys "{esc}"
response = data_errcontinue
Exit Sub
End If
If dataerr = 2169 Then
response = data_errcontinue
Exit Sub
End If
Call logerror("entries" + Str(dataerr), m%)
MsgBox (Str(dataerr))
End Sub
<end node> 5P9i0s8y19Z
<node>errorlog
2
[Visual basic]
3 Return without GoSub
5 Invalid procedure call
6 Overflow
7 Out of memory
9 Subscript out of range
10 This array is fixed or temporarily locked
11 Division by zero
13 Type mismatch
14 Out of string space
16 Expression too complex
17 Can't perform requested operation
18 User interrupt occurred
20 Resume without error
28 Out of stack space
35 Sub, Function, or Property not defined
47 Too many DLL application clients
48 Error in loading DLL
49 Bad DLL calling convention
51 Internal error
52 Bad file name or number
53 File not found
54 Bad file mode
55 File already open
57 Device I/O error
58 File already exists
59 Bad record length
61 Disk full
62 Input past end of file
63 Bad record number
67 Too many files
68 Device unavailable
70 Permission denied
71 Disk not ready
74 Can't rename with different drive
75 Path/File access error
76 Path not found
91 Object variable or With block variable not set
92 For loop not initialized
93 Invalid pattern string
94 Invalid use of Null
97 Can't call Friend procedure on an object that is not an instance of the defining class
98 A property or method call cannot include a reference to a private object, either as an argument or as a return value (Error 98)
260 No timer available
280 DDE channel not fully closed; awaiting response from foreign application
281 No More DDE channels
282 No foreign application responded to a DDE initiate
283 Multiple applications responded to a DDE initiate
284 DDE channel locked
285 Foreign application won't perform DDE method or operation
286 Timeout while waiting for DDE response
287 User pressed Escape key during DDE operation
288 Destination is busy
289 Data not provided in DDE operation
290 Data in wrong format
291 Foreign application quit
292 DDE conversation closed or changed
293 DDE method invoked with no channel open
294 Invalid DDE Link format
295 Message queue filled; DDE message lost
296 PasteLink already performed on this control
297 Can't set LinkMode; invalid Link Topic
298 System DLL 'dll'' could not be loaded (Error 298)
320 Can't use character device names in file names: 'item'
321 Invalid file format
325 Invalid format in resource file
326 Resource with identifier 'item' not found
335 Could not access system registry
336 Object server not correctly registered
337 Object server not found
338 Object server did not correctly run
340 Control array element 'item' doesn't exist
341 Invalid control array index
342 Not enough room to allocate control array 'item'
343 Object not an array
344 Must specify index for object array
345 Reached limit: cannot create any more controls for this form
360 Object already loaded
361 Can't load or unload this object
362 Can't unload controls created at design time
363 Custom control 'item' not found
364 Object was unloaded
365 Unable to unload within this context
366 No MDI form available to load
368 The specified file is out of date. This program requires a later version
371 The specified object can't be used as an owner form for Show
380 Invalid property value
381 Invalid property array index
382 'Item' property cannot be set at run time
383 'Item' property is read-only
384 A form can't be moved or sized while minimized or maximized
385 Must specify index when using property array
386 'Item' property not available at run time
387 'Item' property can't be set on this control
388 Can't set Visible property from a parent menu
389 Invalid key
390 No Defined Value
391 Name not available
393 'Item' property cannot be read at run time
394 'Item' property is write-only
395 Can't use separator bar as menu name
396 'Item' property cannot be set within a page
397 Can't set Visible property for top level menus while they are merged
400 Form already displayed; can't show modally
401 Can't show non-modal form when modal form is displayed
402 Must close or hide topmost modal form first
403 MDI forms cannot be shown modally
404 MDI child forms cannot be shown modally
419 Permission to use object denied
422 Property not found
423 Property or method not found
424 Object required
425 Invalid object use
426 Only one MDI Form allowed
427 Invalid object type; Menu control required
428 Popup menu must have at least one submenu
*************************** Ole Automation errors Start ************************
429 ActiveX component can't create object or return reference to this object
430 Class doesn't support Automation
432 File name or class name not found during Automation operation
438 Object doesn't support this property or method
440 Automation error
442 Connection to type library or object library for remote process has been lost
443 Automation object doesn't have a default value
445 Object doesn't support this action
446 Object doesn't support named arguments
447 Object doesn't support current locale setting
448 Named argument not found
449 Argument not optional or invalid property assignment
450 Wrong number of arguments or invalid property assignment
451 Object not a collection
********************** Ole Automation errors End ************************
452 Invalid ordinal
453 Specified DLL function not found
454 Code resource not found
455 Code resource lock error
457 This key is already associated with an element of this collection
458 Variable uses a type not supported in Visual Basic
459 This component doesn't support the set pf events
460 Invalid Clipboard format
461 Specified format doesn't match format of data
480 Can't create AutoRedraw image
481 Invalid picture
482 Printer error
483 Printer driver does not support specified property
484 Problem getting printer information from the system. Make sure the printer is set up correctly
485 Invalid picture type
486 Can't print form image to this type of printer
520 Can't empty Clipboard
521 Can't open Clipboard
735 Can't save file to TEMP directory
744 Search text not found
746 Replacements too long
[Jet Dao]
lass Description
———————————————————————–
BTRIEVE Btrieve installable ISAM-specific errors (Microsoft Jet
version 2.5 and earlier)
DAO DAO-specific errors
DBASE dBASE installable ISAM-specific errors
DDL Data Definition Language-specific errors
EXCEL Microsoft Excel installable ISAM-specific errors
IMEX Generic import/export errors
INST ISAM Generic installable ISAM errors
ISAM Generic Microsoft Jet ISAM errors
JPM Microsoft Jet errors related to property management
EXTENDED Errors that could have extended error information
MISC Microsoft Jet errors not fitting into another category
PARADOX Paradox installable ISAM-specific errors
QUERY Microsoft Jet errors related to queries
REF INTEGRITY Microsoft Jet errors related to referential integrity
REMOTE Microsoft Jet errors specific to ODBC
REPLICATOR Microsoft Jet errors related to replication
SECURITY Microsoft Jet errors related to security
TEXT Text installable ISAM-specific errors
UNUSED Microsoft Jet errors that are no longer used or that
have special meaning. Errors that have special meaning
are usually translations from other errors and are not
generated in the Microsoft Jet code.
NOTE: An asterisk (*) means that there is no Jet error message text for a particular error message. An '|' represents a
placeholder for a value that is given when the error message is displayed.
Error# Microsoft Jet Database Engine Error Message Class
3001 Invalid argument. MISC
3002 Couldn't start session. ISAM
3003 Couldn't start transaction; too many transactions
already nested. ISAM
3004 Couldn't find database '|'. REPLICATOR
3005 '|' isn't a valid database name. ISAM
3006 Database '|' is exclusively locked. ISAM
3007 Can't open library database '|'. ISAM
3008 Table '|' is exclusively locked. ISAM
3009 Couldn't lock table '|'; currently in use. ISAM
3010 Table '|' already exists. MISC
3011 Couldn't find object '|'. MISC
3012 Object '|' already exists. ISAM
3013 Couldn't rename installable ISAM file. ISAM
3014 Can't open any more tables. ISAM
3015 '|' isn't an index in this table. ISAM
3016 Field won't fit in record. ISAM
3017 The size of a field is too long. MISC
3018 Couldn't find field '|'. MISC
3019 Operation invalid without a current index. ISAM
3020 Update or CancelUpdate without AddNew or Edit. MISC
3021 No current record. MISC
3022 Duplicate value in index, primary key, or
relationship. Changes were unsuccessful. ISAM
3023 AddNew or Edit already used. QUERY
3024 Couldn't find file '|'. MISC
3025 Can't open any more files. ISAM
3026 Not enough space on disk. ISAM
3027 Can't update. Database or object is read-only. MISC
3028 Can't start your application. The system database
is missing or opened exclusively by another user. ISAM
3029 Not a valid account name or password. SECURITY
3030 '|' isn't a valid account name. SECURITY
3031 Not a valid password. SECURITY
3032 Can't perform this operation. SECURITY
3033 No permission for '|'. MISC
3034 Commit or Rollback without BeginTrans. ISAM
3035 * MISC
3036 Database has reached maximum size. ISAM
3037 Can't open any more tables or queries. MISC
3038 * ISAM
3039 Couldn't create index; too many indexes already
defined. ISAM
3040 Disk I/O error during read. ISAM
3041 Can't open a database created with a previous
version of your application. ISAM
3042 Out of MS-DOS file handles. ISAM
3043 Disk or network error. UNUSED
3044 '|' isn't a valid path. ISAM
3045 Couldn't use '|'; file already in use. ISAM
3046 Couldn't save; currently locked by another user. ISAM
3047 Record is too large. ISAM
3048 Can't open any more databases. ISAM
3049 Can't open database '|'. It may not be a database
that your application recognizes, or the file may
be corrupt. MISC
3050 Couldn't lock file. ISAM
3051 Couldn't open file '|'. MISC
3052 MS-DOS file sharing lock count exceeded. You need
to increase the number of locks installed with
SHARE.EXE. ISAM
3053 Too many client tasks. MISC
3054 Too many Memo or OLE object fields. UNUSED
3055 Not a valid file name. MISC
3056 Couldn't repair this database. MISC
3057 Operation not supported on attached, or linked,
tables. MISC
3058 Index or primary key can't contain a null value. ISAM
3059 Operation canceled by user. MISC
3060 Wrong data type for parameter '|'. QUERY
3061 Too few parameters. Expected '|'. EXTENDED
3062 Duplicate output alias '|'. EXTENDED
3063 Duplicate output destination '|'. EXTENDED
3064 Can't open action query '|'. QUERY
3065 Can't execute a non-action query. QUERY
3066 Query or table must contain at least one output
field. EXTENDED
3067 Query input must contain at least one table or
query. EXTENDED
3068 Not a valid alias name. QUERY
3069 The action query '|' cannot be used as a row source. EXTENDED
3070 Can't bind name '|'. QUERY
3071 Can't evaluate expression. QUERY
3072 '|' EXTENDED
3073 Operation must use an updatable query. QUERY
3074 Can't repeat table name '|' in FROM clause. EXTENDED
3075 '|1' in query expression '|2'. EXTENDED
3076 '|' in criteria expression. EXTENDED
3077 '|' in expression. EXTENDED
3078 Couldn't find input table or query '|'. EXTENDED
3079 Ambiguous field reference '|'. EXTENDED
3080 Joined table '|' not listed in FROM clause. EXTENDED
3081 Can't join more than one table with the same
name ('|'). EXTENDED
3082 JOIN operation '|' refers to a non-joined table. EXTENDED
3083 Can't use internal report query. QUERY
3084 Can't insert data with action query. QUERY
3085 Undefined function '|' in expression. EXTENDED
3086 Couldn't delete from specified tables. QUERY
3087 Too many expressions in GROUP BY clause. QUERY
3088 Too many expressions in ORDER BY clause. QUERY
3089 Too many expressions in DISTINCT output. QUERY
3090 Resultant table not allowed to have more than one
Counter or AutoNumber field. ISAM
3091 HAVING clause ('|') without grouping or aggregation. UNUSED
3092 Can't use HAVING clause in TRANSFORM statement. EXTENDED
3093 ORDER BY clause ('|') conflicts with DISTINCT. EXTENDED
3094 ORDER BY clause ('|') conflicts with GROUP BY
clause. EXTENDED
3095 Can't have aggregate function in expression ('|'). EXTENDED
3096 Can't have aggregate function in WHERE clause ('|'). EXTENDED
3097 Can't have aggregate function in ORDER BY
clause ('|'). EXTENDED
3098 Can't have aggregate function in GROUP BY
clause ('|'). EXTENDED
3099 Can't have aggregate function in JOIN
operation ('|'). EXTENDED
3100 Can't set field '|' in join key to Null. EXTENDED
3101 There is no record in table '|2' with key matching
field(s) '|1'. EXTENDED
3102 Circular reference caused by '|'. EXTENDED
3103 Circular reference caused by alias '|' in query
definition's SELECT list. EXTENDED
3104 Can't specify Fixed Column Heading '|' in a
crosstab query more than once. EXTENDED
3105 Missing destination field name in SELECT INTO
statement ('|'). EXTENDED
3106 Missing destination field name in UPDATE
statement ('|'). EXTENDED
3107 Record(s) can't be added; no Insert Data permission
on '|'. EXTENDED
3108 Record(s) can't be edited; no Update Data permission
on '|'. EXTENDED
3109 Record(s) can't be deleted; no Delete Data
permission on '|'. EXTENDED
3110 Couldn't read definitions; no Read Design permission
for table or query '|'. EXTENDED
3111 Couldn't create; no Create permission for table or query
'|'. EXTENDED
3112 Record(s) can't be read; no Read Data permission
on '|'. EXTENDED
3113 Can't update '|'; field not updatable. UNUSED
3114 Can't include Memo or OLE object when you select
unique values ('|'). EXTENDED
3115 Can't have Memo or OLE object in aggregate argument
('|'). EXTENDED
3116 Can't have Memo or OLE object in criteria ('|') for
aggregate function. EXTENDED
3117 Can't sort on Memo or OLE object ('|'). EXTENDED
3118 Can't join on Memo or OLE object ('|'). EXTENDED
3119 Can't group on Memo or OLE object ('|'). EXTENDED
3120 Can't group on fields selected with '*' ('|'). EXTENDED
3121 Can't group on fields selected with '*'. EXTENDED
3122 '|' not part of aggregate function or grouping. EXTENDED
3123 Can't use '*' in crosstab query. EXTENDED
3124 Can't input from internal report query ('|'). QUERY
3125 '|' isn't a valid name. MISC
3126 Invalid bracketing of name '|'. EXTENDED
3127 INSERT INTO statement contains unknown field
name '|'. EXTENDED
3128 Must specify tables to delete from. QUERY
3129 Invalid SQL statement; expected DELETE, INSERT,
PROCEDURE, SELECT, or UPDATE. QUERY
3130 Syntax error in DELETE statement. QUERY
3131 Syntax error in FROM clause. QUERY
3132 Syntax error in GROUP BY clause. QUERY
3133 Syntax error in HAVING clause. QUERY
3134 Syntax error in INSERT statement. QUERY
3135 Syntax error in JOIN operation. QUERY
3136 Syntax error in LEVEL clause. QUERY
3137 Missing semicolon (;) at end of SQL statement. QUERY
3138 Syntax error in ORDER BY clause. QUERY
3139 Syntax error in PARAMETER clause. QUERY
3140 Syntax error in PROCEDURE clause. QUERY
3141 Syntax error in SELECT statement. QUERY
3142 Characters found after end of SQL statement. QUERY
3143 Syntax error in TRANSFORM statement. QUERY
3144 Syntax error in UPDATE statement. QUERY
3145 Syntax error in WHERE clause. QUERY
3146 ODBC – call failed. UNUSED
3147 * UNUSED
3148 * UNUSED
3149 * UNUSED
3150 * UNUSED
3151 ODBC – connection to '|' failed. EXTENDED
3152 * UNUSED
3153 * UNUSED
3154 ODBC – couldn't find DLL '|'. REMOTE
3155 ODBC – insert failed on attached (linked)
table '|'. EXTENDED
3156 ODBC – delete failed on attached (linked)
table '|'. EXTENDED
3157 ODBC – update failed on attached (linked)
table '|'. EXTENDED
3158 Couldn't save record; currently locked by
another user. INST ISAM
3159 Not a valid bookmark. MISC
3160 Table isn't open. INST ISAM
3161 Couldn't decrypt file. INST ISAM
3162 Null is invalid. MISC
3163 Couldn't perform operation; data too long for field. MISC
3164 Field can't be updated. MISC
3165 Couldn't open .INF file. DBASE
3166 Missing memo file. DBASE
3167 Record is deleted. MISC
3168 Invalid .INF file. DBASE
3169 Illegal type in expression. QUERY
3170 Couldn't find installable ISAM. UNUSED
3171 Couldn't find net path or user name. PARADOX
3172 Couldn't open PARADOX.NET. UNUSED
3173 Couldn't open table 'MSysAccounts' in the system
database file. SECURITY
3174 Couldn't open table 'MSysGroups' in the system
database file. SECURITY
3175 Date is out of range or is in an invalid format. INST ISAM
3176 Couldn't open file '|'. IMEX
3177 Not a valid table name. IMEX
3178 * IMEX
3179 Encountered unexpected end of file. IMEX
3180 Couldn't write to file '|'. IMEX
3181 Invalid range. IMEX
3182 Invalid file format. IMEX
3183 Not enough space on temporary disk. ISAM
3184 Couldn't execute query; couldn't find attached,
or linked, table. EXTENDED
3185 SELECT INTO remote database tried to produce too
many fields. EXTENDED
3186 Couldn't save; currently locked by user '|2' on
machine '|1'. EXTENDED
3187 Couldn't read; currently locked by user '|2' on
machine '|1'. EXTENDED
3188 Couldn't update; currently locked by another
session on this machine. ISAM
3189 Table '|1' is exclusively locked by user '|3' on
machine '|2'. UNUSED
3190 Too many fields defined. ISAM
3191 Can't define field more than once. ISAM
3192 Couldn't find output table '|'. EXTENDED
3193 (unknown) UNUSED
3194 (unknown) UNUSED
3195 (expression) UNUSED
3196 Couldn't use '|'; database already in use. ISAM
3197 Data has changed; operation stopped. MISC
3198 Couldn't start session. Too many sessions already
active. ISAM
3199 Couldn't find reference.
3200 Can't delete or change record. Since related
records exist in table '|', referential integrity
rules would be violated. EXTENDED
3201 Can't add or change record. Referential integrity
rules require a related record in table '|'. EXTENDED
3202 Couldn't save; currently locked by another user. ISAM
3203 Can't specify subquery in expression ('|'). EXTENDED
3204 Database already exists. ISAM
3205 Too many crosstab column headers ('|'). EXTENDED
3206 Can't create a relationship between a field
and itself. REF INTEGRITY
3207 Operation not supported on Paradox table with no
primary key. PARADOX
3208 Invalid Deleted entry in the Xbase section of
initialization setting. DBASE
3209 Invalid Stats entry in the Xbase section of
initialization setting. DBASE
3210 Connection string too long. QUERY
3211 Couldn't lock table '|'; currently in use. EXTENDED
3212 Couldn't lock table '|1'; currently in use by user
'|3' on machine '|2'. UNUSED
3213 Invalid Date entry in the Xbase section of
initialization setting. DBASE
3214 Invalid Mark entry in the Xbase section of
initialization setting. DBASE
3215 Too many Btrieve tasks. BTRIEVE
3216 Parameter '|' specified where a table name is
required. EXTENDED
3217 Parameter '|' specified where a database name is
required. EXTENDED
3218 Couldn't update; currently locked. ISAM
3219 Invalid operation. MISC
3220 Incorrect collating sequence. PARADOX
3221 Invalid entries in the Btrieve section of
initialization setting. BTRIEVE
3222 Query can't contain a Database parameter. QUERY
3223 '|' isn't a valid parameter name. EXTENDED
3224 Can't read Btrieve data dictionary. BTRIEVE
3225 Encountered record locking deadlock while
performing Btrieve operation. BTRIEVE
3226 Errors encountered while using the Btrieve DLL. BTRIEVE
3227 Invalid Century entry in the Xbase section of
initialization setting. DBASE
3228 Invalid Collating Sequence. PARADOX
3229 Btrieve – can't change field. BTRIEVE
3230 Out-of-date Paradox lock file. PARADOX
3231 ODBC – field would be too long; data truncated. REMOTE
3232 ODBC – couldn't create table. REMOTE
3233 * UNUSED
3234 ODBC – remote query timeout expired. REMOTE
3235 ODBC – data type not supported on server. REMOTE
3236 * UNUSED
3237 * UNUSED
3238 ODBC – data out of range. REMOTE
3239 Too many active users. ISAM
3240 Btrieve – missing Btrieve engine. BTRIEVE
3241 Btrieve – out of resources. BTRIEVE
3242 Invalid reference in SELECT statement. EXTENDED
3243 None of the import field names match fields in the
appended table. IMEX
3244 Can't import password-protected spreadsheet. IMEX
3245 Couldn't parse field names from first row of
import table. IMEX
3246 Operation not supported in transactions. MISC
3247 ODBC – linked table definition has changed. REMOTE
3248 Invalid NetworkAccess entry in initialization
setting. INST ISAM
3249 Invalid PageTimeout entry in initialization
setting. INST ISAM
3250 Couldn't build key. ISAM
3251 Operation is not supported for this type of object. MISC
3252 Can't open form whose underlying query contains a
user-defined function that attempts to set or get
the form's RecordsetClone property.MISC
3253 * UNUSED
3254 ODBC – Can't lock all records. REMOTE
3255 * UNUSED
3256 Index file not found. DBASE
3257 Syntax error in WITH OWNERACCESS OPTION declaration. QUERY
3258 Query contains ambiguous outer joins. QUERY
3259 Invalid field data type. MISC
3260 Couldn't update; currently locked by user '|2'
on machine '|1'. EXTENDED
3261 '|' EXTENDED
3262 '|' EXTENDED
3263 Invalid database object. MISC
3264 No fields defined – cannot append Tabledef or Index. DAO
3265 Item not found in this collection. DAO
3266 Can't append. Field is part of a TableDefs
collection. DAO
3267 Property can be set only when the field is part of
a Recordset object's Fields collection. DAO
3268 Can't set this property once the object is part of
a collection. DAO
3269 Can't append. Index is part of a TableDefs
collection. DAO
3270 Property not found. DAO
3271 Invalid property value. DAO
3272 Object isn't a collection. DAO
3273 Method not applicable for this object. DAO
3274 External table isn't in the expected format. INST ISAM
3275 Unexpected error from external database
driver ('|'). INST ISAM
3276 Invalid database ID. MISC
3277 Can't have more than 10 fields in an index. ISAM
3278 Database engine hasn't been initialized. MISC
3279 Database engine has already been initialized. MISC
3280 Can't delete a field that is part of an index or is
needed by the system. ISAM
3281 Can't delete this index. It is either the current
index or is used in a relationship. ISAM
3282 Can't create field or index in a table that
is already defined. ISAM
3283 Primary key already exists. ISAM
3284 Index already exists. ISAM
3285 Invalid index definition. ISAM
3286 Format of memo file doesn't match specified external
database format. INST ISAM
3287 Can't create index on the given field. ISAM
3288 Paradox index is not primary. PARADOX
3289 Syntax error in CONSTRAINT clause. DDL
3290 Syntax error in CREATE TABLE statement. DDL
3291 Syntax error in CREATE INDEX statement. DDL
3292 Syntax error in field definition. DDL
3293 Syntax error in ALTER TABLE statement. DDL
3294 Syntax error in DROP INDEX statement. DDL
3295 Syntax error in DROP TABLE or DROP INDEX. DDL
3296 Join expression not supported. MISC
3297 Couldn't import table or query. No records found,
or all records contain errors. IMEX
3298 There are several tables with that name. Please
specify owner in the format owner.table. REMOTE
3299 ODBC Specification Conformance Error ('|'). This
error should be reported to the ODBC driver
vendor. UNUSED
3300 Can't create a relationship. REF INTEGRITY
3301 Can't perform this operation; features in this
version are not available in databases with
older formats. MISC
3302 Can't change a rule while the rules for this table
are in use. TLV
3303 Can't delete this field. It's part of one or more
relationships. REF INTEGRITY
3304 You must enter a personal identifier (PID)
consisting of at least four and no more than 20
characters and digits. SECURITY
3305 Invalid connection string in pass-through query. REMOTE
3306 At most one field can be returned from a subquery
that doesn't use the EXISTS keyword. QUERY
3307 The number of columns in the two selected tables
or queries of a union query don't match. QUERY
3308 Invalid TOP argument in select query. EXTENDED
3309 Property setting can't be larger than 2 KB. JPM
3310 This property isn't supported for external data
sources or for databases created in a previous
version. JPM
3311 Property specified already exists. JPM
3312 Validation rules and default values can't be placed
on system or attached (linked) tables. TLV
3313 Can't place this validation expression on this
field. TLV
3314 Field '|' can't contain a null value. EXTENDED
3315 Field '|' can't be a zero-length string. EXTENDED
3316 '|' EXTENDED
3317 One or more values entered is prohibited by the
validation rule '|2' set for '|1'. UNUSED
3318 Top not allowed in delete queries. EXTENDED
3319 Syntax error in union query. QUERY
3320 '|' in table-level validation expression. EXTENDED
3321 No database specified in connection string or IN
clause. REMOTE
3322 Crosstab query contains one or more invalid fixed
column headings. EXTENDED
3323 The query cannot be used as a row source. QUERY
3324 This query is a DDL query and cannot be used as a
row source. QUERY
3325 Pass-through query with ReturnsRecords property
set to True did not return any records. REMOTE
3326 This Recordset is not updatable. EXTENDED
3327 Field '|' is based on an expression and can't be
edited. EXTENDED
3328 Table '|2' is read-only. EXTENDED
3329 Record in table '|' was deleted by another user. EXTENDED
3330 Record in table '|' is locked by another user. EXTENDED
3331 To make changes to this field, first save the
record. EXTENDED
3332 Can't enter value into blank field on "one" side
of outer join. EXTENDED
3333 Records in table '|' would have no record on
the "one" side. EXTENDED
3334 Can be present only in version 1.0 format. ISAM
3335 DeleteOnly called with non-zero cbData. JPM
3336 Btrieve: Invalid IndexDDF option in initialization
setting. BTRIEVE
3337 Invalid DataCodePage option in initialization
setting. BTRIEVE
3338 Btrieve: Xtrieve options aren't correct in
initialization setting. BTRIEVE
3339 Btrieve: Invalid IndexDeleteRenumber option in
initialization setting. BTRIEVE
3340 Query '|' is corrupt. EXTENDED
3341 Current field must match join key '|' on "one" side
of one-to-many relationship because it has been
updated. EXTENDED
3342 Invalid Memo or OLE object in subquery '|'. EXTENDED
3343 Unrecognized database format '|'. EXTENDED
3344 Unknown or invalid reference '|1' in validation
expression or default value in table '|2'. EXTENDED
3345 Unknown or invalid field reference '|'. EXTENDED
3346 Number of query values and destination fields
aren't the same. QUERY
3347 Can't add record(s); primary key for table '|' not
in recordset. EXTENDED
3348 Can't add record(s); join key of table '|' not in
recordset. EXTENDED
3349 Numeric field overflow. INST ISAM
3350 Object is invalid for operation. ISAM
3351 ORDER BY expression ('|') uses non-output fields. EXTENDED
3352 No destination field name in INSERT INTO statement
('|'). EXTENDED
3353 Btrieve: Can't find file FIELD.DDF. BTRIEVE
3354 At most one record can be returned by this subquery. QUERY
3355 Syntax error in default value. TLV
3356 The database is opened by user '|2' on
machine '|1'. EXTENDED
3357 This query is not a properly formed data-definition
query. QUERY
3358 Can't open Microsoft Jet engine system database. MISC
3359 Pass-through query must contain at least one
character. QUERY
3360 Query is too complex. QUERY
3361 Unions not allowed in a subquery. QUERY
3362 Single-row update/delete affected more than one
row of an attached (linked) table. Unique index
contains duplicate values. REMOTE
3363 Record(s) can't be added; no corresponding record
on the "one" side. EXTENDED
3364 Can't use Memo or OLE object field '|' in SELECT
clause of a union query. EXTENDED
3365 Property value not valid for REMOTE objects. DAO
3366 Can't append a relation with no fields defined. DAO
3367 Can't append. Object already in collection. DAO
3368 Relationship must be on the same number of fields
with the same data types. DDL
3369 Can't find field in index definition. DDL
3370 Can't modify the design of table '|'. It's in a
read-only database. EXTENDED
3371 Can't find table or constraint. EXTENDED
3372 No such index '|2' on table '|1'. EXTENDED
3373 Can't create relationship. Referenced table '|'
doesn't have a primary key. EXTENDED
3374 The specified fields are not uniquely indexed in
table '|'. EXTENDED
3375 Table '|1' already has an index named '|2'. EXTENDED
3376 Table '|' doesn't exist. EXTENDED
3377 No such relationship '|2' on table '|1'. EXTENDED
3378 There is already a relationship named '|' in the
current database. EXTENDED
3379 Can't create relationships to enforce referential
integrity. Existing data in table '|2' violates
referential integrity rules with related table
'|1'. EXTENDED
3380 Field '|2' already exists in table '|1'. EXTENDED
3381 There is no field named '|2' in table '|1'. EXTENDED
3382 The size of field '|' is too long. EXTENDED
3383 Can't delete field '|'. It's part of one or more
relationships. EXTENDED
3384 Can't delete a built-in property. DAO
3385 User-defined properties don't support a Null value. DAO
3386 Property '|' must be set before using this method. DAO
3387 Can't find TEMP directory. UNUSED
3388 Unknown function '|2' in validation expression or
default value on '|1'. EXTENDED
3389 Query support unavailable. MISC
3390 Account name already exists. SECURITY
3391 An error has occurred. Properties were not saved. JPM
3392 There is no primary key in table '|'. EXTENDED
3393 Can't perform join, group, sort, or indexed
restriction. A value being searched or sorted on
is too long. QUERY
3394 Can't save property; property is a schema property. JPM
3395 Invalid referential integrity constraint. REF INTEGRITY
3396 Can't perform cascading operation. Since related
records exist in table '|', referential integrity
rules would be violated. EXTENDED
3397 Can't perform cascading operation. There must be a
related record in table '|'. EXTENDED
3398 Can't perform cascading operation. It would result
in a null key in table '|'. EXTENDED
3399 Can't perform cascading operation. It would result
in a duplicate key in table '|'. EXTENDED
3400 Can't perform cascading operation. It would result
in two updates on field '|2' in table '|1'. EXTENDED
3401 Can't perform cascading operation. It would cause
field '|' to become null, which is not allowed. EXTENDED
3402 Can't perform cascading operation. It would cause
field '|' to become a zero-length string, which
is not allowed. EXTENDED
3403 Can't perform cascading operation: '|'. EXTENDED
3404 Can't perform cascading operation. The value entered
is prohibited by the validation rule '|2' set
for '|1'. UNUSED
3405 Error '|' in validation rule. UNUSED
3406 Error '|' in default value. UNUSED
3407 The server's MSysConf table exists, but is in an
incorrect format. Contact your system
administrator. REMOTE
3408 Too many FastFind Sessions were invoked. MISC
3409 Invalid field name '|' in definition of index or
relationship. EXTENDED
3410 * UNUSED
3411 Invalid entry. Can't perform cascading operation
specified in table '|1' because value entered is
too big for field '|2'. EXTENDED
3412 '|' EXTENDED
3413 Can't perform cascading update on table '|1' because
it is currently in use by user '|3' on machine
'|2'. EXTENDED
3414 Can't perform cascading update on table '|' because
it is currently in use. EXTENDED
3415 Zero-length string is valid only in a text or Memo
field. MISC
3416 '|' UNUSED
3417 An action query cannot be used as a row source. QUERY
3418 Can't open '|'. Another user has the table open
using a different network control file or locking
style. PARADOX
3419 Can't open this Paradox 4.x or Paradox 5.x table
because ParadoxNetStyle is set to 3.x in the
initialization setting. PARADOX
3420 Object is invalid or not set. DAO
3421 Data type conversion error. UNUSED
3422 Can't modify table structure. Another user has the
table open. ISAM
3423 You cannot use ODBC to import from, export to, or
link an external Microsoft Access or ISAM
database table to your database. REMOTE
3424 Can't create database; Invalid locale. ISAM
3425 This method or property is not currently available
on this Recordset. UNUSED
3426 The action was canceled by an associated object. UNUSED
3427 Error in DAO automation. UNUSED
3428 The Jet database engine has encountered a problem
in your database. To correct the problem, you
must repair and compact the database. ISAM
3429 Incompatible installable ISAM version. ISAM
3430 While loading the Excel installable ISAM, OLE was
unable to initialize. EXCEL
3431 This is not an Excel 5 file. EXCEL
3432 Error opening an Excel 5 file. EXCEL
3433 Invalid parameter in ISAM Engines section of the
initialization setting. INST ISAM
3434 Can't expand named range. EXCEL
3435 Cannot delete spreadsheet cells. EXCEL
3436 Failure creating file. EXCEL
3437 Spreadsheet is full. EXCEL
3438 The data being exported does not match the format
described in the SCHEMA.INI file. TEXT
3439 You attempted to attach or import a Microsoft Word
mail merge file. Although you can export such
files, you cannot attach or import them. TEXT
3440 An attempt was made to import or attach to an empty
text file. To import or attach a text file, the
file must contain data. TEXT
3441 Text file specification field separator matches
decimal separator or text delimiter. TEXT
3442 In the text file specification '|1', the '|2'
option is invalid. EXTENDED
3443 The fixed width specification '|1', contains no
column widths. EXTENDED
3444 In the fixed width specification '|1', column '|2'
does not specify a width. EXTENDED
3445 An incorrect version of the Jet DLL file
(MSAJT200.DLL for 16-bit versions, or MSJT2032
for 32-bit versions) was found. The version must
be 2.5 or later. Try reinstalling the application
that returned the error. DAO
3446 The Jet VBA file (VBAJET.DLL for 16-bit versions, or
VBAJET32.DLL for 32-bit versions) is missing. Try
reinstalling the application that returned the
error. DAO
3447 The Jet VBA file (VBAJET.DLL for 16-bit versions,
or VBAJET32.DLL for 32-bit versions) failed to
initialize when called. Try reinstalling the
application that returned the error. DAO
3448 A call to an OLE system function was not
successful. Try reinstalling the application
that returned the error. DAO
3449 No country code was found in the connect string
for an attached table. ISAM
3450 Syntax error in query. Incomplete query clause. EXTENDED
3451 Illegal reference in query. EXTENDED
3452 You cannot make changes to the design of the
database at this replica. REPLICATOR
3453 You can't establish or maintain a relationship
between a replicated table and local table. REPLICATOR
3454 * UNUSED
3455 Cannot make the database replicable. REPLICATOR
3456 Cannot make the '|2' object in '|1' container
replicable. REPLICATOR
3457 You cannot set the KeepLocal Property for an
object that is already replicable. REPLICATOR
3458 The KeepLocal Property cannot be set on a database;
it can be set only on the objects in a database. REPLICATOR
3459 Once a database has been made replicable, it cannot
be made unreplicable. REPLICATOR
3460 The operation you attempted conflicts with an
existing operation involving the replica. REPLICATOR
3461 The replication property you are attempting to set
or delete is read-only and cannot be changed. REPLICATOR
3462 Failure to load a transport .DLL. REPLICATOR
3463 Cannot find the .DLL '|2'. EXTENDED
3464 Data type mismatch in criteria expression. EXTENDED
3465 The disk drive you are attempting to access is
unreadable. EXTENDED
3466 * EXTENDED
3467 * EXTENDED
3468 Access was denied while accessing dropbox '|2'. EXTENDED
3469 The disk for dropbox '|2' is full. EXTENDED
3470 Disk failure accessing dropbox '|2'. EXTENDED
3471 Failure to write to the Transporter log file. ISAM
3472 Disk full for path '|1'. EXTENDED
3473 Disk failure while accessing log file '|1'. EXTENDED
3474 Can't open the log file '|1' for writing. EXTENDED
3475 Sharing violation while attempting to open log file
'|1' in deny write mode. EXTENDED
3476 Invalid dropbox path '|2'. EXTENDED
3477 Dropbox address '|2' is syntactically invalid. EXTENDED
3478 The replica is not a partial replica. REPLICATOR
3479 Cannot make a partial replica the Design Master
for the replica set. REPLICATOR
3480 The relationship '|' in the partial filter
expression is invalid. EXTENDED
3481 The table name '|' in the partial filter
expression is invalid. EXTENDED
3482 The filter expression for the partial replica is
invalid. REPLICATOR
3483 The password supplied for the dropbox '|2' is
invalid. EXTENDED
3484 The password used by the Transporter to write to a
destination dropbox is invalid. REPLICATOR
3485 The object cannot be made replicable because the
database is not replicable. REPLICATOR
3486 You cannot add a second ReplicationID Autonumber
field to a table. REPLICATOR
3487 The database you are attempting to make replicable
cannot be converted. REPLICATOR
3488 The value specified is not a ReplicaID for any
replica in the replica set. REPLICATOR
3489 The object specified is not replicable because it is
missing a necessary resource. REPLICATOR
3490 Cannot make a new replica because the '|2' object
in '|1' container could not be made replicable. REPLICATOR
3491 The database must be opened in exclusive mode
before it can be made replicable. REPLICATOR
3492 The synchronization failed because a design change
could not be applied to one of the replicas. REPLICATOR
3493 Can't set the specified Registry parameter for the
Transporter. REPLICATOR
3494 Unable to retrieve the specified Registry parameter
for the Transporter. REPLICATOR
3495 There are no scheduled exchanges between the two
Transporters. REPLICATOR
3496 The Replication Manager cannot find the ExchangeID
in the MSysExchangeLog table. REPLICATOR
3497 Unable to set a schedule for the Transporter. REPLICATOR
3498 * UNUSED
3499 Can't retrieve the full path information for a
replica. REPLICATOR
3500 Setting an exchange with the same Transporter is
not allowed. REPLICATOR
3501 * UNUSED
3502 The replica is not being managed by a transporter. REPLICATOR
3503 The Transporter's system registry has no value set
for the key you queried. REPLICATOR
3504 The Transporter ID does not match an existing ID
in the MSysTranspAddress table. REPLICATOR
3505 You attempted to delete or get information about a
partial filter that does not exist in
MSysFilters. REPLICATOR
3506 The Transporter is unable to open the transporter
log. REPLICATOR
3507 Failure writing to the Transporter log. REPLICATOR
3508 There is no active transport for the Transporter. REPLICATOR
3509 Could not find a valid transport for this
Transporter. REPLICATOR
3510 The replica you are attempting to exchange with is
currently being used in another exchange. REPLICATOR
3511 * UNUSED
3512 Failure to read the transport dropbox. REPLICATOR
3513 Transport failed to write to a dropbox. REPLICATOR
3514 Transporter could not find any scheduled or
on-demand exchanges to process. REPLICATOR
3515 The Jet database engine could not find the system
clock on your computer. REPLICATOR
3516 Could not find transport address. REPLICATOR
3517 Transporter could not find any messages to process. REPLICATOR
3518 Could not find Transporter in the MSysTranspAddress
table. REPLICATOR
3519 Transport failed to send a message. REPLICATOR
3520 The replica name or ID does not match a currently
managed replica. REPLICATOR
3521 The two replicas cannot be synchronized because
there is no common point to start the
synchronization. REPLICATOR
3522 The Transporter cannot find the record of a
specific exchange in the MSysExchangeLog table. REPLICATOR
3523 The Transporter cannot find a specific version
number in the MSysSchChange table. REPLICATOR
3524 The history of design changes in the replica does
not match the history in the design-master
replica. REPLICATOR
3525 Transporter could not access the message database. REPLICATOR
3526 The name selected for the system object is already
in use. REPLICATOR
3527 The Transporter or Replication Manager could not
find the system object. REPLICATOR
3528 There is no new data in shared memory for the
Transporter or Replication Manager to read. REPLICATOR
3529 The Transporter or Replication Manager found
previous data in the shared memory. The existing
data will be overwritten. REPLICATOR
3530 The Transporter is already serving a client. REPLICATOR
3531 The wait period for an event has timed-out. REPLICATOR
3532 Transport could not be initialized. REPLICATOR
3533 The system object used by a process still exists
after the process has stopped. REPLICATOR
3534 Transporter looked for system event but did not
find one to report to client. REPLICATOR
3535 Client has asked the Transporter to terminate
operation. REPLICATOR
3536 Transporter received an invalid message for a
replica it manages. REPLICATOR
3537 The Transporter's client is no longer present and
cannot be notified. REPLICATOR
3538 Cannot initialize Transporter because there are
too many applications running. REPLICATOR
3539 A system error has occurred in the disk I/O for a
system drive or your page file has reached its
limit. REPLICATOR
3540 Your page file has reached its limit or is
corrupted. REPLICATOR
3541 The Transporter could not be shut down properly
and is still active. REPLICATOR
3542 Process aborted when attempting to terminate
Transporter client. REPLICATOR
3543 Transporter has not been set up. REPLICATOR
3544 The Transporter is already running. REPLICATOR
3545 The two replicas you are attempting to synchronize
are from different replica sets. REPLICATOR
3546 The type of exchange you are attempting is not
valid. REPLICATOR
3547 The Transporter could not find a replica from the
correct set to complete the exchange. REPLICATOR
3548 GUIDs do not match or the requested GUID could
not be found. REPLICATOR
3549 The file name you provided is too long. REPLICATOR
3550 There is no index on the Guid column. REPLICATOR
3551 Unable to delete the specified registry parameter
for the Transporter. REPLICATOR
3552 The size of the registry parameter exceeds the
maximum allowed. REPLICATOR
3553 The GUID could not be created. REPLICATOR
3554 * UNUSED
3555 All valid nicknames for replicas are already in
use. REPLICATOR
3556 Invalid path for destination dropbox. REPLICATOR
3557 Invalid address for destination dropbox. REPLICATOR
3558 Disk I/O error at destination dropbox. REPLICATOR
3559 Failure to write because destination disk is full. REPLICATOR
3560 The two replicas you are attempting to synchronize
have the same ReplicaID. REPLICATOR
3561 The two replicas you are attempting to synchronize
both have design-master status. REPLICATOR
3562 Access denied at destination dropbox. REPLICATOR
3563 Fatal error accessing a local dropbox. REPLICATOR
3564 Transporter cannot find the source file for
messages. REPLICATOR
3565 There is a sharing violation in the source dropbox
because the message database is open in another
application.REPLICATOR
3566 Network I/O error. REPLICATOR
3567 Message in dropbox belongs to the wrong
Transporter. REPLICATOR
3568 Transporter could not delete a file. REPLICATOR
3569 The replica has been logically removed from the
replica set and is no longer available. REPLICATOR
3570 The filters defining a partial replica are out of
synch with each other. REPLICATOR
3571 The attempt to set a column in a partial replica
violated a rule governing partial replicas. REPLICATOR
3572 A disk I/O error occurred while reading or writing
to the TEMP directory. REPLICATOR
3573 The directory you queried for a list of replicas
is not a managed directory. REPLICATOR
3574 The ReplicaID for this replica was reassigned
during a move or copy procedure. REPLICATOR
3575 The disk drive you are attempting to write to is
full. EXTENDED
3576 The database you are attempting to open is already
in use by another application. EXTENDED
3577 Can't update replication system column. EXTENDED
3578 Failure to replicate database; can't determine
whether database is open in exclusive mode. EXTENDED
3579 Could not create replication system tables needed
to make the database replicable. EXTENDED
3580 Could not add rows needed to make the database
replicable. EXTENDED
3581 Can't open replication system table '|' because the
table is already in use. EXTENDED
3582 Cannot make a new replica because the '|2' object
in '|1' container could not be made replicable. EXTENDED
3583 Cannot make the '|2' object in '|1' container
replicable. EXTENDED
3584 Insufficient memory to complete operation. EXTENDED
3585 Can't replicate the table; the number of columns
exceeds the maximum allowed. EXTENDED
3586 Syntax error in partial filter expression. EXTENDED
3587 Unknown token in partial filter expression. EXTENDED
3588 Error when evaluating the partial filter expression. EXTENDED
3589 The partial filter expression contains an unknown
function. EXTENDED
3590 Violates the rules for partial replicas. EXTENDED
3591 Log file path '|1' is invalid. EXTENDED
3592 You cannot make a password-protected database
replicable or set password protection on a
replicable database. REPLICATOR
3593 Can't change a replicable database from allowing
multiple data masters to allowing only a single
data master. REPLICATOR
3594 Can't change a replicable database from allowing
only a single data master to allowing multiple
data masters. REPLICATOR
3595 The system tables in your replica are no longer
reliable and the replica should not be used. REPLICATOR
3596 * UNUSED
3597 * UNUSED
3598 * UNUSED
3599 * UNUSED
3600 Aggregation expressions cannot use GUIDs. QUERY
3601 * UNUSED
3602 * UNUSED
3603 * UNUSED
3604 * UNUSED
3605 Synchronizing a replicated database with a
non-replicated database is not allowed. The '|'
database is not replicable. EXTENDED
3606 * REPLICATOR
3607 The replication property you are attempting to
delete is read-only and cannot be removed. REPLICATOR
3608 Record length too long for an indexed Paradox
table. ISAM
3609 No unique index found for referenced field of
primary table. REF INTEGRITY
3610 Same table ('|') referenced as both source and
destination in make table query. EXTENDED
3611 Can't execute data definition statements on
attached data sources. QUERY
3612 Multi-level GROUP BY clause not allowed in a
subquery. QUERY
3613 Can't create a relationship on attached (or linked)
SQL tables. MISC
3614 GUID not allowed in Find method criteria
expression. MISC
3615 Type mismatch in JOIN Expression. QUERY
3616 Updating data in an attached (or linked) table not
supported by this ISAM. INST ISAM
3617 Deleting data in an attached (or linked) table not
supported by this ISAM. INST ISAM
3618 Exceptions table could not be created on
import/export. MISC
3619 Records could not be added to Exceptions table. MISC
3620 The connection to Excel for viewing your attached
worksheet has been lost. Possible cause was that
Excel has terminated. EXCEL
3621 Can't change password on a shared open database. ISAM
3622 You must use the dbSeeChanges option with
OpenDatabase when accessing a SQLServer table
which has an IDENTITY column.QUERY
3623 Cannot access the FoxPro 3.0 bound DBF file '|'. EXTENDED
3624 Couldn't read; currently locked by another
session on this machine. ISAM
3625 The text file specification '|' does not exist.
You can't import, export, or attach using the
specification. EXTENDED
************************* Ole Container Control Messages **********************
31001 Out of memory
31003 Can't open Clipboard
31004 No object
31006 Unable to close object
31007 Can't paste
31008 Invalid property value
31009 Can't copy
31017 Invalid format
31018 Class is not set
31019 Source Document is not set
31021 Invalid Action
31022 Unable to initialize OLE
31023 Invalid or unknown Class
31024 Unable to create link
31026 Source name is too long
31027 Unable to activate object
31028 Object not running
31029 Dialog already in use
31031 Invalid source for link
31032 Unable to create embedded object
31033 Unable to fetch Link source name
31034 Invalid Verb index
31035 Incorrect Clipboard format
31036 Error saving to file
31037 Error loading from file
31038 This control requires VB version 3.0 or greater
31039 Unable to access source document
[Command Dialog]
Code Message
20476 The FileName buffer is too small to store the seleted file name(s)
20477 Invalid filename
20478 An attempt to subclass a ListBox failed due to insufficient memory
24574 No fonts exist
28660 The [devices] section of the file WIN.INI did not contain an entry for the requested printer
28661 The PrintDlg function failed when it attempted to create an information context
28662 The data in the DEVMODE and DEVNAMES data structures describes two different printers
28663 A default printer does not exist
28664 No printer device drivers were found
28665 The PrintDlg function failed during initialization
28666 The printer device driver failed to initialize a DEVMODE data structure
28667 The PrintDlg function failed to load the specified printer's device driver
28668 The PD_RETURNDEFAULT flag was set in the Flags member of the PRINTDLG data structure but either the hDevMode or hDevNames field were nonzero
28669 The common dialog function failed to parse the strings in the [devices] section of the file WIN.INI
28670 Load of required resources failed
28671 The PD_RETURNDEFAULT flag was set in the Flags member of the PRINTDLG data structure, but either the hDevMode or hDevNames field were nonzero
31001 Out of memory
32751 Help call fail. Check Help properties.
32752 Low on memory! Can't bring up the dialog!
32753 Couldn't determine procedure address(es). \nSelect a different DLL.
32754 DLL selected couldn't be loaded
32755 Cancel was selected
32756 The ENABLEHOOK flag was set in the Flags member of a common dialog data structure but the application failed to provide a pointer to a corresponding hook function
32757 The common dialog function was unable to lock the memory associated with a handle
32758 The common dialog function was unable to allocate memory for internal data structures
32759 The common dialog function failed to lock a specified resource
32760 The common dialog function failed to load a specified resource
32761 The common dialog function failed to find a specified resource
32762 The common dialog function failed to load a specified string
32763 The ENABLETEMPLATE flag was set in the Flags member of a common dialog data structure but the application failed to provide a corresponding instance handle
32764 The ENABLETEMPLATE flag was set in the Flags member of a common dialog data structure but the application failed to provide a corresponding template
32765 The common dialog function failed during initialization
32766 The lStructSize member of the corresponding common dialog data structure is invalid
[Grid]
30000 Can not do a RemoveItem on a fixed row
30001 Cannot use AddItem on a fixed row
30002 Grid does not contain that row
30004 Invalid Column number for alignment
30005 Invalid Alignment value
30006 Unable to Allocate Memory For Grid
30008 Not a valid Picture type
30009 Invalid Row Value
30010 Invalid Column Value
30011 Unable to register the memory manager
30013 Invalid Row Height Value
30014 Invalid Column Width Value
30015 Can not remove last non-fixed row
30016 FixedRows must be one less than Rows value
30017 FixedColumns must be one less than columns value
[Internet control]
35750 Unable to open internet handle.
35751 "Unable to open URL"
35752 "URL is malformed"
35753 "Protocol not supported for this method"
35754 "Unable to connect to remote host"
35755 "No remote computer is specified"
35756 "Unable to complete request"
35757 "You must execute an operation before retrieving data"
35758 "Unable to retrieve data"
icFtpCommandFailed 35759 "FTP command failed"
icUnsupportedType 35760 "Cannot coerce type"
icTimeOut 35761 "Request timed out"
icUnsupportedCommand 35762 "Not a valid or supported command"
icInvalidOperation 35763 "Invalid operation argument"
icExecuting 35764 "Still executing last request"
icInvalidForFtp 35765 "This call is not valid for an FTP connection"
icOutOfHandles 35767 "Out of handles"
icinetTimeout 35768 "Timeout"
icInetTimeout 35768 Timeout
icExtendedError 35769 Extended error.
icIntervalError 35770 Internal error.
icInvalidURL 35771 Invalid URL.
icUnrecognizedScheme 35772 Unrecognized scheme
icNameNotResolved 35773 Name not resolved.
icProtocolNotFound 35774 Protocol not found.
icInvalidOption 35775 Invalid option.
icBadOptionLength 35776 Bad option length.
35777 Option not settable
icShutDown 35778 Shutdown
icIncorrectUserName 35779 Incorrect User name.
icLoginFailure 35781 Login failure.
icInetIvalidOpertation 35782 Invalid operaion.
icOperationCancelled 35783 Operation cancelled.
icIncorrectHandleType 35784 incorrect handle type.
icIncorrectHandleState 35785 incorrect handle state.
icNotProxyRequest 35786 Not a proxy.
icRegistryValueNotFound 35787 Registry value not found.
icbadRegistryParameter 35788 bad registry parameter.
icNoDirectAccess 35789 No direct access.
icIncorrect Password 35779 Incorrect password.
icNoContext 35790 No context.
icNoCallback 35791 No callback.
icRequestPending 35792 Request pending.
icIncorrectFormat 35793 Incorrect format.
icItemNotFound 35794 Item not found.
icCannotConnect 35795 Cannot connect.
icConnectionAborted 35796 Connection aborted.
icConnectionReset 35797 Connection reset.
icForceEntry 35798 Force entry.
icInvalidProxyRequest 35799 Invalid proxy reques
icWouldBlock 35800 Would block.
icHandleExists 35802 Handle exists.
icSecCertDateInvalid 35803 Security certificate date invalid.
icSecCertCnInvalid 35804 Security certificate number invalid.
Trappable Errors for the Windows Common Controls
See Also Example
The following tables list the trappable errors and constants for the Windows Common Controls in the ComCtl32.OCX and ComCt232.OCX files.
The following are the errors for the Windows Common Controls located in the ComCtl32.OCX file. Controls included in this file are: TabStrip, Toolbar
, StatusBar, ProgressBar, TreeView, ListView, ImageList, and Slider.
Constant Value Description
ccInvalidProcedureCAll 5 Invalid procedure call
ccOutofMemory 7 Out of memory
The operation could not allocate enough memory.
ccTypeMismatch 13 Type Mismatch
One of the arguments could not be converted to the correct data type.
ccInvalidPropertyValue 380 Invalid property value
A value has been assigned to a property, that is outside its permissible range.
ccSetNotSupportedAtRuntime 382 Property cannot be set at run time
ccSetNotSupported 383 Property is read-only
ccSetNotPermitted 387 Property can't be set on this control
ccGetNotSupported 394 Property is write-only
ccInvalidClipboardFormat 460 Invalid clipboard format
ccInvalidObjectUse 425 Invalid object use
ccDataObjectLocked 672 DataObject formats list may not be cleared or expanded outside of the OLEStartDrag event
ccExpectedAnArgument 673 Expected at least one argument
ccRecursiveOleDrag 674 Illegal recursive invocation of OLE drag and drop
ccIndexOutOfBounds 35600 Index out of bounds
ccElemNotFound 35601 Element not found
ccNonUniqueKey 35602 Key is not unique in collection
ccInvalidKey 35603 Invalid key
ccCol1MustBeLeftAligned 35604 When the ListView control's View property is set to 3 (Report), the left-most column (column 1) can only be left aligned. Any attempt to set the alignment to another value will result in this error.
ccElemNotPartOfCollection 35605 This item's control has been deleted
ccCollectionChangedDuringEnum 35606 Control's collection has been modified
ccMissingRequiredArg 35607 Required argument is missing
ccBadObjectReference 35610 Invalid object
ccReadOnlyIfHasImages 35611 Property is read-only if image list contains images
ccImageListMustBeInitialized 35613 ImageList must be initialized before it can be used
ccWouldIntroduceCycle 35614 This would introduce a cycle
ccNotSameSize 35615 All images in list must be same size
ccMaxPanelsExceeded 35616 Maximum Panels Exceeded
ccImageListLocked 35617 ImageList cannot be modified while another control is bound to it
ccMaxButtonsExceeded 35619 Maximum Buttons Exceeded
ccCircularReference 35700 Circular object referencing is not allowed
The following are the errors for the Windows Common Controls located in the ComCt232.OCX file. Controls included in this file are: UpDown and Animation.
Constant Value Description
cc2InvalidProcedureCall 5 Invalid procedure call
cc2BadFileNameOrNumber 52 Bad file name or number
cc2FileNotFound 53 File not found
cc2InvalidPropertyValue 380 Invalid property value
cc2SetNotSupportedAtRuntime 382 Property cannot be set at runtime
cc2SetNotSupported 383 Property is read-only
cc2InvalidObjectUse 425 Invalid object use
cc2InvalidClipboardFormat 460 Invalid clipboard format
cc2DataObjectLocked 672 DataObject formats list may not be cleared or expanded outside of the OLEStartDrag event
cc2ExpectedAnArgument 673 Expected at least one argument.
cc2InconsistentObject 35750 Internal state of the control has become corrupted
cc2ErrorDuringSet 35751 Unable to set property
cc2ErrorOpeningVideo 35752 Unable to open AVI file
cc2ErrorPlayingVideo 35753 Unable to play AVI file
cc2NoValidBuddyCtl 35754 BuddyControl property must be set first
cc2VideoNotOpen 35755 Must open AVI file first
cc2AutoBuddyNotSet 35756 AutoBuddy not set, no potential buddy controls found
cc2ErrorStoppingVideo 35757 Error trying to stop playing video file
cc2ErrorClosingVideo 35758 Error closing open video file
cc2CantStopAutoPlay 35759 Stop method does not effect AutoPlay property
cc2BuddyNotASibling 35760 BuddyControl must be a separate control within the same container
cc2NoUpDownAsBuddy 35761 An UpDown control cannot be buddied with another UpDown control.
<end node> 5P9i0s8y19Z
<node>File handling
2
<end node> 5P9i0s8y19Z
<node>random acess
3
[Random access tips]
1. PLACE a if eof(#) below a get#,i,var to stop adding blanks to a list.
Type named
last As String * 20
first As String * 20
time As Integer
code As String * 5
End Type
dim names as named
Set up as the form:
Open a$ For Random As #1 Len = Len(names)
numrec = LOF(1) / Len(names);returns the number of records
<end node> 5P9i0s8y19Z
<node>add Record
4
[ add record]
If EDITMODE Then ' Got here with EDIT Button
RecordNumber = ListOfNames.ItemData(ListOfNames.ListIndex)
ListOfNames.RemoveItem ListOfNames.ListIndex
Else ' Got here with ADD Button
TotalNames = TotalNames + 1
RecordNumber = TotalNames
End If
' Make key, add it to List and set its ItemData Property
Call UpdateIndex(RecordNumber)
' Make record and save it to file
Call MakeRecord(Entry)
Put #DATAFILENUM, RecordNumber, Entry
' Finally select newly added row in List
ListOfNames.ListIndex = ListOfNames.NewIndex
Call ShowButtons ' out of EDIT/ADD mode,
<end node> 5P9i0s8y19Z
<node>find record
4
[ Find record using index]
RecNum = ListOfNames.ItemData(ListOfNames.ListIndex)
Get #DATAFILENUM, RecNum, Entry
<end node> 5P9i0s8y19Z
<node>index
4
Index random file]
Sub UpdateIndex (RecNum As Integer)
EntryKey$ = LName.Text + ", " + FName.Text
ListOfNames.AddItem EntryKey$
ListOfNames.ItemData(ListOfNames.NewIndex) = RecNum
[ Delete linked]
If ListOfNames.ListIndex < 0 Then
Beep
Exit Sub
End If
Index = ListOfNames.ListIndex ' Remember index
RecNum = ListOfNames.ItemData(Index)
Call MakeRecord(Entry)
Entry.Deleted = True
Put #DATAFILENUM, RecNum, Entry
ListOfNames.RemoveItem ListOfNames.ListIndex
Rem now display previous (or next) item in the list
Index = Index – 1
If Index < 0 Then Index = Index + 1
If Index < ListOfNames.ListCount Then
ListOfNames.ListIndex = Index
End If
<end node> 5P9i0s8y19Z
<node>fonts
2
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long
Private Declare Function SetMapMode Lib "gdi32" (ByVal hdc As Long, ByVal nMapMode As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Const MM_TEXT = 1
Private Type TEXTMETRIC
tmHeight As Integer
tmAscent As Integer
tmDescent As Integer
tmInternalLeading As Integer
tmExternalLeading As Integer
tmAveCharWidth As Integer
tmMaxCharWidth As Integer
tmWeight As Integer
tmItalic As String * 1
tmUnderlined As String * 1
tmStruckOut As String * 1
tmFirstChar As String * 1
tmLastChar As String * 1
tmDefaultChar As String * 1
tmBreakChar As String * 1
tmPitchAndFamily As String * 1
tmCharSet As String * 1
tmOverhang As Integer
tmDigitizedAspectX As Integer
tmDigitizedAspectY As Integer
End Type
'******************************************
' Returns true if the system is using small fonts,
' false if using large fonts
'
' Source: the MS knowlege base article Q152136.
'
Public Function SmallFonts() As Boolean
Dim hdc As Long
Dim hwnd As Long
Dim PrevMapMode As Long
Dim tm As TEXTMETRIC
' Set the default return value to small fonts
SmallFonts = True
' Get the handle of the desktop window
hwnd = GetDesktopWindow()
' Get the device context for the desktop
hdc = GetWindowDC(hwnd)
If hdc Then
' Set the mapping mode to pixels
PrevMapMode = SetMapMode(hdc, MM_TEXT)
' Get the size of the system font
GetTextMetrics hdc, tm
' Set the mapping mode back to what it was
PrevMapMode = SetMapMode(hdc, PrevMapMode)
' Release the device context
ReleaseDC hwnd, hdc
' If the system font is more than 16 pixels high,
' then large fonts are being used
If tm.tmHeight > 16 Then SmallFonts = False
End If
End Function
<end node> 5P9i0s8y19Z
<node>Form
2
<end node> 5P9i0s8y19Z
<node>Center
3
[ Center the form:]
form1.Left = (screen.Width – form1.Width) / 2
form1.Top = (screen.Height – form1.Height) / 2
<end node> 5P9i0s8y19Z
<node>Max Size
3
Form
These value represent the maximum dimensions of a form on a vga
screen.
Height = 7210
Left = 000
Top = 0
Width = 9600
800 x 600
width=12000
height=9000
<end node> 5P9i0s8y19Z
<node>Scroll on
3
Scroll on a form]
Example page 115 august 1995 visual basic magazine.
.
Declare Function scrollwindowex% lib "user" (Byval hwnd%, byval dx%, byval dy%, lpcscroll as any, lprcclip as any, byval hrgnupdate%, lprcupdate as any, byval fuscroll%)
Declare sub UpdateWindow lib "user" (byval hwnd as integer)
Global constant sw_erase=&h4
Global constant sw_invalidate=&h2
Sub form_load
'set to pixels
scalemode=3
end sub
sub scrollprint(stext as string)
dim i as integer, cy as integer
cy=textheight(stext)
do until(currentY +cy) < scaleheight
i=scrollwindowex(hwnd,0, -cy,byval 0&,byval 0&,0,byval 0&,sw_erase or sw_invalidate)
call updatewindow(hwnd)
currenty=currenty-cy
loop
print stext
end sub
<end node> 5P9i0s8y19Z
<node>FORMAT
2
This example shows various uses of the Format function to format values using both named formats and user-defined formats. For the date separator (/), time separator (:), and AM/ PM literal, the actual formatted output displayed by your system depends on the locale settings on which the code is running. When times and dates are displayed in the development environment, the short time format and short date format of the code locale are used. When displayed by running code, the short time format and short date format of the system locale are used, which may differ from the code locale. For this example, English/U.S. is assumed.
MyTime and MyDate are displayed in the development environment using current system short time setting and short date setting.
Dim MyTime, MyDate, MyStr
MyTime = #17:04:23#
MyDate = #January 27, 1993#
' Returns current system time in the system-defined long time format.
MyStr = Format(Time, "Long Time")
' Returns current system date in the system-defined long date format.
MyStr = Format(Date, "Long Date")
MyStr = Format(MyTime, "h:m:s") ' Returns "17:4:23".
MyStr = Format(MyTime, "hh:mm:ss AMPM") ' Returns "05:04:23 PM".
can use "mm/dd/yy" to get number date
MyStr = Format(MyDate, "dddd, mmm d yyyy") ' Returns "Wednesday,
' Jan 27 1993".
' If format is not supplied, a string is returned.
MyStr = Format(23) ' Returns "23".
' User-defined formats.
MyStr = Format(5459.4, "##,##0.00") ' Returns "5,459.40".
MyStr = Format(334.9, "###0.00") ' Returns "334.90".
MyStr = Format(5, "0.00%") ' Returns "500.00%".
MyStr = Format("HELLO", "<") ' Returns "hello".
MyStr = Format("This is it", ">") ' Returns "THIS IS IT".
<end node> 5P9i0s8y19Z
<node>keyboard
2
<end node> 5P9i0s8y19Z
<node>codes
3
[Key codes]
The following are for the keyup and key down event:
Cap Locks=20 Num Lock=144
shift= 16 ctrl=17 alt=18
del= 46 end=35 home=36
ins=45 pgdn=34 pgup=33
f1=112 – f12=123
arrow– left=37, up=38, right=39, down=40
.
For the keypress event:
Chr$(8)=backspace
Chr$(34)="
asc("0")=48
asc("9")=57
<end node> 5P9i0s8y19Z
<node>sendkeys
3
Key strokes-send
Sendkeys "abc",true
For Special keys "{tab}{f1}{shift}. The true send keystrokes immediately.
The keys go to the active application.
To specify characters that aren't displayed when you press a key (such as Enter or Tab) and keys that represent actions rather than characters, use the codes shown below:
SendKeys "=", True ' Get grand total.
SendKeys "%{F4}", True ' Send ALT+F4 to close Calculator.
Key Code Key Code
Backspace {BACKSPACE} or {BS} or {BKSP} Break {BREAK}
Caps Lock {CAPSLOCK} Clear {CLEAR}
Del {DELETE} or {DEL} Down Arrow {DOWN}
End {END} Enter {ENTER} or ~
Esc {ESCAPE} or {ESC} Help {HELP}
Home {HOME} Ins {INSERT}
Left Arrow {LEFT} Num Lock {NUMLOCK}
Page Down {PGDN} Page Up {PGUP}
Print Screen {PRTSC} Right Arrow {RIGHT}
Scroll Lock {SCROLLLOCK} Tab {TAB}
Up Arrow {UP} F1 {F1}
F2 {F2} F3 {F3}
F4 {F4} F5 {F5}
F6 {F6} F7 {F7}
F8 {F8} F9 {F9}
F10 {F10} F11 {F11}
F12 {F12} F13 {F13}
F14 {F14} F15 {F15}
F16 {F16}
To specify keys combined with any combination of Shift, Ctrl, and Alt keys, precede the regular key code with one or more of the following codes:
Key Code
Shift +
Control ^
Alt %
To specify that Shift, Ctrl, and/or Alt should be held down while several other keys are pressed, enclose the keys' code in parentheses. For example, to have the Shift key held down while E and C are pressed, use "+(EC)". To have Shift held down while E is pressed, followed by C being pressed without Shift, use "+EC".
To specify repeating keys, use the form {key number}; you must put a space between key and number. For example, {LEFT 42} means press the Left Arrow key 42 times; {h 10} means press h 10 times.
Note SendKeys can't send keystrokes to an application that is not designed to run in Microsoft Windows. Sendkeys also can't send the Print Screen (PRTSC) key to any application.
<end node> 5P9i0s8y19Z
<node>List boxes
2
<end node> 5P9i0s8y19Z
<node>add to
3
Add]
The itemdata poperty takes on the form:
list.AddItem (f2.des)
list.ItemData(list.NewIndex) = number
Add the entry to list first:
To reassign use .listindex instead of .newindex
.
<end node> 5P9i0s8y19Z
<node>horizontal scroll
3
[Horizontal scroll
Declare Function SendMessage Lib "user" (ByVal hWnd As Integer, ByVal wMsg As Integer,
ByVal wParam As Integer, iparam As Any) As Long
Global Const WM_USEr = 1024
Global Const LB_SETHORIZONTALEXTENT = (WM_USEr + 21)
form_load
Dim c As Integer, nRet As Long, nNewWidth As Integer
nNewWidth = list2.Width + 100
nRet = SendMessage(list2.hWnd, LB_SETHORIZONTALEXTENT, nNewWidth, ByVal 0&)
<end node> 5P9i0s8y19Z
<node>linking two lists
3
Linking list Boxes]
Using two list boxes. The first holds a description.
The second list holds the data and call the sub to accomplish a task.
LIST BOX 1:
Sub lides_Click ()
lifor.ListIndex = lides.ListIndex
End Sub
Sub lides_DblClick ()
If lifor.ListIndex = lides.ListIndex And nli <> 5 Then
Call lifor_DblClick
Else
lifor.ListIndex = lides.ListIndex
End If
nli = 0
End Sub
[Sub lides_KeyPress (Keyascii As Integer)
If Keyascii = 13 Then Call lifor_DblClick
End Sub
Sub lides_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Call lides_DblClick
End Sub
.
LIST BOX 2
Sub lifor_click ()
lides.ListIndex = lifor.ListIndex
End Sub
Sub lifor_DblClick ()
Static v1 As String
nli = 5
v = lifor.List(lifor.ListIndex)
If v1 <> v Then For i = 0 To 7: Txvar(i) = "": lavar(i) = "": Next
v1 = v
Call formulas
End Sub
Sub lifor_KeyPress (Keyascii As Integer)
If Keyascii = 13 Then Call lifor_DblClick
End Sub
Sub lifor_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Call lifor_DblClick
End Sub
[ Remove]
Combo1.RemoveItem Combo1.ListIndex
<end node> 5P9i0s8y19Z
<node>message boxes
2
<end node> 5P9i0s8y19Z
<node>general
3
Message box]
m%=msgbox("message",type+icon,"title")
& chr(10) & BREAKS THE MESSAGE TO NEW LINE
return values:
m% type icons
ok= 1 ok= 0 stop= 16
cancel= 2 okcancel= 1 question= 32
abort= 3 abortretryign= 2 exclamation= 48
retry= 4 yesnocancel= 3 information= 64
ignore= 5 yesno= 4
yes= 6 retrycancel= 6
no= 7
<end node> 5P9i0s8y19Z
<node>input
3
[Input Box]
fil = InputBox("File name", "New File", "N.TXX")
var = InputBox(prompt, title, default for box)
<end node> 5P9i0s8y19Z
<node>Mouse
2
<end node> 5P9i0s8y19Z
<node>pointer
3
Mouse Pointer]
{[form.][control.]|Screen.}MousePointer[ = setting ]
.
0 (Default) Shape determined by the control
1 Arrow
2 Cross (cross-hair pointer)
3 I-Beam
4 Icon (small square within a square)
5 Size (four-pointed arrow pointing north, south, east, west)
6 Size NE SW (double arrow pointing northeast and southwest)
7 Size N S (double arrow pointing north and south)
8 Size NW SE (double arrow pointing northwest and southeast)
9 Size W E (double arrow pointing west and east)
10 Up Arrow
11 Hourglass (wait)
12 No Drop
<end node> 5P9i0s8y19Z
<node>numlocks
2
Option Explicit
Private Declare Function GetKeyState Lib _
"user32" (ByVal nVirtKey As Long) As Integer
Public Function NumLockOn() As Boolean
Dim iKeyState As Integer
iKeyState = GetKeyState(vbKeyNumlock)
NumLockOn = (iKeyState = 1 Or iKeyState = -127)
End Function
************************************************************
Option Explicit
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VK_NUMLOCK = &H90
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
' API declarations:
Private Declare Function GetVersionEx Lib "kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetKeyboardState Lib "user32" _
(pbKeyState As Byte) As Long
Private Declare Function SetKeyboardState Lib "user32" _
(lppbKeyState As Byte) As Long
Public Sub ToggleNumLock(TurnOn As Boolean)
'To turn numlock on, set turnon to true
'To turn numlock off, set turnon to false
Dim bytKeys(255) As Byte
Dim bnumLockOn As Boolean
'Get status of the 256 virtual keys
GetKeyboardState bytKeys(0)
bnumLockOn = bytKeys(VK_NUMLOCK)
Dim typOS As OSVERSIONINFO
If bnumLockOn <> TurnOn Then 'if current state <>
'requested stae
If typOS.dwPlatformId = _
VER_PLATFORM_WIN32_WINDOWS Then '=== Win95/98
bytKeys(VK_NUMLOCK) = 1
SetKeyboardState bytKeys(0)
Else '=== WinNT/2000
'Simulate Key Press
keybd_event VK_NUMLOCK, &H45, _
KEYEVENTF_EXTENDEDKEY Or 0, 0
'Simulate Key Release
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY _
Or KEYEVENTF_KEYUP, 0
End If
End If
End Sub
*********************
Dim o As OSVERSIONINFO
Dim NumLockState As Boolean
Dim ScrollLockState As Boolean
Dim CapsLockState As Boolean
o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
Dim keys(0 To 255) As Byte
GetKeyboardState keys(0)
' CapsLock handling:
CapsLockState = keys(VK_CAPITAL)
If CapsLockState <> True Then 'Turn capslock on
If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then '=== Win95/98
keys(VK_CAPITAL) = 1
SetKeyboardState keys(0)
ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then '=== WinNT
'Simulate Key Press
keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
'Simulate Key Release
keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY _
Or KEYEVENTF_KEYUP, 0
End If
End If
<end node> 5P9i0s8y19Z
<node>printer
2
'MS Windows API Function Prototypes
private Declare Function GetProfileString Lib "kernel32" Alias _
"GetProfileStringA" (byval lpAppName as string, _
byval lpKeyName as string, byval lpDefault as string, _
byval lpReturnedString as string, _
byval nSize as Long) as Long
'—————————————————————
' Retreive the vb object "printer" corresponding to the window's
' default printer.
'—————————————————————
public Function GetDefaultPrinter() as Printer
Dim strBuffer as string * 254
Dim iRetValue as Long
Dim strDefaultPrinterInfo as string
Dim tblDefaultPrinterInfo() as string
Dim objPrinter as Printer
' Retreive current default printer information
iRetValue = GetProfileString("windows", "device", ",,,", strBuffer, 254)
strDefaultPrinterInfo = Left(strBuffer, InStr(strBuffer, Chr(0)) – 1)
tblDefaultPrinterInfo = Split(strDefaultPrinterInfo, ",")
for Each objPrinter In Printers
If objPrinter.DeviceName = tblDefaultPrinterInfo(0) then
' Default printer found !
Exit for
End If
next
' If not found, return nothing
If objPrinter.DeviceName <> tblDefaultPrinterInfo(0) then
set objPrinter = nothing
End If
set GetDefaultPrinter = objPrinter
End Function
Now to test the routine, place the following code into a Form_Load routine :
private Sub Form_Load()
Dim objPrinter as Printer
set objPrinter = GetDefaultPrinter()
MsgBox "Default printer is: " + objPrinter.DeviceName
MsgBox "Driver name is: " + objPrinter.DriverName
MsgBox "Port is: " + objPrinter.Port
set objPrinter = nothing
End
End Sub
<end node> 5P9i0s8y19Z
<node>Printer
3
[Close print]
printer.newpage
printer.enddoc
[Font]
{[form.][control.]|Printer.}FontBold[ = boolean ]
{[form.][control.]|Printer.}FontItalic[ = boolean ]
{[form.][control.]|Printer.}FontStrikethru[ = boolean ]
{[form.][picturebox.]|Printer.}FontTransparent[ = boolean ]
{[form.][control.]|Printer.}FontUnderline[ = boolean ]
.
[form.][control.]|Printer.}FontSize[ = points ]
[Position]
Description
Determine the horizontal (CurrentX) and vertical (CurrentY) coordinates
for the next printing or drawing method. Not available at design time.
Usage
{[form.][picturebox.]|Printer.}CurrentX[ = x ]
{[form.][picturebox.]|Printer.}CurrentY[ = y ]
Remarks
Coordinates are measured from the upper-left corner of an object.
CurrentX is 0 at an object's left edge and CurrentY is 0 at its top
edge. Coordinates are expressed in twips, or the current scale defined
by the ScaleHeight, ScaleWidth, ScaleLeft, ScaleTop, and ScaleMode.
properties.
[Print example]
Sub mnprinter_Click ()
On Error Resume Next
printer.FontSize = 12
printer.FontName = "Arial"
For i = 0 To limap.ListCount – 1
Select Case limap.ItemData(i)
Case Is = 0
printer.CurrentX = 2000
printer.Print limap.List(i)
Case Is = 1
printer.CurrentX = 2000
printer.FontBold = True
printer.FontSize = 18
printer.Print limap.List(i)
printer.FontBold = False
printer.FontSize = 12
Case Is = 2
printer.CurrentX = 2000
printer.FontBold = True
printer.Print limap.List(i)
printer.FontBold = False
End Select
Next
printer.NewPage
printer.EndDoc
<end node> 5P9i0s8y19Z
<node>registry
3
DOCUMENT:Q143274 20-MAY-1996 [vbwin]
TITLE :Retrieving Printer Name from Windows 95 Registry in VB
PRODUCT :Microsoft Visual Basic for Windows
PROD/VER:4.00
OPER/SYS:WINDOWS
KEYWORDS:kbprg
————————————————————————
The information in this article applies to:
– Standard, Professional, and Enterprise Editions of Microsoft Visual
Basic, 32-bit edition, for Windows, version 4.0
————————————————————————
SUMMARY
=======
The Registry is used by Windows 95 to determine what application programs
and hardware items are installed in the computer system. This article
explains how to retrieve the name of the default printer from the Registry
from within a Visual Basic application program.
MORE INFORMATION
================
MANIPULATING THE REGISTRY IN VISUAL BASIC
=========================================
The Windows 95 Registry is a database of information containing
configuration details about the hardware and software installed in your
computer system. Under Windows 3.1, this information is maintained through
initialization (INI) files.
The Registry is comprised of keys. Each key may contain a specific value or
other subkeys, which in turn may contain values or other subkeys. You can
examine or modify the contents of the registration database by using the
Win32 Registry API functions in a Visual Basic program or by using the
Registry Editor (REGEDIT).
The demonstration program below shows how to use the Win32 Registry API
functions to retrieve the default printer's name from the Registry.
1. The first step to retrieve the printer name is to call the RegOpenKeyEx
function. This function opens the specified key in the registration
database. In our case, we want to open the key that is associated with
the printer. This key is stored in the Registry as:
System
Current Control Set
Control
Print
Printers
Default
All of the above items are keys and subkeys. We are interested in the
Printers subkey.
We also need to tell the RegOpenKeyEx function that we want to work with
the Default subkey. After calling this function, a value is returned
that is set to zero if the function was successful.
2. The next step is to retrieve the actual value stored for the key we are
interrogating. Because we want to retrieve the name that is assigned to
the default printer, we want to call the RegQueryValueEx function. We
must tell this function that we want to retrieve the value that was
given to the Default subkey.
3. The last step is mandatory. You must call the RegCloseKey function to
release the handle of the key you have been accessing in the
Registration database. This terminates access to the registration
database and frees the handle for future use by the computer system.
How to Create the Demonstration Program
—————————————
The demonstration program below shows how to retrieve the name of the
default printer from the Windows 95 Registry.
1. Create a new project in Visual Basic. Form1 is created by default.
2. Add the following constant and Declare statements to the General
Declarations section of Form1.
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias _
"RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal dwReserved As Long, ByVal samDesired As Long, phkResult _
As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName$, ByVal _
lpdwReserved As Long, lpdwType As Long, lpData As Any, lpcbData As _
Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As _
Long) As Long
Const HKEY_CURRENT_CONFIG As Long = &H80000005
3. Add a Text Box control to Form1.
4. Add a Command Button control to Form1.
5. Add the following code to the Click event for Command1.
Private Sub Command1_Click()
Dim PName As String
PName = GetCurrPrinter()
Text1.Text = PName
End Sub
6. Create a new procedure called GetCurrPrinter. Add the following code to
this procedure.
Function GetCurrPrinter() As String
GetCurrPrinter = RegGetString$(HKEY_CURRENT_CONFIG, _
"System\CurrentControlSet\Control\Print\Printers", "Default")
End Function
7. Create a new procedure called RegGetString. Add the following code to
this procedure.
Function RegGetString$(hInKey As Long, ByVal subkey$, ByVal valname$)
Dim RetVal$, hSubKey As Long, dwType As Long, SZ As Long
Dim R As Long
RetVal$ = ""
Const KEY_ALL_ACCESS As Long = &HF0063
Const ERROR_SUCCESS As Long = 0
Const REG_SZ As Long = 1
R = RegOpenKeyEx(hInKey, subkey$, 0, KEY_ALL_ACCESS, hSubKey)
If R <> ERROR_SUCCESS Then GoTo Quit_Now
SZ = 256: v$ = String$(SZ, 0)
R = RegQueryValueEx(hSubKey, valname$, 0, dwType, ByVal v$, SZ)
If R = ERROR_SUCCESS And dwType = REG_SZ Then
RetVal$ = Left$(v$, SZ)
Else
RetVal$ = "–Not String–"
End If
If hInKey = 0 Then R = RegCloseKey(hSubKey)
Quit_Now:
RegGetString$ = RetVal$
End Function
Execute the demonstration program by pressing the F5 function key. When you
click the Command Button control, the name of your default printer is
displayed in the Text Box control.
ADDITIONAL REFERENCES
=====================
<end node> 5P9i0s8y19Z
<node>PrintToFile
2
<end node> 5P9i0s8y19Z
<node>Screen Resolution
2
There is a simple way to get Monitor resolutions through a WinAPI call. Declare this in a module:
Declare Function GetsystemMetrics Lib "User32" (ByVal nIndex As integer) As long
And make a call to this API in Form_Load or Form_Resize event:
Sub Form_Resize()
dim xRes as integer
dim yRes as integer
xRes = GetsystemMetrics(0)
yRes = GetsystemMetrics(1)
If xRes < 1024 and yRes < 768 Then
' Write your control resize
' and reposition code here
Else
Exit Sub
End If
<end node> 5P9i0s8y19Z
<node>Sort
2
Public Sub Shaker(Item() As Variant)
Dim Exchange As Boolean
Dim Temp As Variant
Dim x As Integer
Do
Exchange = False
For x = (UBound(Item)) To (LBound(Item) + 1) Step -1
If Item(x – 1) > Item(x) Then
Temp = Item(x – 1)
Item(x – 1) = Item(x)
Item(x) = Temp
Exchange = True
End If
Next x
For x = (LBound(Item) + 1) To (UBound(Item))
If Item(x – 1) > Item(x) Then
Temp = Item(x – 1)
Item(x – 1) = Item(x)
Item(x) = Temp
Exchange = True
End If
Next x
Loop While Exchange
End Sub
<end node> 5P9i0s8y19Z
<node>Strings
2
[Lower case]
d=Lcase()
[Upper case]
d=Ucase()
<end node> 5P9i0s8y19Z
<node>To Numbers
3
[String to Number]
Syntax
CBool(expression)
CByte(expression)
CCur(expression)
CDate(expression)
CDbl(expression)
CDec(expression)
CInt(expression)
CLng(expression)
CSng(expression)
CVar(expression)
CStr(expression)
The required expression argument is any string expression or numeric expression.
Return Types
The function name determines the return type as shown in the following:
Function Return Type Range for expression argument
CBool Boolean Any valid string or numeric expression.
CByte Byte 0 to 255.
CCur Currency -922,337,203,685,477.5808 to 922,337,203,685,477.5807.
CDate Date Any valid date expression.
CDbl Double -1.79769313486232E308 to
-4.94065645841247E-324 for negative values; 4.94065645841247E-324 to 1.79769313486232E308 for positive values.
CDec Decimal +/-79,228,162,514,264,337,593,543,950,335 for zero-scaled numbers, that is, numbers with no decimal places. For numbers with 28 decimal places, the range is
+/-7.9228162514264337593543950335. The smallest possible non-zero number is 0.0000000000000000000000000001.
CInt Integer -32,768 to 32,767; fractions are rounded.
CLng Long -2,147,483,648 to 2,147,483,647; fractions are rounded.
CSng Single -3.402823E38 to -1.401298E-45 for negative values; 1.401298E-45 to 3.402823E38 for positive values.
CVar Variant Same range as Double for numerics. Same range as String for non-numerics.
CStr String Returns for CStr depend on the expression argument.
Remarks
If the expression passed to the function is outside the range of the data type being converted to, an error occurs.
In general, you can document your code using the data-type conversion functions to show that the result of some operation should be expressed as a particular data type rather than the default data type. For example, use CCur to force currency arithmetic in cases where single-precision, double-precision, or integer arithmetic normally would occur.
You should use the data-type conversion functions instead of Val to provide internationally aware conversions from one data type to another. For example, when you use CCur, different decimal separators, different thousand separators, and various currency options are properly recognized depending on the locale setting of your computer.
When the fractional part is exactly 0.5, CInt and CLng always round it to the nearest even number. For example, 0.5 rounds to 0, and 1.5 rounds to 2. CInt and CLng differ from the Fix and Int functions, which truncate, rather than round, the fractional part of a number. Also, Fix and Int always return a value of the same type as is passed in.
Use the IsDate function to determine if date can be converted to a date or time. CDate recognizes date literals and time literals as well as some numbers that fall within the range of acceptable dates. When converting a number to a date, the whole number portion is converted to a date. Any fractional part of the number is converted to a time of day, starting at midnight.
CDate recognizes date formats according to the locale setting of your system. The correct order of day, month, and year may not be determined if it is provided in a format other than one of the recognized date settings. In addition, a long date format is not recognized if it also contains the day-of-the-week string.
A CVDate function is also provided for compatibility with previous versions of Visual Basic. The syntax of the CVDate function is identical to the CDate function, however, CVDate returns a Variant whose subtype is Date instead of an actual Date type. Since there is now an intrinsic Date type, there is no further need for CVDate. The same effect can be achieved by converting an expression to a Date, and then assigning it to a Variant
. This technique is consistent with the conversion of all other intrinsic types to their equivalent Variant subtypes.
Note The CDec function does not return a discrete data type; instead, it always returns a Variant whose value has been converted to a Decimal subtype.
<end node> 5P9i0s8y19Z
<node>Type Statement
2
[Type statement]
Type named
last As String * 20
first As String * 20
time As Integer
code As String * 5
End Type
dim names as named ;set names from type statement.
<end node> 5P9i0s8y19Z
<node>replacemnent terms
1
app.path= application.startuppath
doevents – application.DoEvents()
right- Microsoft.VisualBasic.right
string() – string.format()
type endtype – structure end structure- remember to dimension as structure. Do not use the structure.
<end node> 5P9i0s8y19Z
<node>Special features
1
[Bootstrap Files]
File1=@COMCAT.DLL,$(WinSysPathSysFile),$(DLLSelfRegister),,5/31/98 12:00:00 AM,22288,4.71.1460.1
File2=@STDOLE2.TLB,$(WinSysPathSysFile),$(TLBRegister),,6/3/99 12:00:00 AM,17920,2.40.4275.1
File3=@ASYCFILT.DLL,$(WinSysPathSysFile),,,3/8/99 12:00:00 AM,147728,2.40.4275.1
File4=@OLEPRO32.DLL,$(WinSysPathSysFile),$(DLLSelfRegister),,3/8/99 12:00:00 AM,164112,5.0.4275.1
File5=@OLEAUT32.DLL,$(WinSysPathSysFile),$(DLLSelfRegister),,4/12/00 12:00:00 AM,598288,2.40.4275.1
File6=@msvbvm60.dll,$(WinSysPathSysFile),$(DLLSelfRegister),,8/21/00 12:00:00 AM,1388544,6.0.89.64
File7=@VB6STKIT.DLL,$(WinSysPathSysFile),,,6/1/99 12:00:00 AM,101888,6.0.84.50
[Setup1 Files]
File1=@License.txt,$(AppPath),,,12/28/01 2:59:12 PM,12106,0.0.0.0
File2=@SW RPG d20 – BugReport.html,$(AppPath),,,12/15/01 2:27:22 PM,3209,0.0.0.0
File3=@VB5DB.DLL,$(WinSysPath),,$(Shared),6/18/98 12:00:00 AM,89360,6.0.81.69
File4=@msjtes40.dll,$(WinSysPathSysFile),$(DLLSelfRegister),,5/4/01 12:05:02 PM,241936,4.0.4229.0
File5=@msjint40.dll,$(WinSysPathSysFile),,,5/4/01 12:05:02 PM,151824,4.0.2927.2
File6=@msjter40.dll,$(WinSysPathSysFile),,,5/4/01 12:05:02 PM,53520,4.0.2927.2
File7=@msrepl40.dll,$(WinSysPathSysFile),,,5/4/01 12:05:02 PM,553232,4.0.4331.0
File8=@msrd3x40.dll,$(WinSysPathSysFile),$(DLLSelfRegister),,5/4/01 12:05:02 PM,315664,4.0.4325.0
File9=@msrd2x40.dll,$(WinSysPathSysFile),$(DLLSelfRegister),,5/4/01 12:05:02 PM,422160,4.0.2927.2
File10=@mswdat10.dll,$(WinSysPathSysFile),,,5/4/01 12:05:02 PM,831760,4.0.3829.2
File11=@mswstr10.dll,$(WinSysPathSysFile),,,5/4/01 12:05:02 PM,614672,4.0.3829.2
File12=@expsrv.dll,$(WinSysPathSysFile),,,5/4/01 12:05:02 PM,379152,6.0.0.8540
File13=@vbajet32.dll,$(WinSysPathSysFile),,,5/4/01 12:05:02 PM,30992,6.0.1.8268
File14=@msjet40.dll,$(WinSysPathSysFile),$(DLLSelfRegister),,5/4/01 12:05:02 PM,1503504,4.0.4431.3
File15=@dao360.dll,$(MSDAOPath),$(DLLSelfRegister),$(Shared),5/4/01 12:05:02 PM,557328,3.60.3714.5
File56=@COMDLG32.OCX,$(WinSysPath),$(DLLSelfRegister),$(Shared),5/22/00 12:00:00 AM,140488,6.0.84.18
File57=@RICHED32.DLL,$(WinSysPathSysFile),,,5/7/98 12:00:00 AM,174352,4.0.993.4
File58=@RICHTX32.OCX,$(WinSysPath),$(DLLSelfRegister),$(Shared),5/22/00 12:00:00 AM,203976,6.0.88.4
File59=@MSFLXGRD.OCX,$(WinSysPath),$(DLLSelfRegister),$(Shared),5/22/00 12:00:00 AM,244416,6.0.84.18
File60=@TABCTL32.OCX,$(WinSysPath),$(DLLSelfRegister),$(Shared),12/6/00 12:00:00 AM,209608,6.0.90.43
File61=@SW RPG d20.exe,$(AppPath),,,5/4/02 1:58:22 PM,1060864,2.0.0.325
<end node> 5P9i0s8y19Z
<node>Alpha list
2
Place Vertical label [laAlpha] with the height of 6300. Use true type font of new currier. Font size 10 bolded. Create a constant to supply the alphabet with a space between each letter. Behind this have another label [laAlpha2] to mark the position of the selected letter.
<end node> 5P9i0s8y19Z
<node>time Bare
2
Create two labels. The second guages the first
Start
laTop.Width = 0: laTop.Visible = True: laBottom.Visible = True: Inc = laBottom.Width / Nrec
middle
Lcount = Lcount + 1: If Lcount > 30 Then Lcount = 0: laTop.Width = laBottom.Width * Lrec / Nrec: DoEvents
Lrec = Lrec + 1
<end node> 5P9i0s8y19Z
<node>variables
1
Dim Length As Single, FREEBYTE&, m%
Static filepath$
To keep in a subroutin use "static"
<end node> 5P9i0s8y19Z