home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 January / Chip_1999-01_cd.bin / sharewar / learnAPI / learnapi.exe / Main.frm (.txt) < prev    next >
Visual Basic Form  |  1998-07-04  |  33KB  |  751 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "LearnAPI"
  5.    ClientHeight    =   3780
  6.    ClientLeft      =   255
  7.    ClientTop       =   1035
  8.    ClientWidth     =   2760
  9.    Icon            =   "Main.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   3780
  14.    ScaleWidth      =   2760
  15.    Begin VB.CommandButton cmdRun 
  16.       Caption         =   "&Run"
  17.       Height          =   375
  18.       Left            =   120
  19.       TabIndex        =   7
  20.       Top             =   720
  21.       Width           =   2535
  22.    End
  23.    Begin VB.ComboBox cboAPIFunction 
  24.       Height          =   315
  25.       Left            =   120
  26.       Style           =   2  'Dropdown List
  27.       TabIndex        =   5
  28.       Top             =   360
  29.       Width           =   2535
  30.    End
  31.    Begin VB.Frame fraGroup 
  32.       Caption         =   "ShellExecute Function"
  33.       Height          =   855
  34.       Index           =   1
  35.       Left            =   120
  36.       TabIndex        =   2
  37.       Top             =   2520
  38.       Width           =   2415
  39.       Begin VB.Label lblURL 
  40.          AutoSize        =   -1  'True
  41.          BackStyle       =   0  'Transparent
  42.          Caption         =   "Longonot Software Web-Site"
  43.          BeginProperty Font 
  44.             Name            =   "MS Sans Serif"
  45.             Size            =   8.25
  46.             Charset         =   0
  47.             Weight          =   400
  48.             Underline       =   -1  'True
  49.             Italic          =   0   'False
  50.             Strikethrough   =   0   'False
  51.          EndProperty
  52.          ForeColor       =   &H00FF0000&
  53.          Height          =   195
  54.          Left            =   120
  55.          MouseIcon       =   "Main.frx":030A
  56.          MousePointer    =   99  'Custom
  57.          TabIndex        =   4
  58.          Top             =   240
  59.          Width           =   2055
  60.       End
  61.       Begin VB.Label lblMailto 
  62.          AutoSize        =   -1  'True
  63.          BackStyle       =   0  'Transparent
  64.          Caption         =   "longonot@intekom.co.za"
  65.          BeginProperty Font 
  66.             Name            =   "MS Sans Serif"
  67.             Size            =   8.25
  68.             Charset         =   0
  69.             Weight          =   400
  70.             Underline       =   -1  'True
  71.             Italic          =   0   'False
  72.             Strikethrough   =   0   'False
  73.          EndProperty
  74.          ForeColor       =   &H00FF0000&
  75.          Height          =   195
  76.          Left            =   240
  77.          MouseIcon       =   "Main.frx":045C
  78.          MousePointer    =   99  'Custom
  79.          TabIndex        =   3
  80.          Top             =   480
  81.          Width           =   1770
  82.       End
  83.    End
  84.    Begin VB.Timer tmrFlashWindow 
  85.       Enabled         =   0   'False
  86.       Interval        =   200
  87.       Left            =   2400
  88.       Top             =   0
  89.    End
  90.    Begin VB.Label lblDiscription 
  91.       BorderStyle     =   1  'Fixed Single
  92.       Caption         =   "Discription of API function."
  93.       Height          =   1215
  94.       Left            =   120
  95.       TabIndex        =   8
  96.       Top             =   1200
  97.       Width           =   2535
  98.       WordWrap        =   -1  'True
  99.    End
  100.    Begin VB.Label lblSelectFunction 
  101.       AutoSize        =   -1  'True
  102.       Caption         =   "Select an API Function:"
  103.       Height          =   195
  104.       Left            =   120
  105.       TabIndex        =   6
  106.       Top             =   120
  107.       Width           =   1680
  108.    End
  109.    Begin VB.Label lblCredits 
  110.       AutoSize        =   -1  'True
  111.       BackStyle       =   0  'Transparent
  112.       Caption         =   "About / Credits"
  113.       BeginProperty Font 
  114.          Name            =   "MS Sans Serif"
  115.          Size            =   8.25
  116.          Charset         =   0
  117.          Weight          =   700
  118.          Underline       =   -1  'True
  119.          Italic          =   0   'False
  120.          Strikethrough   =   0   'False
  121.       EndProperty
  122.       ForeColor       =   &H00008000&
  123.       Height          =   195
  124.       Left            =   120
  125.       MouseIcon       =   "Main.frx":05AE
  126.       MousePointer    =   99  'Custom
  127.       TabIndex        =   1
  128.       Top             =   3480
  129.       Width           =   1305
  130.    End
  131.    Begin VB.Label lblExit 
  132.       BackStyle       =   0  'Transparent
  133.       Caption         =   "Exit"
  134.       BeginProperty Font 
  135.          Name            =   "MS Sans Serif"
  136.          Size            =   8.25
  137.          Charset         =   0
  138.          Weight          =   700
  139.          Underline       =   -1  'True
  140.          Italic          =   0   'False
  141.          Strikethrough   =   0   'False
  142.       EndProperty
  143.       ForeColor       =   &H00008000&
  144.       Height          =   255
  145.       Left            =   1560
  146.       MouseIcon       =   "Main.frx":0700
  147.       MousePointer    =   99  'Custom
  148.       TabIndex        =   0
  149.       Top             =   3480
  150.       Width           =   375
  151.    End
  152. Attribute VB_Name = "frmMain"
  153. Attribute VB_GlobalNameSpace = False
  154. Attribute VB_Creatable = False
  155. Attribute VB_PredeclaredId = True
  156. Attribute VB_Exposed = False
  157. Option Explicit
  158. Dim CustomColors() As Byte 'Variable to hold custom colours
  159. Dim RunningInIDE As Boolean 'Used to hold running in IDE or not
  160. Private Sub cSetWindowPos()
  161. Dim flags%, lResult&
  162. Static Invert As Boolean
  163. flags = SWP_NOSIZE Or SWP_NOMOVE
  164. If Invert = False Then
  165.     lResult = SetWindowPos(frmMain.hwnd, HWND_TOPMOST, 0, 0, 0, 0, flags)
  166.     Invert = True
  167. ElseIf Invert = True Then
  168.     lResult = SetWindowPos(frmMain.hwnd, HWND_NOTTOPMOST, 0, 0, 0, 0, flags)
  169.     Invert = False
  170. End If
  171. End Sub
  172. Private Sub cGetOpenFileName()
  173. 'The code to call the Open Dialog box is in the
  174. 'fGetOpenFileName function
  175. Dim Path$, Filter$
  176.     Filter = "All Files (*.*)" & Chr(0) & "*.*" & Chr(0)
  177.     Path = fGetOpenFileName(Filter)
  178.     If Path <> "Cancel" Then
  179.         MsgBox "You selected " & Path, vbOKOnly + vbInformation, "LearnAPI"
  180.     End If
  181. End Sub
  182. Private Sub cGetFileAttributes()
  183. Dim Path$, Filter$, Att&, Msg$
  184. On Error GoTo OpenError
  185.     Filter = "All Files (*.*)" & Chr(0) & "*.*" & Chr(0)
  186.     Path = fGetOpenFileName(Filter)
  187.     If Path <> "Cancel" Then
  188.         Att = GetFileAttributes(Path)
  189.         If (Att And FILE_ATTRIBUTE_ARCHIVE) <> 0 Then Msg = Msg & "Archive" & vbCrLf
  190.         If (Att And FILE_ATTRIBUTE_COMPRESSED) <> 0 Then Msg = Msg & "Compressed" & vbCrLf
  191.         If (Att And FILE_ATTRIBUTE_DIRECTORY) <> 0 Then Msg = Msg & "Directory" & vbCrLf
  192.         If (Att And FILE_ATTRIBUTE_HIDDEN) <> 0 Then Msg = Msg & "Hidden" & vbCrLf
  193.         If (Att And FILE_ATTRIBUTE_NORMAL) <> 0 Then Msg = Msg & "Normal" & vbCrLf
  194.         If (Att And FILE_ATTRIBUTE_READONLY) <> 0 Then Msg = Msg & "Read only" & vbCrLf
  195.         If (Att And FILE_ATTRIBUTE_SYSTEM) <> 0 Then Msg = Msg & "System" & vbCrLf
  196.         MsgBox "The file attributes for " & Path & " are:" & vbCrLf & vbCrLf & Msg, vbOKOnly + vbInformation, "LearnAPI"
  197.     End If
  198.     Exit Sub
  199. OpenError:
  200.     MsgBox "Could not find file attributes.", vbOKOnly + vbExclamation, "LearnAPI"
  201. End Sub
  202. Private Sub cGetCursorPos()
  203. Dim v As POINTAPI, Success&
  204.     Success = GetCursorPos(v)
  205.     MsgBox "The mouse coordinates are: " & v.X & ", " & v.Y, vbOKOnly + vbInformation, "LearnAPI"
  206. End Sub
  207. Private Sub cFindExecutable()
  208. Dim OpenFile As OPENFILENAME
  209. Dim Success As Long, FileTitleLength%, Filter$
  210. Dim Result$, X&, DirLen#, FileLen#, Dir$
  211. On Error GoTo OpenError
  212.     'The following lines open the Open Dialog box using API calls
  213.     OpenFile.lStructSize = Len(OpenFile)
  214.     OpenFile.hwndOwner = frmMain.hwnd
  215.     OpenFile.hInstance = App.hInstance
  216.     Filter = "All Files (*.*)" & Chr(0) & "*.*" & Chr(0)
  217.     OpenFile.lpstrFilter = Filter
  218.     OpenFile.nFilterIndex = 1
  219.     OpenFile.lpstrFile = String(257, 0)
  220.     OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
  221.     OpenFile.lpstrFileTitle = OpenFile.lpstrFile
  222.     OpenFile.nMaxFileTitle = OpenFile.nMaxFile
  223.     OpenFile.lpstrTitle = "LearnAPI - Open Dialog Box"
  224.     OpenFile.flags = 0
  225.     Success = GetOpenFileName(OpenFile)
  226.     If Success = 0 Then
  227.         Exit Sub
  228.     Else:
  229. 'The next 4 lines remove null length strings.
  230. 'Trim does not work. Anyone got a better idea?
  231.         lblDiscription.ToolTipText = Trim(OpenFile.lpstrFile)
  232.         OpenFile.lpstrFile = lblDiscription.ToolTipText
  233.         lblDiscription.ToolTipText = Trim(OpenFile.lpstrFileTitle)
  234.         OpenFile.lpstrFileTitle = lblDiscription.ToolTipText
  235.         
  236. 'These lines find path without filetitle
  237.         FileLen = Len(OpenFile.lpstrFile)
  238.         DirLen = Len(OpenFile.lpstrFileTitle)
  239.         Dir = Left(OpenFile.lpstrFile, FileLen - DirLen - 1)
  240.         Result = Space(128)
  241.         
  242.         X = FindExecutable(OpenFile.lpstrFileTitle, Dir, Result)
  243.         If X < 32 Then GoTo OpenError
  244.         MsgBox "The application used to open " & OpenFile.lpstrFileTitle & " is " & vbCrLf & vbCrLf & Result, vbOKOnly + vbInformation, "LearnAPI"
  245.     End If
  246.     Exit Sub
  247. OpenError:
  248.     MsgBox "Could not find associated program file.", vbOKOnly + vbExclamation, "LearnAPI"
  249. End Sub
  250. Private Sub cGetTickCount()
  251. Dim MilloSec#, Days#, Hours#, Min#, Sec#
  252. Dim Msg$
  253.     MilloSec = GetTickCount()
  254.     Sec = MilloSec \ 1000
  255.     Days = Sec \ (24& * 3600&)
  256.     If Days > 0 Then Sec = Sec - (24 * 3600 * Days)
  257.     Hours = Sec \ 3600
  258.     If Hours > 0 Then Sec = Sec - (3600 * Hours)
  259.     Min = Sec \ 60
  260.     Sec = Sec Mod 60
  261.     Msg = "Windows has been running for" & vbCrLf & vbCrLf
  262.     Msg = Msg & Days & " Day(s), " & Hours & " Hour(s), " & Min & " Minute(s), " & Sec & " Second(s)"
  263.     MsgBox Msg, vbOKOnly + vbInformation, "LearnAPI"
  264. End Sub
  265. Private Sub cInternetAutodial()
  266. Dim Success&
  267.     Success = InternetAutodial(2, 0&)
  268. End Sub
  269. Private Sub cInternetAutodialHangup()
  270. Dim Success&
  271.     Success = InternetAutodialHangup(0&)
  272. End Sub
  273. Private Sub cGetLogicalDriveStrings()
  274. Dim Success&, D$, X&, Y&, Z&
  275. Dim DriveLetters As String * 256
  276. Dim Msg As String
  277.     DriveLetters = 255
  278.     Success = GetLogicalDriveStrings(255, DriveLetters)
  279. On Error GoTo ErrorHandler
  280.     Do
  281.         X = Y + 1
  282.         Z = Z + 1
  283.         Y = InStr(X, DriveLetters, "\")
  284.         D = Mid$(DriveLetters, Y - 2, 3)
  285.         Msg = Msg & D & " "
  286.     Loop Until Y = 0
  287. ErrorHandler:
  288. MsgBox "The drive letters available on this system are: " & vbCrLf & Msg, vbOKOnly + vbInformation, "LearnAPI"
  289. End Sub
  290. Private Sub cGetDriveType()
  291. Dim Drive$, DriveType$, X&
  292.     Drive = UCase(Left(App.Path, 3))
  293.     X = GetDriveType(Drive)
  294.     Select Case X
  295.         Case 2: DriveType = "removable drive."
  296.         Case 3: DriveType = "fixed drive."
  297.         Case 4: DriveType = "remote drive."
  298.         Case 5: DriveType = "CDROM drive."
  299.         Case 6: DriveType = "ramdisk."
  300.     End Select
  301.     MsgBox "Drive " & Drive & " is a " & DriveType, vbOKOnly + vbInformation, "LearnAPI"
  302. End Sub
  303. Private Sub cboAPIFunction_Click()
  304. Select Case cboAPIFunction.Text
  305.     Case "CharLower": lblDiscription.Caption = "Converts text to lowercase. Same as the Visual Basic LCase function."
  306.     Case "CharUpper": lblDiscription.Caption = "Converts text to uppercase. Same as the Visual Basic UCase function."
  307.     Case "ChooseColor": lblDiscription.Caption = "Display the Colour common dialog box using API calls."
  308.     Case "ExitWindowsEx": lblDiscription.Caption = "Exit Windows. Exit all applications and save your work before trying this command."
  309.     Case "FindExecutable": lblDiscription.Caption = "Find which application is associated with a file extension."
  310.     Case "FlashWindow": lblDiscription.Caption = "Makes the application title flash. Press Run to start and stop the flashing."
  311.     Case "GetComputerName": lblDiscription.Caption = "Displays the computer name."
  312.     Case "GetCursorPos": lblDiscription.Caption = "Finds the mouse coordinates."
  313.     Case "GetDiskFreeSpace": lblDiscription.Caption = "Returns the amount of free space available on the current drive."
  314.     Case "GetDoubleClickTime": lblDiscription.Caption = "The double-click time is the maximum number of milliseconds that may occur between the first and second click of a double-click. See also SetDoubleClickTime."
  315.     Case "GetDriveType": lblDiscription.Caption = "Returns the current drive type."
  316.     Case "GetFileAttributes": lblDiscription.Caption = "Displays the attributes of a file."
  317.     Case "GetLogicalDriveStrings": lblDiscription.Caption = "Returns the available drive letters of your computer."
  318.     Case "GetOpenFileName": lblDiscription.Caption = "Displays the Open Dialog Box using the Windows API."
  319.     Case "GetSystemDirectory": lblDiscription.Caption = "Returns the Windows System directory."
  320.     Case "GetSystemInfo": lblDiscription.Caption = "Displays the number of processors and the processor type."
  321.     Case "GetTempPath": lblDiscription.Caption = "Returns the path to the temporary directory."
  322.     Case "GetTickCount": lblDiscription.Caption = "Displays how long Windows has been running."
  323.     Case "GetUserName": lblDiscription.Caption = "Displays the user who is currently logged onto Windows."
  324.     Case "GetVersionEx": lblDiscription.Caption = "Returns the Windows version, build and service pack versions."
  325.     Case "GetVolumeInformation": lblDiscription.Caption = "Displays the volume information of the current drive."
  326.     Case "GetWindowsDirectory": lblDiscription.Caption = "Returns the path to the Windows directory."
  327.     Case "GlobalMemoryStatus": lblDiscription.Caption = "Displays the current memory status."
  328.     Case "IDECheck": lblDiscription.Caption = "This is not an API function, but I thought it could be useful. It tells you whether or not you are running within the Visual Basic IDE. You could disable shareware nag screens based on this result."
  329.     Case "InternetAutoDial": lblDiscription.Caption = "Automatically dial the Internet. Please note that this function requires Windows 95/98. If you are running Windows 95, you must have Internet Explorer 3.x or later installed."
  330.     Case "InternetAutoDialHangup": lblDiscription.Caption = "Hangup the Internet. Please note that this function requires Windows 95/98. If you are running Windows 95, you must have Internet Explorer 3.x or later installed."
  331.     Case "MessageBeep": lblDiscription.Caption = "Beep. Same as the Visual Basic beep command."
  332.     Case "PlaySound": lblDiscription.Caption = "Play a wav file."
  333.     Case "SetDoubleClickTime": lblDiscription.Caption = "The double-click time is the maximum number of milliseconds that may occur between the first and second clicks of a double-click. Default is 500. See also GetDoubleClickTime."
  334.     Case "SetWindowPos": lblDiscription.Caption = "Make LearnAPI stay on top of all other windows."
  335.     Case "Sleep": lblDiscription.Caption = "Create a delay with the Sleep command."
  336.     Case "SwapMouseButton": lblDiscription.Caption = "Swap the left and right mouse buttons."
  337.     Case "WinExec": lblDiscription.Caption = "Start Windows Explorer."
  338.     Case "-DelBinary": lblDiscription.Caption = "Del a binary value from the registry."
  339.     Case "-GetBinary": lblDiscription.Caption = "Retrieve a binary value from the registry."
  340.     Case "-SetBinary": lblDiscription.Caption = "Save a binary value to the registry."
  341. End Select
  342. End Sub
  343. Private Sub cmdRun_Click()
  344. Select Case cboAPIFunction.Text
  345.     Case "CharLower": Call cCharLower
  346.     Case "CharUpper": Call cCharUpper
  347.     Case "ChooseColor": Call cChooseColor
  348.     Case "ExitWindowsEx": Call cExitWindowsEx
  349.     Case "FindExecutable": Call cFindExecutable
  350.     Case "FlashWindow": Call cFlashWindow
  351.     Case "GetComputerName": Call cGetComputerName
  352.     Case "GetCursorPos": Call cGetCursorPos
  353.     Case "GetDiskFreeSpace": Call cGetDiskFreeSpace
  354.     Case "GetDoubleClickTime": Call cGetDoubleClickTime
  355.     Case "GetDriveType": Call cGetDriveType
  356.     Case "GetFileAttributes": Call cGetFileAttributes
  357.     Case "GetLogicalDriveStrings": Call cGetLogicalDriveStrings
  358.     Case "GetOpenFileName": Call cGetOpenFileName
  359.     Case "GetSystemDirectory": Call cGetSystemDirectory
  360.     Case "GetSystemInfo": Call cGetSystemInfo
  361.     Case "GetTempPath": Call cGetTempPath
  362.     Case "GetTickCount": Call cGetTickCount
  363.     Case "GetUserName": Call cGetUserName
  364.     Case "GetVersionEx": Call cGetVersionEx
  365.     Case "GetVolumeInformation": Call cGetVolumeInformation
  366.     Case "GetWindowsDirectory": Call cGetWindowsDirectory
  367.     Case "GlobalMemoryStatus": Call cGlobalMemoryStatus
  368.     Case "IDECheck": Call cIDECheck
  369.     Case "InternetAutoDial": Call cInternetAutodial
  370.     Case "InternetAutoDialHangup": Call cInternetAutodialHangup
  371.     Case "MessageBeep": Call cMessageBeep
  372.     Case "PlaySound": Call cPlaySound
  373.     Case "SetDoubleClickTime": Call cSetDoubleClickTime
  374.     Case "SetWindowPos": Call cSetWindowPos
  375.     Case "Sleep": Call cSleep
  376.     Case "SwapMouseButton": Call cSwapMouseButton
  377.     Case "WinExec": Call cWinExec
  378.     Case "-DelBinary": Call dfDelBinary
  379.     Case "-GetBinary": Call dfGetBinary
  380.     Case "-SetBinary": Call dfSetBinary
  381. End Select
  382. End Sub
  383. Private Function fGetOpenFileName(Filter As String)
  384. 'I have made this into a function so that I can use
  385. 'it from other functions.
  386. Dim OpenFile As OPENFILENAME, Temp$
  387. Dim Success As Long, FileTitleLength%
  388.     OpenFile.lStructSize = Len(OpenFile)
  389.     OpenFile.hwndOwner = frmMain.hwnd
  390.     OpenFile.hInstance = App.hInstance
  391.     OpenFile.lpstrFilter = Filter
  392.     OpenFile.nFilterIndex = 1
  393.     OpenFile.lpstrFile = String(257, 0)
  394.     OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
  395.     OpenFile.lpstrFileTitle = OpenFile.lpstrFile
  396.     OpenFile.nMaxFileTitle = OpenFile.nMaxFile
  397.     OpenFile.lpstrTitle = "LearnAPI - Open Dialog Box"
  398.     OpenFile.flags = 0
  399.     Success = GetOpenFileName(OpenFile)
  400.     If Success = 0 Then
  401.         fGetOpenFileName = "Cancel"
  402.     Else:
  403. 'The next two lines remove null length strings.
  404. 'Trim does not work. Anyone got a better idea?
  405.         lblDiscription.ToolTipText = Trim(OpenFile.lpstrFile)
  406.         fGetOpenFileName = lblDiscription.ToolTipText
  407.     End If
  408. End Function
  409. Private Function IDECheck() As Boolean
  410. 'Used in conjunction with cIDECheck
  411.     RunningInIDE = True
  412.     IDECheck = True
  413. End Function
  414. Private Sub cIDECheck()
  415. 'The following line is only executed when running
  416. 'under the VB IDE. Therefore RunningInIDE is
  417. 'always false when running from a exe program.
  418.     Debug.Assert IDECheck
  419.     If RunningInIDE = False Then
  420.         MsgBox "LearnAPI is not running within the Visual Basic IDE.", vbOKOnly + vbInformation, "LearnAPI"
  421.     ElseIf RunningInIDE = True Then
  422.         MsgBox "LearnAPI is running within the Visual Basic IDE.", vbOKOnly + vbInformation, "LearnAPI"
  423.     End If
  424. End Sub
  425. Private Sub cCharLower()
  426. Dim InputStr$
  427.     InputStr = InputBox("Please enter some text in both cases.", "LearnAPI", "Thank you for downloading LearnAPI.")
  428.     If InputStr = "" Then Exit Sub
  429.     InputStr = CharLower(InputStr)
  430.     MsgBox "The text you entered has been converted to lowercase:" & vbCrLf & vbCrLf & InputStr, vbOKOnly + vbInformation, "LearnAPI"
  431. End Sub
  432. Private Sub cCharUpper()
  433. Dim InputStr$
  434.     InputStr = InputBox("Please enter some text in both cases.", "LearnAPI", "Thank you for downloading LearnAPI.")
  435.     If InputStr = "" Then Exit Sub
  436.     InputStr = CharUpper(InputStr)
  437.     MsgBox "The text you entered has been converted to uppercase:" & vbCrLf & vbCrLf & InputStr, vbOKOnly + vbInformation, "LearnAPI"
  438. End Sub
  439. Private Sub Form_Load()
  440. ReDim CustomColors(0 To 16 * 4 - 1) As Byte
  441. Dim i As Integer
  442.     For i = LBound(CustomColors) To UBound(CustomColors)
  443.         CustomColors(i) = 0
  444.     Next i
  445.     cboAPIFunction.AddItem "CharLower"
  446.     cboAPIFunction.AddItem "CharUpper"
  447.     cboAPIFunction.AddItem "ChooseColor"
  448.     cboAPIFunction.AddItem "ExitWindowsEx"
  449.     cboAPIFunction.AddItem "FindExecutable"
  450.     cboAPIFunction.AddItem "FlashWindow"
  451.     cboAPIFunction.AddItem "GetComputerName"
  452.     cboAPIFunction.AddItem "GetCursorPos"
  453.     cboAPIFunction.AddItem "GetDiskFreeSpace"
  454.     cboAPIFunction.AddItem "GetDoubleClickTime"
  455.     cboAPIFunction.AddItem "GetDriveType"
  456.     cboAPIFunction.AddItem "GetFileAttributes"
  457.     cboAPIFunction.AddItem "GetLogicalDriveStrings"
  458.     cboAPIFunction.AddItem "GetOpenFileName"
  459.     cboAPIFunction.AddItem "GetSystemDirectory"
  460.     cboAPIFunction.AddItem "GetSystemInfo"
  461.     cboAPIFunction.AddItem "GetTempPath"
  462.     cboAPIFunction.AddItem "GetTickCount"
  463.     cboAPIFunction.AddItem "GetUserName"
  464.     cboAPIFunction.AddItem "GetVersionEx"
  465.     cboAPIFunction.AddItem "GetVolumeInformation"
  466.     cboAPIFunction.AddItem "GetWindowsDirectory"
  467.     cboAPIFunction.AddItem "GlobalMemoryStatus"
  468.     cboAPIFunction.AddItem "IDECheck"
  469.     cboAPIFunction.AddItem "InternetAutoDial"
  470.     cboAPIFunction.AddItem "InternetAutoDialHangup"
  471.     cboAPIFunction.AddItem "MessageBeep"
  472.     cboAPIFunction.AddItem "PlaySound"
  473.     cboAPIFunction.AddItem "SetDoubleClickTime"
  474.     cboAPIFunction.AddItem "SetWindowPos"
  475.     cboAPIFunction.AddItem "Sleep"
  476.     cboAPIFunction.AddItem "SwapMouseButton"
  477.     cboAPIFunction.AddItem "WinExec"
  478.     cboAPIFunction.AddItem "-DelBinary"
  479.     cboAPIFunction.AddItem "-GetBinary"
  480.     cboAPIFunction.AddItem "-SetBinary"
  481.     cboAPIFunction.ListIndex = 0
  482. End Sub
  483. Private Sub cChooseColor()
  484. 'To hold the custom colours, also use the code in the
  485. 'Form_Load procedure and in the General Declaration section.
  486. Dim cc As CHOOSECOLOR
  487. Dim Custcolor(16) As Long
  488. Dim lReturn As Long
  489.     cc.lStructSize = Len(cc)
  490.     cc.hwndOwner = frmMain.hwnd
  491.     cc.hInstance = App.hInstance
  492.     cc.lpCustColors = StrConv(CustomColors, vbUnicode)
  493.     cc.flags = 0
  494.     lReturn = CHOOSECOLOR(cc)
  495.     If lReturn <> 0 Then
  496.         frmMain.BackColor = Str$(cc.rgbResult)
  497.         CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
  498.     Else
  499.         Exit Sub
  500.     End If
  501. End Sub
  502. Private Sub cSleep()
  503.     MsgBox "The next msgbox will appear in 2 seconds.", vbOKOnly + vbInformation, "LearnAPI"
  504.     Sleep 2000
  505.     MsgBox "The sleep function can be used as a delay command.", vbOKOnly + vbInformation, "LearnAPI"
  506. End Sub
  507. Private Sub dfDelBinary()
  508. Dim Result
  509.     Result = MsgBox("Are you sure you want to delete: HKEY_CURRENT_USER\Software\Longonot Software\BinaryValue?", vbYesNo + vbInformation, "LearnAPI - Code provided by Danny Falkov")
  510.     If Result = vbYes Then
  511.         delsetting HKEY_CURRENT_USER, "Software\Longonot Software", "BinaryValue"
  512.     End If
  513. End Sub
  514. Private Sub dfGetBinary()
  515. Dim Value
  516.     Value = getstring(HKEY_CURRENT_USER, "Software\Longonot Software", "BinaryValue")
  517.     If Value = "" Then Value = "No value found!"
  518.     MsgBox Value, vbOKOnly + vbInformation, "LearnAPI - Code provided by Danny Falkov"
  519. End Sub
  520. Private Sub dfSetBinary()
  521. Dim Value$
  522.     Value = InputBox("Please enter a value between 0 and 255 to be saved as a binary value in the registry. The value will be stored in the following key: HKEY_CURRENT_USER\Software\Longonot Software\BinaryValue", "LearnAPI - Code provided by Danny Falkov")
  523. On Error GoTo ErrorHandler
  524.     If Value = "" Then
  525.         Exit Sub
  526.     ElseIf Value > 255 Then
  527.         GoTo ErrorHandler
  528.     End If
  529.     Value = CByte(Value)
  530.     Call savestringlong(HKEY_CURRENT_USER, "Software\Longonot Software", "BinaryValue", Value)
  531.     Exit Sub
  532. ErrorHandler:
  533.     MsgBox "Invalid Value"
  534. End Sub
  535. Private Sub cSwapMouseButton()
  536. Dim CurrStat&, Tmp&
  537.     CurrStat = SwapMouseButton(Tmp)
  538.     If CurrStat = 0 Then
  539.         SwapMouseButton (1)
  540.     Else: SwapMouseButton (0)
  541.     End If
  542.     MsgBox "The mouse buttons have been swapped. This will effect all users that use this computer!", vbOKOnly + vbInformation, "LearnAPI"
  543. End Sub
  544. Private Sub cGetVolumeInformation()
  545. Dim Driv$, Volume$, VolumeNameSize&, SerialNumber&, lpMaximumComponentLength&
  546. Dim lpFileSystemFlags&, lpFileSystemNameBuffer$, nFileSystemNameSize&
  547. Dim Volumenumber$, X As Boolean
  548.     Driv = UCase(Left(App.Path, 3))
  549.     X = GetVolumeInformation(Driv, Volume, VolumeNameSize, SerialNumber, lpMaximumComponentLength, lpFileSystemFlags, lpFileSystemNameBuffer, nFileSystemNameSize)
  550.          
  551.     Volume = UCase(Dir(Driv, vbVolume))
  552.     Volumenumber = Hex(SerialNumber)
  553.     MsgBox "Current Drive: " & Driv & vbCrLf & "Volume Name: " & Volume & vbCrLf & "Volume Serial Number: " & Volumenumber, vbOKOnly + vbInformation, "LearnAPI - Code provided by Charles Bronner"
  554. End Sub
  555. Private Sub cMessageBeep()
  556. Dim Success&
  557.     Success = MessageBeep(1)
  558. End Sub
  559. Private Sub cGlobalMemoryStatus()
  560. Dim v As MEMORYSTATUS, PhyMem$, AvailMem$, VirMem$, AvailVirMem$
  561. Dim PagMem$, AvailPagMem$, LoadMem$, Info$
  562.     v.dwLength = Len(v)
  563.     GlobalMemoryStatus v
  564.     PhyMem = v.dwTotalPhys: AvailMem = v.dwAvailPhys
  565.     VirMem = v.dwTotalVirtual: AvailVirMem = v.dwAvailVirtual
  566.     PagMem = v.dwTotalPageFile: AvailPagMem = v.dwAvailPageFile
  567.     LoadMem = v.dwMemoryLoad
  568.     Info = Info & "Total Physical Memory: "
  569.     Info = Info & Format$(PhyMem \ 1024, "###,###,###") & "K" & vbCrLf
  570.     Info = Info & "Available Physical Memory: "
  571.     Info = Info & Format$(AvailMem \ 1024, "###,###,###") & "K" & vbCrLf
  572.     Info = Info & "Percentage of Memory in use: " & LoadMem & "%" & vbCrLf
  573.     Info = Info & "Maximum Paging File Size: "
  574.     Info = Info & Format$(PagMem \ 1024, "###,###,###") & "K" & vbCrLf
  575.     Info = Info & "Kilobytes Avaiable in Paging File: "
  576.     Info = Info & Format$(AvailPagMem \ 1024, "###,###,###") & "K" & vbCrLf
  577.         
  578.     Info = Info & "Total Virtual Memory: "
  579.     Info = Info & Format$(VirMem \ 1024, "###,###,###") & "K" & vbCrLf
  580.     Info = Info & "Available Virtual Memory: "
  581.     Info = Info & Format$(AvailVirMem \ 1024, "###,###,###") & "K" & vbCrLf & vbCrLf
  582.     MsgBox Info, vbOKOnly + vbInformation
  583. End Sub
  584. Private Sub cGetSystemInfo()
  585. Dim v As SYSTEM_INFO, Info$
  586. Dim NoOfProcessors$, ProcessorType$, PageSize$
  587.     GetSystemInfo v
  588.     NoOfProcessors = v.dwNumberOrfProcessors
  589.     ProcessorType = v.dwProcessorType
  590.     Select Case ProcessorType
  591.         Case PROCESSOR_INTEL_386
  592.             Info = Info & "Intel 386" & vbCrLf
  593.         Case PROCESSOR_INTEL_486
  594.             Info = Info & "Intel 486" & vbCrLf
  595.         Case PROCESSOR_INTEL_PENTIUM
  596.             Info = Info & "Intel Pentium" & vbCrLf
  597.         Case PROCESSOR_MIPS_R4000
  598.             Info = Info & "MIPS R4000" & vbCrLf
  599.         Case PROCESSOR_ALPHA_21064
  600.             Info = Info & "DEC Alpha 21064" & vbCrLf
  601.         Case Else
  602.             Info = Info & "(unknown)" & vbCrLf
  603.     End Select
  604.         
  605.     MsgBox "No of Processors: " & NoOfProcessors & vbCrLf & "Processor Type: " & Info, vbOKOnly + vbInformation
  606. End Sub
  607. Private Sub cGetTempPath()
  608. Dim Success&, TempDir$
  609.     TempDir = Space(255)
  610.     Success = GetTempPath(255, TempDir)
  611.     MsgBox "The temporary directory is: " & Trim(TempDir), vbOKOnly + vbInformation
  612. End Sub
  613. Private Sub cGetDiskFreeSpace()
  614. Dim SectorsPerCluster&, BytesPerSector&, FreeClusters&
  615. Dim TotalClusters&, FreeSpace$, Success As Boolean, Drive$
  616.     Drive = UCase(Left(App.Path, 3))
  617.     Success = GetDiskFreeSpace(Drive, SectorsPerCluster, BytesPerSector, FreeClusters, TotalClusters)
  618.     FreeSpace = SectorsPerCluster * BytesPerSector * FreeClusters
  619.     FreeSpace = (FreeSpace \ 1024) \ 1024
  620.     MsgBox "The free space on drive " & Drive & " is " & Str$(FreeSpace) & " MB", vbOKOnly + vbInformation
  621. End Sub
  622. Private Sub lblCredits_Click()
  623.     frmAbout.Show (1)
  624. End Sub
  625. Private Sub cExitWindowsEx()
  626.     Dim Result, Success
  627.     Result = MsgBox("Are you sure you want to exit Windows?", vbYesNo) 'Confirm Exit
  628.     If Result = vbYes Then
  629.         'EWX_SHUTDOWN must be 1 for API function to shutdown Windows
  630.         Success = ExitWindowsEx(EWX_SHUTDOWN, 0)
  631.     End If
  632. End Sub
  633. Private Sub cFlashWindow()
  634. Static Invert As Boolean
  635.     If Invert = False Then
  636.         tmrFlashWindow.Enabled = True
  637.         Invert = True
  638.     Else
  639.         FlashWindow frmMain.hwnd, False
  640.         tmrFlashWindow.Enabled = False
  641.         Invert = False
  642.     End If
  643. End Sub
  644. Private Sub lblDiscription_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  645.     lblDiscription.ToolTipText = ""
  646. End Sub
  647. Private Sub lblMailto_Click()
  648. Dim Success&
  649.     Success = ShellExecute(Me.hwnd, vbNullString, "mailto:longonot@intekom.co.za", vbNullString, "C:\", SW_SHOWNORMAL)
  650. End Sub
  651. Private Sub lblExit_Click()
  652.     End
  653. End Sub
  654. Private Sub cWinExec()
  655. Dim Success&
  656.     Success = WinExec("Explorer.exe", 10)
  657. End Sub
  658. Private Sub cGetComputerName()
  659. Dim PCName$, Success&
  660.     PCName = Space(100)
  661.     Success = GetComputerName(PCName, 100)
  662.     MsgBox "The computer name is: " & Trim(PCName), vbOKOnly + vbInformation, "LearnAPI"
  663. End Sub
  664. Private Sub cPlaySound()
  665. Dim Path$, Filter$
  666. On Error GoTo OpenError
  667.     Filter = "Wav Files (*.wav)" & Chr(0) & "*.wav" & Chr(0)
  668.     Path = fGetOpenFileName(Filter)
  669.     If Path <> "Cancel" Then
  670.         PlaySound Path, 0, SND_ASYNC
  671.     End If
  672. OpenError:
  673. End Sub
  674. Private Sub cGetSystemDirectory()
  675. Dim Success&, WinSysDir$
  676.     WinSysDir = Space(144)
  677.     Success = GetSystemDirectory(WinSysDir, 144)
  678.     WinSysDir = Trim(WinSysDir)
  679.     MsgBox "The Windows Directory is: " & WinSysDir, vbOKOnly + vbInformation 'Display result
  680. End Sub
  681. Private Sub lblURL_Click()
  682. Dim Success&
  683.     Success = ShellExecute(Me.hwnd, vbNullString, "http://home.intekom.com/longonot", vbNullString, "C:\", SW_SHOWNORMAL)
  684. End Sub
  685. Private Sub cGetUserName()
  686. Dim Dummy$, Success&
  687.     Dummy = Space(100)
  688.     Success = GetUserName(Dummy, 100)
  689.     MsgBox "You are logged on as: " & Trim(Dummy), vbOKOnly + vbInformation, "LearnAPI"
  690. End Sub
  691. Private Sub cGetVersionEx()
  692. Dim v As OSVERSIONINFO, Success&, Junk$, Dummy$
  693.     Dim WindowsVersion$, BuildVersion$, SP$, SPL$, PlatformName$
  694.     v.dwOSVersionInfoSize = Len(v)
  695.     Success = GetVersionEx(v)
  696.     WindowsVersion = v.dwMajorVersion & "." & v.dwMinorVersion
  697.     BuildVersion = v.dwBuildNumber And &HFFFF&
  698.     SP = v.szCSDVersion
  699.     Select Case v.dwPlatformId
  700.     Case VER_PLATFORM_WIN32_WINDOWS
  701.         'If v.dwMinorVersion = 0 then Windows 95
  702.         'If v.dwMinorVersion = 10 then Windows 98
  703.         If v.dwMinorVersion = 0 Then
  704.             PlatformName = "Windows 95"
  705.         ElseIf v.dwMinorVersion = 10 Then
  706.             PlatformName = "Windows 98"
  707.         End If
  708.         lblDiscription.ToolTipText = ""
  709.         lblDiscription.ToolTipText = SP
  710.         If Trim(lblDiscription.ToolTipText) = "" Then
  711.             MsgBox PlatformName & " Version " & WindowsVersion & ", Build " & BuildVersion, vbOKOnly + vbInformation, "LearnAPI"
  712.         Else
  713.             MsgBox PlatformName & " Version " & WindowsVersion & ", Build " & BuildVersion & ", Service Pack " & SP, vbOKOnly + vbInformation, "LearnAPI"
  714.         End If
  715.      Case VER_PLATFORM_WIN32_NT
  716.         PlatformName = "Windows NT"
  717.         SPL = Mid(SP, 1, 12)
  718.         If SPL = "Service Pack" Then
  719.             MsgBox PlatformName & " Version " & WindowsVersion & ", Build " & BuildVersion & ", " & SP, vbOKOnly + vbInformation, "LearnAPI"
  720.         Else
  721.             MsgBox PlatformName & " Version " & WindowsVersion & ", Build " & BuildVersion, vbOKOnly + vbInformation, "LearnAPI"
  722.         End If
  723.      End Select
  724. End Sub
  725. Private Sub cGetWindowsDirectory()
  726. Dim Success&, WinDir$
  727.     WinDir = Space(144)
  728.     Success = GetWindowsDirectory(WinDir, 144)
  729.     WinDir = Trim(WinDir)
  730.     MsgBox "The Windows Directory is: " & WinDir, vbOKOnly + vbInformation 'Display result
  731. End Sub
  732. Private Sub tmrFlashWindow_Timer()
  733.     FlashWindow frmMain.hwnd, True
  734. End Sub
  735. Private Sub cGetDoubleClickTime()
  736. Dim Result$
  737.     Result = GetDoubleClickTime
  738.     MsgBox "The double-click time is: " & Result & " milliseconds.", vbOKOnly + vbInformation, "LearnAPI"
  739. End Sub
  740. Private Sub cSetDoubleClickTime()
  741. Dim InputStr$, InputNum&
  742.     InputStr = InputBox("Please enter a value for the double-click time. The default is 500. Setting this value to low will prevent users being able to double click fast enough!", "LearnAPI", "500")
  743.     If InputStr = "" Then Exit Sub
  744. 'The next line converts string to a long
  745. 'If the string is not a number, InputNum = 0
  746. 'InputNum must be > 0 to set double-click time
  747.     InputNum = Val(InputStr)
  748.     SetDoubleClickTime (InputNum)
  749.     MsgBox "The double-click time has been changed. Use the GetDoubleClickTime function to view your change.", vbOKOnly + vbInformation, "LearnAPI"
  750. End Sub
  751.