-
May 31st, 2005, 12:23 AM
#1
Frequently Asked VB Questions
In order to make this thread as tidy as possible pls. PM me all your comments, suggestions, improvements, modifications.... And pls. post only those that are only truly "Frequently Asked Questions".... Thanks!
1. How to read/write ini?
VB Code:
Option Explicit
'declares for ini controlling
Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal
lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Sub Form_Load()
On Error Resume Next
Dim File As String, OFLen As Double, Str As String
File = "C:\temp.txt"
OFLen = FileLen(File)
'write few example sections:
WriteIniSection File, "Test1", ""
WriteIniSection File, "Test2", "Here shoud be found some text"
'write few ini strings
WriteIni File, "Test3", "Ini1", "This is ini 1"
WriteIni File, "Test1", "Ini2", "This is ini 2"
'inform we're written the data
MsgBox Format((FileLen(File) - OFLen) / 1024, "0.00") & " KB data written to " & Chr(34) & File & Chr(34)
'read the ini file
Str = Str & "Test2 section: " & vbTab & ReadIniSection(File, "Test2") & vbCrLf
Str = Str & "Test1 section: " & vbTab & ReadIniSection(File, "Test1") & vbCrLf
Str = Str & "Ini1 string: " & vbTab & ReadIni(File, "Test3", "Ini1") & vbCrLf
Str = Str & "Ini2 string: " & vbTab & ReadIni(File, "Test1", "Ini2") & vbCrLf
'show data
MsgBox Str
'end application
End
End Sub
'// INI CONTROLLING PROCEDURES
'reads ini string
Public Function ReadIni(Filename As String, Section As String, Key As String) As String
Dim RetVal As String * 255, v As Long
v = GetPrivateProfileString(Section, Key, "", RetVal, 255, Filename)
ReadIni = Left(RetVal, v - 1)
End Function
'reads ini section
Public Function ReadIniSection(Filename As String, Section As String) As String
Dim RetVal As String * 255, v As Long
v = GetPrivateProfileSection(Section, RetVal, 255, Filename)
ReadIniSection = Left(RetVal, v - 1)
End Function
'writes ini
Public Sub WriteIni(Filename As String, Section As String, Key As String, Value As String)
WritePrivateProfileString Section, Key, Value, Filename
End Sub
'writes ini section
Public Sub WriteIniSection(Filename As String, Section As String, Value As String)
WritePrivateProfileSection Section, Value, Filename
End Sub
2. How to send e-mail?
Have a look at this official FAQ article: How do I send an email using Outlook
3.How to work with registry?
VB Code:
'Savesetting
Private Sub Form_Unload(Cancel As Integer)
SaveSetting "RegCust", "Startup", "Backup", strDate
SaveSetting "RegCust", "Startup", "LastEntry",intLastEntry
End Sub
'GetSetting
Private Sub Form_Load()
Dim intLastEntry As Integer
intLastEntry = GetSetting("RegCust", "Startup", _
"LastEntry", "0")
End Sub
'DeleteSetting
Private Sub cmdDelKey_Click()
DeleteSetting "RegCust", "StartUp", "LastEntry"
End Sub
Private Sub cmdDelSection_Click()
DeleteSetting "RegCust", "StartUp"
End Sub
Private Sub cmdUnInstall_Click()
DeleteSetting "RegCust"
End Sub
4. How to open Password protected Access db?
VB Code:
'connection to secure database
Dim Cnn As ADODB.Connection
'In the place where you want to establish your connection, such
'as the Initialize event of a class module, enter the following:
Dim strConnect As String
Set Cnn = New ADODB.Connection
'Substitute your own User IDs, Password, Data Source, and System
'database in the connection string below
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Password=MyPassword;User ID=Administrator;" & _
"Data Source=C:\AccessDBs\DB1.mdb;" & _
"Persist Security Info=True;" & _
"Jet OLEDB:System database=C:\AccessDBs\system.mdw"
'if you don't need you can eliminate the last line in connection string
With Cnn
.CursorLocation = adUseClient
.Open strConnect
End With
5. How to save image in db?
Have a look at this official FAQ article: Database - How can I store images (or other files) in a database?
6. How to write/read text file?
VB Code:
'write
Option Explicit
'Set a reference to Microsoft Scripting Runtime
Private Sub Command1_Click()
Dim fs As FileSystemObject
Dim ts As TextStream
Set fs = New FileSystemObject
'To write
Set ts = fs.OpenTextFile("C:\mytestfile.txt", ForWriting, True)
ts.WriteLine "I Love"
ts.WriteLine "VB Forums"
ts.Close
'To Read
If fs.FileExists("C:\mytestfile.txt") Then
Set ts = fs.OpenTextFile("C:\mytestfile.txt")
Do While Not ts.AtEndOfStream
MsgBox ts.ReadLine
Loop
ts.Close
End If
Set ts = Nothing
Set fs = Nothing
End Sub
'read
Function FileText(ByVal filename As String) As String
Dim handle As Integer
' ensure that the file exists
If Len(Dir$(filename)) = 0 Then
Err.Raise 53 ' File not found
End If
' open in binary mode
handle = FreeFile
Open filename$ For Binary As #handle
' read the string and close the file
FileText = Space$(LOF(handle))
Get #handle, , FileText
Close #handle
End Function
7. How to fix invalid characters in sql criteria?
VB Code:
Crit="Mark's"
strSQL = "SELECT * FROM MyTable WHERE ComField ='" & CleanText(Crit) & "'"
Public Function CleanText(strIn As String) As String
On Error GoTo VBError
Dim iAcnt As Long
Dim strString As String
Dim vLimit As Long
vLimit = Len(strIn)
For iAcnt = 1 To vLimit
Select Case Asc(Mid$(strIn, iAcnt, 1))
Case 10, 13
strString = strString & Mid$(strIn, iAcnt, 1)
Case 124
strString = strString & "!"
Case 39
strString = strString & "''"
Case 34
strString = strString & """"
Case Is < 32
strString = strString & " "
Case Is > 126
strString = strString & " "
Case Else
strString = strString & Mid$(strIn, iAcnt, 1)
End Select
Next
CleanText = strString
CleanText = Trim$(CleanText)
Exit Function
VBError:
MsgBox "VBError in Sub Parse_SQL_Text : " & Err.Number & " - " & Err.Description
Resume Next
End Function
8. How to dynamically add controls?
VB Code:
Dim WithEvents vTextBox As TextBox
Set vTextBox = Controls.Add("vb.textbox", "DeeU")
Last edited by dee-u; Dec 21st, 2008 at 01:15 AM.
-
May 31st, 2005, 12:34 AM
#2
Re: Frequently Asked Questions
9. How to terminate a process?
VB Code:
Option Explicit
'on win2k you need the following:
Private Const PROCESS_TERMINATE = &H1
'On nt 9X the following could be enough:
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
'in any case, let us use both...
Private Const MAX_PATH As Integer = 260
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32moduleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Private Declare Function CreateToolHelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Function KillApp(myName As String) As Boolean
Dim uProcess As PROCESSENTRY32
Dim rProcessFound As Long
Dim hSnapShot As Long
Dim szExename As String
Dim exitCode As Long
Dim myProcess As Long
Dim iFound As Integer
On Error GoTo ErrHandler
Const TH32CS_SNAPPROCESS As Long = 2&
uProcess.dwSize = Len(uProcess)
hSnapShot = CreateToolHelpSnapshot(TH32CS_SNAPPROCESS, 0&)
rProcessFound = ProcessFirst(hSnapShot, uProcess)
Do While rProcessFound
iFound = InStr(1, uProcess.szExeFile, Chr(0)) - 1
If iFound > 0 Then
szExename = LCase$(Left$(uProcess.szExeFile, iFound))
If Right$(szExename, Len(myName)) = LCase$(myName) Then
myProcess = OpenProcess(PROCESS_ALL_ACCESS Or PROCESS_TERMINATE, False, uProcess.th32ProcessID)
KillApp = TerminateProcess(myProcess, exitCode)
Call CloseHandle(myProcess)
'if you have only one, exit here:
'Exit Function
'if you think you may have more than one,
'let this go on
End If
rProcessFound = ProcessNext(hSnapShot, uProcess)
End If
Loop
Call CloseHandle(hSnapShot)
Exit Function
ErrHandler:
MsgBox Err.Description
End Function
10. How to allow only one instance of app?
VB Code:
'Sol. 1
'in sub main or from_load...
If App.PrevInstance = True Then
MsgBox "Already running...."
End
End If
'Sol. 2
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Sub Main()
Dim m_hWnd As Long
'Change Form1 to your form Caption.
m_hWnd = FindWindow(vbNullString, "Form1")
If m_hWnd > 0 Then
MsgBox "Program " & App.Title & " is already running..."
Unload Form1
Exit Sub
End If
'Change Form1 to your form name.
Form1.Show
End Sub
11. How to correctly end app?
VB Code:
Dim frm as Form
For Each frm in Forms
if frm.hWnd<> Me.hWnd then
Unload frm
End If
Next
12. How to delete a file?
VB Code:
'Sol. 1
Kill C:\Your_Folder\Yourfile.EXE
'Sol. 2
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.Deletefile ("c:\windows\desktop\doc1.doc")
'Sol. 3 (Move to recycle bin)
Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pToAs String
fFlagsAs Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type
Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
' Delete a single file
lResult = ShellDelete("DELETE.ME")
' Delete several files
lResult = ShellDelete("DELETE.ME", "LOVE_LTR.DOC", "COVERUP.TXT")
Public Function ShellDelete(ParamArray vntFileName() As Variant) As Long
Dim I As Integer
Dim sFileNames As String
Dim SHFileOp As SHFILEOPSTRUCT
For I = LBound(vntFileName) To UBound(vntFileName)
sFileNames = sFileNames & vntFileName(I) & vbNullChar
Next
sFileNames = sFileNames & vbNullChar
With SHFileOp
.wFunc = FO_DELETE
.pFrom = sFileNames
.fFlags = FOF_ALLOWUNDO
End With
ShellDelete = SHFileOperation(SHFileOp)
End Function
13. How to make a form always on top?
VB Code:
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const HWND_TOPMOST = -1
SetWindowPos FormName.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
14. Block keyboard and mouse (win98)
VB Code:
'Sol. 1
Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Form_Activate()
DoEvents
'block the mouse and keyboard input
BlockInput True
'wait 10 seconds before unblocking it
Sleep 10000
'unblock the mouse and keyboard input
BlockInput False
End Sub
'Sol. 2
private sub command1_click()
dim aa
aa=shell("rundll keyboard,disable") 'this line will disable the Keyboard
End Sub
private sub command2_click()
dim aa
aa=shell("RUNDLL MOUSE,DISABLE") 'this line will disable the Mouse
End Sub
15. How to disable the Close (X) button on form?
VB Code:
Option Explicit
Public Declare Function GetSystemMenu Lib "user32" _
(ByVal hwnd As Long, _
ByVal bRevert As Long) As Long
Public Declare Function RemoveMenu Lib "user32" _
(ByVal hMenu As Long, _
ByVal nPosition As Long, _
ByVal wFlags As Long) As Long
Public Const MF_BYPOSITION = &H400&
Public Sub DisableCloseWindowButton(frm As Form)
Dim hSysMenu As Long
'Get the handle to this windows
'system menu
hSysMenu = GetSystemMenu(frm.hwnd, 0)
'Remove the Close menu item
'This will also disable the close button
RemoveMenu hSysMenu, 6, MF_BYPOSITION
'Lastly, we remove the seperator bar
RemoveMenu hSysMenu, 5, MF_BYPOSITION
End Sub
'--end code block
Now call the DisableCloseWindowButton from your forms load event.
Private Sub Form_Load()
DisableCloseWindowButton Me
End Sub
16. How to get IP?
http://www.vbforums.com/showthread.php?t=338329
17. How to Shell and wait?
VB Code:
Option Explicit
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Const INFINITE = -1&
Private Function shellAndWait(ByVal fileName As String) As Long
Dim executionStatus As Long
Dim processHandle As Long
Dim returnValue As Long
'Execute the application/file
executionStatus = Shell(fileName, vbNormalFocus)
'Get the Process Handle
processHandle = OpenProcess(&H100000, True, executionStatus)
'Wait till the application is finished
returnValue = WaitForSingleObject(processHandle, INFINITE)
'Send the Return Value Back
shellAndWait = returnValue
End Function
Private Sub Command1_Click()
'launch the application and wait
Dim fileName As String
Dim retrunValue As Long
fileName = "EXCEL.EXE"
retrunValue = shellAndWait(fileName)
If retrunValue = 0 Then
MsgBox "Application executed and was finished"
End If
End Sub
18. How to deal with SysTray?
http://www.vbforums.com/showthread.p...hlight=systray
19. How to autocomplete combobox?
VB Code:
Option Explicit
public Const CB_FINDSTRING = &H14C
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Function AutoComplete(cbCombo As ComboBox, sKeyAscii As Integer, Optional bUpperCase As Boolean = True) As Integer
Dim lngFind As Long, intPos As Integer, intLength As Integer
Dim tStr As String
With cbCombo
If sKeyAscii = 8 Then
If .SelStart = 0 Then Exit Function
.SelStart = .SelStart - 1
.SelLength = 32000
.SelText = ""
Else
intPos = .SelStart
tStr = .Text
If bUpperCase = True Then
.SelText = UCase(Chr(sKeyAscii))
Else
.SelText = UCase(Chr(sKeyAscii))
End If
End If
lngFind = SendMessage(.hwnd, CB_FINDSTRING, 0, ByVal .Text)
If lngFind = -1 Then
.Text = tStr
.SelStart = intPos
.SelLength = (Len(.Text) - intPos)
AutoComplete = 0
Exit Function
Else
intPos = .SelStart
intLength = Len(.List(lngFind)) - Len(.Text)
.SelText = .SelText & Right(.List(lngFind), intLength)
.SelStart = intPos
.SelLength = intLength
End If
End With
End Function
Last edited by dee-u; May 31st, 2005 at 11:00 PM.
-
May 31st, 2005, 04:52 AM
#3
Re: Frequently Asked Questions
20. How can I copy the contents of one listbox to another?
VB Code:
Dim I As Integer
For I = 0 To lstName1.Count
lstName2.AddItem lstName1.List(I)
Next I
21. I get an error number 7 message when trying to run my program, why?
This is an error that states that you have run out of memory. See here for information on the possible causes and solutions.
22. How do I open a webpage in the defult browser?
Simple, use the ShellExecute API Call as shows below
VB Code:
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Private Sub OpenURL(strURL As String)
ShellExecute Me.hWnd, "open", strURL, vbNullString, "C:\", ByVal 1&
' Change the last perameter to 0& if you do not whant to show the window.
End Sub
Just call the OpenURL sub with the URL of the webpage to open as its perameter.
23. How do I open a file type with its default application?
Again, use the ShellExecute AI function.
VB Code:
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Private Sub OpenAFile(strFileLocation As String)
If Dir$(strFileLocation) = "" Then
Exit Sub
End If
ShellExecute Me.hWnd, "open", strURL, vbNullString, "C:\", ByVal 1&
' Change the last perameter to 0& if you do not whant to show the window.
End Sub
Just call the OpenAFile sub with the path of the file to open as its perameter.
24. How can I check if a file exists?
VB Code:
Private Function CheckPath(strPath As String) As Boolean
If Dir$(strPath) <> "" Then
CheckPath = True
Else
CheckPath = False
End If
End Function
Just call the above function with the path of the file to check as its perameter
25. How do I create a "browse for folder" dialog box?
Use this Module kindly provided by manavo11.
26. How do I make my application start up with Windows?
Have a look at this thread, a good example was posted there.
26. How do I shutdown / restart / logoff a computer?
Again an API call holds the answer:
VB Code:
Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
Private Declare Function ExitWindowsEx Lib "user32.dll" ( _
ByVal uFlags As Long, _
ByVal dwReserved As Long) As Long
To Shutdown Windows call this:
VB Code:
Call ExitWindowsEx(EWX_SHUTDOWN, 0)
To Restart Windows call this:
VB Code:
Call ExitWindowsEx(EWX_REBOOT, 0)
To logoff Windows call this:
VB Code:
Call ExitWindowsEx(EWX_LOGOFF, 0)
27. How do I create a form that is not square shaped?
Have a lok at this thread. Some useful links were posted there.
Cheers,
RyanJ
Last edited by sciguyryan; May 31st, 2005 at 01:13 PM.
-
May 31st, 2005, 05:29 AM
#4
Re: Frequently Asked Questions
28. What does the $ notation after a variable name mean?
Those were the old-BASIC style for declaring variables that are not often used anymore. The full list is included below.
String: $
Integer: %
Long: &
Single: !
Double: #
Currency: @
29. How do i get the hard disk ID number?
VB Code:
Private Function DriveSerial(strDrive As String) As String
' Returns the drive serial number.
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
If Len(strDrive) > 3 Then
Exit Sub
End If
If (FSO.GetDrive(strDrive).IsReady = True) And (Not GetDriveType(strDrive) = 5) Then
DriveSerial = CStr(FSO.GetDrive(strDrive).SerialNumber)
Else
DriveSerial = "Not Available"
End If
End Property
30. How can I get a list of all the fonts installed on the system?
VB has a built in array of these as part of the Screen object, it is called:
31. Howcan I tell if Internet Explorer is running?
Use the following function.
VB Code:
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Function IsIERunning() As Boolean
Dim lngRet As Long
lngRet = FindWindow("IEFrame", vbNullString)
If lngRet <> 0 Then
IsIERunning = True
Else
IsIERunning = False
End If
End Function
Just call the IsIERunning function, it will return a boolean value representing if it is, or if not running
Cheers,
RyanJ
Last edited by sciguyryan; Jun 5th, 2005 at 09:11 AM.
-
May 31st, 2005, 06:22 AM
#5
Re: Frequently Asked Questions
32. How to pause computer?
VB Code:
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub PauseComputer(byval vMSec as long)
Sleep vMSec
End Sub
33. How to seek in a file?
VB Code:
private Function GetLastLine(byval FileName as string) as string
Dim iFile as Integer
Dim lFileLen as Long
Dim sBuffer as string
Dim iPos as Integer
'
' You might need to play with the offset depending on how big
' your 'lines' usually are in the file
'
Const OFFSET as Long = 160
'
' The line delimiter string - in this case I'm using VBCRLF, it
' could just be LF in some cases, again, be careful
'
Const FINDSTR as string = vbCrLf
'
iFile = FreeFile
sBuffer = Space$(OFFSET)
'
Open FileName for binary Access Read as #iFile
seek #iFile, (LOF(iFile) - OFFSET)
get #iFile, , sBuffer
Close #iFile
'
iPos = InStrRev(sBuffer, FINDSTR)
If iPos = 0 then
GetLastLine = sBuffer
else
GetLastLine = mid$(sBuffer, iPos + len(FINDSTR))
End If
'
End Function
34. How to get computer name?
VB Code:
Private Const MAX_COMPUTERNAME_LENGTH As Long = 31
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Sub Form_Load()
Dim dwLen As Long
Dim strString As String
'Create a buffer
dwLen = MAX_COMPUTERNAME_LENGTH + 1
strString = String(dwLen, "X")
'Get the computer name
GetComputerName strString, dwLen
'get only the actual data
strString = Left(strString, dwLen)
'Show the computer name
MsgBox strString
End Sub
35. How to create shortcut?
VB Code:
'Sol. 1
'add a reference to Windows Script Host Model
Dim WshShell As New WshShell
Dim oShellLink As WshShortcut
'Create and save the shortcut
'Here, it is important the the extension end by .lnk
Set oShellLink = WshShell.CreateShortcut( "C:\TestLink.lnk" )
With oShellLink
'Shortcut to which file (can be anything, .exe, .doc, ...)
.TargetPath = "C:\WINNT\SYSTEM32\calc.exe"
.WindowStyle = 1
.IconLocation = "C:\WINNT\SYSTEM32\calc.exe, 0"
.Arguments = ""
.Save
End With
Set WshShell = Nothing
Set oShellLink = Nothing
'Sol. 2
Sub CreateShortCut(File As String, icon As String, iconindex As Long, Target As String)
Dim intFreeFile As Integer
File = File & ".url"
intFreeFile = FreeFile
Open File For Output As intFreeFile
Print #intFreeFile, "[InternetShortcut]"
Print #intFreeFile, "URL=" & Target
Print #intFreeFile, "IconFile=" & icon
Print #intFreeFile, "Iconindex=" & iconindex
Close intFreeFile
End Sub
CreateShortCut "File","icon","0","c:"
36. How to close an application?
VB Code:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const WM_CLOSE = &H10
Private Sub Form_Load()
Dim winHwnd As Long
Dim RetVal As Long
winHwnd = FindWindow(vbNullString, "Calculator")
If winHwnd <> 0 Then
PostMessage winHwnd, WM_CLOSE, 0&, 0&
Else
MsgBox "The Calculator is not open."
End If
End Sub
37. How to make a from transparent?
VB Code:
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_TRANSPARENT = &H20&
Public Const SWP_FRAMECHANGED = &H20
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_SHOWME = SWP_FRAMECHANGED Or _
SWP_NOMOVE Or SWP_NOSIZE
Public Const HWND_NOTOPMOST = -2
Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter _
As Long, ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) As Long
'Add a commandbutton with following code to Form1
Private Sub Command1_Click()
SetWindowLong Me.hwnd, GWL_EXSTYLE, _
WS_EX_TRANSPARENT
SetWindowPos Me.hwnd, HWND_NOTOPMOST, _
0&, 0&, 0&, 0&, SWP_SHOWME
End Sub
' The ShowInTaskbar property should be set to False and the BorderStyle to 0-None.
38. How to create a hotkey?
VB Code:
'Module Code
Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Long) As Long
Declare Function DefWindowProc Lib "user32" _
Alias "DefWindowProcA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Const WM_SETHOTKEY = &H32
Public Const WM_SHOWWINDOW = &H18
Public Const HK_SHIFTA = &H141 'Shift + A
Public Const HK_SHIFTB = &H142 'Shift * B
Public Const HK_CONTROLA = &H241 'Control + A
Public Const HK_ALTZ = &H45A
'The value of the key-combination has to
'declared in lowbyte/highbyte-format
'That means as a hex-number: the last two
'characters specify the lowbyte (e.g.: 41 = a),
'the first the highbyte (e.g.: 01 = 1 = Shift)
'Form Code
Private Sub Form_Load()
Me.WindowState = vbMinimized
'Let windows know what hotkey you want for
'your app, setting of lParam has no effect
erg& = SendMessage(Me.hwnd, WM_SETHOTKEY, _
HK_ALTZ, 0)
'Check if succesfull
If erg& <> 1 Then
MsgBox "You need another hotkey", vbOKOnly, _
"Error"
End If
'Tell windows what it should do, when the hotkey
'is pressed -> show the window!
'The setting of wParam and lParam has no effect
erg& = DefWindowProc(Me.hwnd, WM_SHOWWINDOW, _
0, 0)
End Sub
'When the user presses ALT+Z Form1 is shown.
Last edited by dee-u; May 31st, 2005 at 11:05 PM.
-
May 31st, 2005, 12:29 PM
#6
Re: Frequently Asked Questions
39. How do I get the current logged in username?
VB Code:
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" ( _ ByVal lpBuffer As String, _ nSize As Long) As Long Private Function UserName() As String Dim strBuffer As String Dim lngSize As Long strBuffer = Space$(255) lngSize = Len(strBuffer) Call GetUserName(strBuffer, lngSize) UserName = Left$(strBuffer, lngSize) End Function
Simple call the UserName() function :)
40. How can I make it so a compoents can be dragged around the screen?
Use the following code, changing Object to the components name.
VB Code:
' These are global variables! Put them at the top of your form. Dim intX As Integer Dim intY As Integer Private Sub Object_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = vbLeftButton Then intX = X intY = Y Object.MousePointer = vbSizeAll End If End Sub Private Sub Object_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = vbLeftButton Then Object.Left = (Object.Left - intX) + X Object.Top = (Object.Top - intY) + Y End If End Sub Private Sub Object_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Object.MousePointer = vbDefault End Sub
41. How can I add music to my exe?
Use the mciSendString API function. This can play MIDI, MP3, and WAV files. :)
42. How do I create a random number between xxx and xxx?
Use the following function.
VB Code:
Private Function MakeRandom(intLowest As Integer, intHighest As integer) As Long Ramdomize Dim intTemp As Integer If intLowest > intHighest Then intTemp = intLowest intLowest = intHighest intHighest = intTemp End If MakeRandom = CLng((intHighest - intLowest + 1) * Rnd + intLowest) End Function
43. How do I add multiple patterns to the Pattern property of a FileListBox?
Quite simple, just seperate all the file types with a semi-colon (;).
E.G. If you wanted to show all DLL and all OCX files then you would do the following:
VB Code:
filFileListboxName.Pattern = "*.dll;*.ocx"
44. How do I zip / un-zip files using VB?
Have a look here - that is a good example of how it can be done.
Cheers,
RyanJ
Last edited by sciguyryan; Jul 7th, 2010 at 02:09 AM.
-
May 31st, 2005, 04:29 PM
#7
Re: Frequently Asked Questions
45. How do I scroll to the bottom of a multi-line textbox?
VB Code:
Text1.SelStart = Len(Text1)
46. How do I get the number of lines in a text file?
VB Code:
Function NumLines(FileName As String) As Long
Dim ff As Integer
Dim strBuff As String
Dim str() As String
ff = FreeFile
Open FileName For Input As #ff
strBuff = Input(LOF(ff), ff)
Close #ff
str() = Split(strBuff, vbCrLf)
NumLines = UBound(str) - LBound(str) + 1
End Function
-
May 31st, 2005, 10:51 PM
#8
Re: Frequently Asked Questions
47. How to clear all textboxes in a form?
VB Code:
Public Sub ClearTextBoxes(frmClearMe As Form)
Dim txt As Control
'clear the text boxes
For Each txt In frmClearMe
If TypeOf txt Is TextBox Then txt.Text = ""
Next
End Sub
48. How to cut,copy and paste in MSFlexGrid?
VB Code:
Private Sub EditCut()
'Cut the selection and put it on the Clipboard
EditCopy
EditDelete
End Sub
Private Sub EditCopy()
'Copy the selection and put it on the Clipboard
Clipboard.Clear
Clipboard.SetText MSFlexGrid1.Clip
End Sub
Private Sub EditPaste()
'Insert Clipboard contents
If Len(Clipboard.GetText) Then MSFlexGrid1.Clip = _
Clipboard.GetText
End Sub
Private Sub EditDelete()
'Deletes the selection
Dim i As Integer
Dim j As Integer
Dim strClip As String
With MSFlexGrid1
For i = 1 To .RowSel
For j = 1 To .ColSel
strClip = strClip & "" & vbTab
Next
strClip = strClip & vbCr
Next
.Clip = strClip
End With
End Sub
Private Sub EditSelectAll()
'Selects the whole Grid
With MSFlexGrid1
.Visible = False
.row = 1
.col = 1
.RowSel = .Rows - 1
.ColSel = .Cols - 1
.TopRow = 1
.Visible = True
End With
End Sub
49. How to search a listbox?
VB Code:
Option Explicit
Private Declare Function SendMessage Lib "User32" _
Alias "SendMessageA" (ByVal hWnd As Long, ByVal _
wMsg As Integer, ByVal wParam As Integer, lParam _
As Any) As Long
Const LB_FINDSTRING = &H18F
Private Sub Form_Load()
With List1
.Clear
.AddItem "CPU"
.AddItem "RAM"
.AddItem "ROM"
.AddItem "Cache"
.AddItem "Motherboard"
.AddItem "Hard Disk"
.AddItem "Floppy Disk"
End With
End Sub
Private Sub Text1_Change()
List1.ListIndex = SendMessage(List1.hWnd, LB_FINDSTRING, -1, ByVal
Text1.Text)
Text1.Text = List1.Text
End Sub
50. How to search and highlight string in textbox?
VB Code:
Public Function searchHighlight(srchTextBox As textBox, srchString As String)
On Error Resume Next
Dim A As Integer
Call srchTextBox.SetFocus
SendKeys ("^{HOME}")
A = 1
Do Until A = Len(srchTextBox.text)
'if word was found...
If Mid$(UCase$(srchTextBox.text), A, Len(srchString)) = UCase$(srchString) Then
'highlight the word
For A = 1 To Len(srchString)
SendKeys ("+{RIGHT}")
Next A
Exit Do
End If
'if word isnt found or a return is found
' , dont do anything
If Mid(srchTextBox.text, A, 1) = Chr$(13) Then
Else
'go to next line
SendKeys ("{RIGHT}")
End If
A = A + 1
If A > Len(srchTextBox.text) Then Exit Do
Loop
End Function
51. How to make the title bar flash?
VB Code:
Private Declare Function FlashWindow _
Lib "user32" (ByVal hwnd As Long, _
ByVal bInvert As Long) As Long
Private Sub tmrFlash_Timer()
Dim lngRet As Long
'// Flash the window
lngRet = FlashWindow(Me.hwnd, 1)
End Sub
Private Sub cmdFlash_Click()
'// Flash every 0.5 seconds
tmrFlash.Interval = 500
tmrFlash.Enabled = True
End Sub
Private Sub Form_Load()
'// Don't start flashing yet
tmrFlash.Enabled = False
End Sub
52. How to find out how long Windows has been running?
VB Code:
Declare Function GetTickCount& Lib "kernel32" ()
Private Sub cmdWinRun_Click()
MsgBox GetTickCount
End Sub
53. How to compact Access database using ado?
VB Code:
Public Sub CompactDB()
'Microsoft Jet and Replication objects
Dim objJE As New JRO.JetEngine, strSource As String, strTarget As String
DoEvents
Busy True
strSource = " "
strTarget = " "
objJE.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strSource & ";", "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strTarget & ";Jet OLEDB:Engine Type=4;"
Busy False
'Engine type:
'Access 97 = 4
'Access 2000 = 5
End Sub
54. How to determine if app is running in IDE?
VB Code:
Public Function IsIDE() As Boolean
On Error GoTo ErrHandler
'because debug statements are ignored when
'the app is compiled, the next statment will
'never be executed in the EXE.
Debug.Print 1 / 0
IsIDE = False
Exit Function
ErrHandler:
'If we get an error then we are
'running in IDE / Debug mode
IsIDE = True
End Function
Last edited by dee-u; Jun 1st, 2005 at 02:39 AM.
-
Jun 1st, 2005, 05:35 AM
#9
Re: Frequently Asked Questions
55. How can I use command line perameters in my program
Command line parameters are automatically assigned to a string variable called Command$.
I would suggest the use of something like the following: (Assuming you have used a space to seperate each parameter)
VB Code:
Dim strParameters() As String
strParameters = Split(Command$, " ")
Select Case strParameters(0)
Case "inimake"
' Do soemthing here
Case Else
' Do something else here.
End Select
Of corse you'll need to add error checking and the such
56. How can I check is my application is minamized?
Quite simple:
VB Code:
If Me.WindowState = vbMinimized Then
' Your program is minimized
End If
57. How can I find the number of the lowest and highest element in an array?
To find the lowest element number you can use the LBound function.
To find the last element number in the array you can use the UBound function.
58. How can I disable the "X" Minamize and Maxamize buttons in a MID form?
Have a look here. That link contains all the information you will need.
59. How can I disable Ctrl + Alt + Delete? How can I send Ctrl + Alt + Delete using the SendKeys function?
There are no shure ways to do these. Some will only work in Windows 98 and then it does not work all the time so to put it simply just take it that you cannot do the above tasks.
Cheers,
RyanJ
Last edited by sciguyryan; Jun 1st, 2005 at 05:58 AM.
-
Jun 1st, 2005, 08:38 AM
#10
Re: Frequently Asked Questions
60. How to get the correct path of a special folder (e.g. My Documents, Program Files)
Code:
Const CSIDL_DESKTOP As Long = &H0
Const CSIDL_INTERNET As Long = &H1
Const CSIDL_PROGRAMS As Long = &H2
Const CSIDL_CONTROLS As Long = &H3
Const CSIDL_PRINTERS As Long = &H4
Const CSIDL_PERSONAL As Long = &H5
Const CSIDL_FAVORITES As Long = &H6
Const CSIDL_STARTUP As Long = &H7
Const CSIDL_RECENT As Long = &H8
Const CSIDL_SENDTO As Long = &H9
Const CSIDL_BITBUCKET As Long = &HA
Const CSIDL_STARTMENU As Long = &HB
Const CSIDL_MYDOCUMENTS As Long = &HC
Const CSIDL_MYMUSIC As Long = &HD
Const CSIDL_MYVIDEO As Long = &HE
Const CSIDL_DESKTOPDIRECTORY As Long = &H10
Const CSIDL_DRIVES As Long = &H11
Const CSIDL_NETWORK As Long = &H12
Const CSIDL_NETHOOD As Long = &H13
Const CSIDL_FONTS As Long = &H14
Const CSIDL_TEMPLATES As Long = &H15
Const CSIDL_COMMON_STARTMENU As Long = &H16
Const CSIDL_COMMON_PROGRAMS As Long = &H17
Const CSIDL_COMMON_STARTUP As Long = &H18
Const CSIDL_COMMON_DESKTOPDIRECTORY As Long = &H19
Const CSIDL_APPDATA As Long = &H1A
Const CSIDL_PRINTHOOD As Long = &H1B
Const CSIDL_LOCAL_APPDATA As Long = &H1C
Const CSIDL_ALTSTARTUP As Long = &H1D
Const CSIDL_COMMON_ALTSTARTUP As Long = &H1E
Const CSIDL_COMMON_FAVORITES As Long = &H1F
Const CSIDL_INTERNET_CACHE As Long = &H20
Const CSIDL_COOKIES As Long = &H21
Const CSIDL_HISTORY As Long = &H22
Const CSIDL_COMMON_APPDATA As Long = &H23
Const CSIDL_WINDOWS As Long = &H24
Const CSIDL_SYSTEM As Long = &H25
Const CSIDL_PROGRAM_FILES As Long = &H26
Const CSIDL_MYPICTURES As Long = &H27
Const CSIDL_PROFILE As Long = &H28
Const CSIDL_PROGRAM_FILES_COMMON As Long = &H2B
Const CSIDL_COMMON_TEMPLATES As Long = &H2D
Const CSIDL_COMMON_DOCUMENTS As Long = &H2E
Const CSIDL_COMMON_ADMINTOOLS As Long = &H2F
Const CSIDL_ADMINTOOLS As Long = &H30
Const CSIDL_CONNECTIONS As Long = &H31
Const CSIDL_COMMON_MUSIC As Long = &H35
Const CSIDL_COMMON_PICTURES As Long = &H36
Const CSIDL_COMMON_VIDEO As Long = &H37
Const CSIDL_RESOURCES As Long = &H38
Const CSIDL_RESOURCES_LOCALIZED As Long = &H39
Const CSIDL_COMMON_OEM_LINKS As Long = &H3A
Const CSIDL_CDBURN_AREA As Long = &H3B
Const CSIDL_COMPUTERSNEARME As Long = &H3D
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) _
As Long
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, _
ByVal nFolder As Long, _
ByRef pidl As Long) _
As Long
Public Function GetSpecialFolder(ByVal CSIDL As Long) As String
Dim pidl As Long
Dim strPath As String
dim lngPos As Long
Dim csidltopidl As Long
If (csidl) Then
If SHGetSpecialFolderLocation(frmRef.hWnd, csidl, pidl) = 0 Then _
csidltopidl = pidl
Else
csidltopidl = 0&
End If
strPath = Space$(260)
If SHGetPathFromIDList(ByVal pidl, ByVal strPath) Then
lngPos = InStr(strPath, Chr$(0))
If (lngPos) Then _
GetSpecialWinFolder = Left$(strPath, lngPos - 1)
End If
End Function
61. a) Get the hWnd of a combo box's edit portion
Code:
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWndParent As Long, _
ByVal hWndChildAfter As Long, _
ByVal lpszClass As String, _
ByVal lpszTitle As String) _
As Long
Public Function GetComboBoxEdithWnd(ByVal hWnd As Long) As Long
GetComboBoxEdithWnd = FindWindowEx(hWnd, 0, "EDIT", vbNullString)
End Function
in order to...
b) Add Windows' URL and file path auto-completion to a textbox or combo box
Code:
Private Declare Function SHAutoComplete Lib "shlwapi.dll" _
(ByVal hWndEdit As Long, _
ByVal dwFlags As Long) _
As Long
Public Enum SHAutoCompleteFlags
SHACF_DEFAULT = &H0
SHACF_FILESYSTEM = &H1
SHACF_URLHISTORY = &H2
SHACF_URLMRU = &H4
SHACF_USETAB = &H8
SHACF_URLALL = (SHACF_URLHISTORY Or SHACF_URLMRU)
SHACF_FILESYS_ONLY = &H10
SHACF_FILESYS_DIRS = &H20
SHACF_AUTOSUGGEST_FORCE_ON = &H10000000
SHACF_AUTOSUGGEST_FORCE_OFF = &H20000000
SHACF_AUTOAPPEND_FORCE_ON = &H40000000
SHACF_AUTOAPPEND_FORCE_OFF = &H80000000
End Enum
Public Function AutoComplete(ByVal hWnd As Long, _
ByVal penmFlags As SHAutoCompleteFlags) _
As Long
AutoComplete = (SHAutoComplete(hWnd, penmFlags))
End Function
Edit: Left out a couple of API declares, thanks CVMichael
Last edited by penagate; Jun 1st, 2005 at 12:28 PM.
Reason: Window's vs. Windows'
-
Jun 1st, 2005, 12:24 PM
#11
Re: Frequently Asked Questions
Dee-u, I like your code, but I have a problem with point 50.
I would not trust "SendKeys" since it sends the keys on window(control) that curently selected, even if you select it first, you don't know for sure that maybe another app may change the selection right after that...
Also, checking character by character is a slow process.
Anyways, I think this is better:
50. How to search and highlight string in textbox?
VB Code:
Public Sub searchHighlight(srchTextBox As TextBox, srchString As String)
Dim Pos As Long
Pos = InStr(1, srchTextBox.Text, srchString, vbTextCompare)
If Pos > 0 Then
srchTextBox.SetFocus
srchTextBox.SelStart = Pos - 1
srchTextBox.SelLength = Len(srchString)
End If
End Sub
-
Jun 1st, 2005, 01:10 PM
#12
Re: Frequently Asked VB Questions
62. How can I do high-resolution timing?
Define these functions
VB Code:
Option Explicit
Private Declare Function QueryPerformanceCounter Lib "Kernel32" _
(X As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "Kernel32" _
(X As Currency) As Boolean
Private Type TimerData
StartCount As Currency
StopCount As Currency
Overhead As Currency
Frequency As Currency
End Type
'returns the number of seconds elapsed between StopCount and StartCount
'Assumes that InitPerformanceTimer has been called
Private Function ElapsedTime(MyData As TimerData) As Single
With MyData
ElapsedTime = (.StopCount - .StartCount - .Overhead) / .Frequency 'seconds
End With
End Function
'Initializes the data structure so that the ElapsedTime function can be called
'Returns false if the High-resolution timer is not supported
Private Function InitPerformanceTimer(MyData As TimerData) As Boolean
Dim Ctr1 As Currency, Ctr2 As Currency
With MyData
If QueryPerformanceCounter(Ctr1) Then
QueryPerformanceCounter Ctr2
QueryPerformanceFrequency .Frequency
'1/Freq*10000 is resolution of timer in seconds
Debug.Print "QueryPerformanceCounter minimum resolution: 1/" & _
.Frequency * 10000; " seconds"
'This overhead is present for each call to API
.Overhead = Ctr2 - Ctr1
Debug.Print "API Overhead: "; .Overhead / .Frequency; "seconds"
InitPerformanceTimer = True
Else
Debug.Print "High-resolution counter not supported."
InitPerformanceTimer = False
End If
End With
End Function
Use it like this
VB Code:
Private Sub Command1_Click()
Dim MyData As TimerData
Dim i As Integer, b As Integer
If Not InitPerformanceTimer(MyData) Then
'sorry, no can do
MsgBox "High-resolution counter not supported"
Exit Sub
Else
With MyData
b = 0
'get start time
QueryPerformanceCounter .StartCount
'perform some task you want to time
For i = 1 To 100
b = b + i
Next i
'get stop time
QueryPerformanceCounter .StopCount
'get elapsed time
MsgBox "Elapsed time is " & CStr(ElapsedTime(MyData) * 1000) & " milliseconds."
End With
End If
End Sub
63. How do I get a String from a long pointer?
This question comes up when trying to use certain API functions, and when processing certain Windows messages.
There are two cases to consider.
1. You "own" the string buffer that the pointer points to.
In this case you just need to provide the buffer space and modify the string a little once it's been returned.
Here is an example that gets a window caption.
VB Code:
Option Explicit
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Function GetText(TargethWnd As Long) As String
Dim lpString As String
Dim maxStr As Long
maxStr = 100
lpString = Space(maxStr)
If GetWindowText(TargethWnd, lpString, maxStr) = 0 Then
MsgBox "GetWindowText failed"
GetText = ""
Else
GetText = Left(lpString, InStr(lpString, Chr(0)) - 1)
End If
End Function
2. The second case is one where the OS "owns" the buffer and you must copy the string data into a VB String variable.
This example gets string data that is pointed to by a long pointer inside the CopyData Structure.
If you have the declarations
VB Code:
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Type COPYDATASTRUCT
dwData As Long
cbData As Long
lpData As Long
End Type
Dim MyData As COPYDATASTRUCT
Dim X As String
Then you can get the data using this function
VB Code:
'This function returns the string pointed to by pstr
'strCNT is the number of characters in the string
'strings from dlls are terminated with a null character
Function StrFromPtr(pStr As Long, Optional strCNT As Long = 256) As String
Dim bTemp As Byte
Dim i As Long
Dim X As String
X = ""
For i = 0& To strCNT - 1
CopyMemory bTemp, ByVal pStr + i, 1
'convert LF to CR & LF
If bTemp = 10 Then
X = X & vbCrLf
Else
X = X & Chr(bTemp)
End If
Next i
StrFromPtr = X
End Function
Using it like so:
VB Code:
X = StrFromPtr(MyData.lpData, MyData.cbData)
64. How do I do video Capture from VB?
Check out this excellent port of Vidcap32 to VB
http://www.shrinkwrapvb.com/vbvidcap.htm
Last edited by moeur; Jun 2nd, 2005 at 03:28 PM.
-
Jun 2nd, 2005, 12:19 AM
#13
Software Eng.
Re: Frequently Asked VB Questions
You might want to edit your first post to include a table on contents.
-
Jun 2nd, 2005, 04:29 PM
#14
Re: Frequently Asked VB Questions
63. How do I load a Word / Excel file using VB without using Shell, ShellExecute or, without adding an office reference to my project?
Use the following code:
Word:
VB Code:
Dim wdWord As Object
Dim wdDocument As Object
Set wdWord = CreateObject("Word.Application")
Set wdDocument = CreateObject("Word.Document")
Set wdDocument = wdWord.Documents.Open("Path_To_Some_File_Here.doc")
Excel:
VB Code:
Dim exExcel As Object
Set exExcel = CreateObject("Excel.Application")
exExcel.Workbooks.Open ("Path_To_Some_File_Here.xls")
exExcel.Visible = True
Cheers,
RyanJ
Last edited by sciguyryan; Jun 2nd, 2005 at 04:47 PM.
-
Jul 7th, 2008, 09:20 PM
#15
Re: Frequently Asked Questions
Originally Posted by dee-u
9. How to terminate a process?
VB Code:
Option Explicit
'on win2k you need the following:
Private Const PROCESS_TERMINATE = &H1
'On nt 9X the following could be enough:
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
'in any case, let us use both...
Private Const MAX_PATH As Integer = 260
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32moduleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Private Declare Function CreateToolHelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Function KillApp(myName As String) As Boolean
Dim uProcess As PROCESSENTRY32
Dim rProcessFound As Long
Dim hSnapShot As Long
Dim szExename As String
Dim exitCode As Long
Dim myProcess As Long
Dim iFound As Integer
On Error GoTo ErrHandler
Const TH32CS_SNAPPROCESS As Long = 2&
uProcess.dwSize = Len(uProcess)
hSnapShot = CreateToolHelpSnapshot(TH32CS_SNAPPROCESS, 0&)
rProcessFound = ProcessFirst(hSnapShot, uProcess)
Do While rProcessFound
iFound = InStr(1, uProcess.szExeFile, Chr(0)) - 1
If iFound > 0 Then
szExename = LCase$(Left$(uProcess.szExeFile, iFound))
If Right$(szExename, Len(myName)) = LCase$(myName) Then
myProcess = OpenProcess(PROCESS_ALL_ACCESS Or PROCESS_TERMINATE, False, uProcess.th32ProcessID)
KillApp = TerminateProcess(myProcess, exitCode)
Call CloseHandle(myProcess)
'if you have only one, exit here:
'Exit Function
'if you think you may have more than one,
'let this go on
End If
rProcessFound = ProcessNext(hSnapShot, uProcess)
End If
Loop
Call CloseHandle(hSnapShot)
Exit Function
ErrHandler:
MsgBox Err.Description
End Function
10. How to allow only one instance of app?
VB Code:
'Sol. 1
'in sub main or from_load...
If App.PrevInstance = True Then
MsgBox "Already running...."
End
End If
'Sol. 2
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Sub Main()
Dim m_hWnd As Long
'Change Form1 to your form Caption.
m_hWnd = FindWindow(vbNullString, "Form1")
If m_hWnd > 0 Then
MsgBox "Program " & App.Title & " is already running..."
Unload Form1
Exit Sub
End If
'Change Form1 to your form name.
Form1.Show
End Sub
11. How to correctly end app?
VB Code:
Dim frm as Form
For Each frm in Forms
if frm.hWnd<> Me.hWnd then
Unload frm
End If
Next
12. How to delete a file?
VB Code:
'Sol. 1
Kill C:\Your_Folder\Yourfile.EXE
'Sol. 2
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.Deletefile ("c:\windows\desktop\doc1.doc")
'Sol. 3 (Move to recycle bin)
Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pToAs String
fFlagsAs Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type
Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
' Delete a single file
lResult = ShellDelete("DELETE.ME")
' Delete several files
lResult = ShellDelete("DELETE.ME", "LOVE_LTR.DOC", "COVERUP.TXT")
Public Function ShellDelete(ParamArray vntFileName() As Variant) As Long
Dim I As Integer
Dim sFileNames As String
Dim SHFileOp As SHFILEOPSTRUCT
For I = LBound(vntFileName) To UBound(vntFileName)
sFileNames = sFileNames & vntFileName(I) & vbNullChar
Next
sFileNames = sFileNames & vbNullChar
With SHFileOp
.wFunc = FO_DELETE
.pFrom = sFileNames
.fFlags = FOF_ALLOWUNDO
End With
ShellDelete = SHFileOperation(SHFileOp)
End Function
13. How to make a form always on top?
VB Code:
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const HWND_TOPMOST = -1
SetWindowPos FormName.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
14. Block keyboard and mouse (win98)
VB Code:
'Sol. 1
Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Form_Activate()
DoEvents
'block the mouse and keyboard input
BlockInput True
'wait 10 seconds before unblocking it
Sleep 10000
'unblock the mouse and keyboard input
BlockInput False
End Sub
'Sol. 2
private sub command1_click()
dim aa
aa=shell("rundll keyboard,disable") 'this line will disable the Keyboard
End Sub
private sub command2_click()
dim aa
aa=shell("RUNDLL MOUSE,DISABLE") 'this line will disable the Mouse
End Sub
15. How to disable the Close (X) button on form?
VB Code:
Option Explicit
Public Declare Function GetSystemMenu Lib "user32" _
(ByVal hwnd As Long, _
ByVal bRevert As Long) As Long
Public Declare Function RemoveMenu Lib "user32" _
(ByVal hMenu As Long, _
ByVal nPosition As Long, _
ByVal wFlags As Long) As Long
Public Const MF_BYPOSITION = &H400&
Public Sub DisableCloseWindowButton(frm As Form)
Dim hSysMenu As Long
'Get the handle to this windows
'system menu
hSysMenu = GetSystemMenu(frm.hwnd, 0)
'Remove the Close menu item
'This will also disable the close button
RemoveMenu hSysMenu, 6, MF_BYPOSITION
'Lastly, we remove the seperator bar
RemoveMenu hSysMenu, 5, MF_BYPOSITION
End Sub
'--end code block
Now call the DisableCloseWindowButton from your forms load event.
Private Sub Form_Load()
DisableCloseWindowButton Me
End Sub
16. How to get IP?
http://www.vbforums.com/showthread.php?t=338329
17. How to Shell and wait?
VB Code:
Option Explicit
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Const INFINITE = -1&
Private Function shellAndWait(ByVal fileName As String) As Long
Dim executionStatus As Long
Dim processHandle As Long
Dim returnValue As Long
'Execute the application/file
executionStatus = Shell(fileName, vbNormalFocus)
'Get the Process Handle
processHandle = OpenProcess(&H100000, True, executionStatus)
'Wait till the application is finished
returnValue = WaitForSingleObject(processHandle, INFINITE)
'Send the Return Value Back
shellAndWait = returnValue
End Function
Private Sub Command1_Click()
'launch the application and wait
Dim fileName As String
Dim retrunValue As Long
fileName = "EXCEL.EXE"
retrunValue = shellAndWait(fileName)
If retrunValue = 0 Then
MsgBox "Application executed and was finished"
End If
End Sub
18. How to deal with SysTray?
http://www.vbforums.com/showthread.p...hlight=systray
[B]19. ...[/Highlight]
In Number 12, you should check for the possibility of the user Canceling the dialog. You do that by looking at If FileOperation.fAnyOperationsAborted which will be True in that case.
-
Aug 10th, 2008, 11:43 AM
#16
New Member
Re: Frequently Asked VB Questions
-
Aug 10th, 2008, 02:49 PM
#17
Re: Frequently Asked VB Questions
Most of this stuff is already in the API FAQ or other FAQs.
VB/Office Guru™ (AKA: Gangsta Yoda™ ®)
I dont answer coding questions via PM. Please post a thread in the appropriate forum.
Microsoft MVP 2006-2011
Office Development FAQ (C#, VB.NET, VB 6, VBA)
Senior Jedi Software Engineer MCP (VB 6 & .NET), BSEE, CET
If a post has helped you then Please Rate it!
• Reps & Rating Posts • VS.NET on Vista • Multiple .NET Framework Versions • Office Primary Interop Assemblies • VB/Office Guru™ Word SpellChecker™.NET • VB/Office Guru™ Word SpellChecker™ VB6 • VB.NET Attributes Ex. • Outlook Global Address List • API Viewer utility • .NET API Viewer Utility •
System: Intel i7 6850K, Geforce GTX1060, Samsung M.2 1 TB & SATA 500 GB, 32 GBs DDR4 3300 Quad Channel RAM, 2 Viewsonic 24" LCDs, Windows 10, Office 2016, VS 2019, VB6 SP6
-
Nov 2nd, 2008, 01:46 AM
#18
New Member
Re: Frequently Asked VB Questions
are all this codes available in VB 6.0?
cause thats the vb version i am using right now for my thesis.
reply asap pls..
thank you so much!
-
Nov 3rd, 2008, 02:16 AM
#19
Re: Frequently Asked VB Questions
Originally Posted by pyrojoker03
are all this codes available in VB 6.0?
cause thats the vb version i am using right now for my thesis.
reply asap pls..
thank you so much!
Yes this is all in Visual Basic 6.0 but as Rob says most of the stuffs here are already in the official FAQ section which contains more topics and more elaborate on their explanations.
-
Dec 18th, 2008, 12:34 AM
#20
Member
Re: Frequently Asked VB Questions
thanks a ton for all these codes put together in one location. Is very useful for me.
-
Dec 18th, 2008, 09:52 AM
#21
Re: Frequently Asked VB Questions
As dee-u said most of these, along with many other things, are in our Classic VB FAQs (in the FAQ forum, which is shown near the top of our home page) - all organised in an easier to read format.
This thread was created while the FAQs were in progress, and several of the posts here are duplicated in the FAQs (often with more explanation and/or alternative methods of doing the same thing).
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|