home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / VISUAL_B / FERRAMEN / VB_ASM / SNOOPER.ZIP / SNOOPER.BAS < prev    next >
Encoding:
BASIC Source File  |  1994-06-19  |  34.9 KB  |  830 lines
  1. Option Explicit
  2.  
  3. '---------------------------------------------------------------'
  4. ' VB-ASM, Version 1.00                                          '
  5. ' Copyright (c) 1994 SoftCircuits Programming                   '
  6. ' Redistributed by Permission.                                  '
  7. '                                                               '
  8. ' SoftCircuits Programming                                      '
  9. ' P.O. Box 16262                                                '
  10. ' Irvine, CA 92713                                              '
  11. ' CompuServe: 72134,263                                         '
  12. '                                                               '
  13. ' This program may be used and distributed freely on the        '
  14. ' condition that it is distributed in full and unchanged, and   '
  15. ' that no fee is charged for such use and distribution with the '
  16. ' exception or reasonable media and shipping charges.           '
  17. '                                                               '
  18. ' You may also incorporate any or all portions of this program, '
  19. ' and/or include the VB-ASM DLL, as part of your own programs   '
  20. ' and distribute such programs without payment of royalties on  '
  21. ' the condition that such program do not duplicate the overall  '
  22. ' functionality of VB-ASM and/or any of its demo programs, and  '
  23. ' that you agree to the following disclaimer.                   '
  24. '                                                               '
  25. ' WARNING: Accessing the low-level services of Windows, DOS and '
  26. ' the ROM-BIOS using VB-ASM is an extremely powerful technique  '
  27. ' that, if used incorrectly, can cause possible permanent       '
  28. ' damage and/or loss of data. You are responsible for           '
  29. ' determining appropriate use of any and all files included in  '
  30. ' this package. SoftCircuits will not be held liable for any    '
  31. ' damages resulting from the use of these files.                '
  32. '                                                               '
  33. ' SOFTCIRCUITS SPECIFICALLY DISCLAIMS ALL WARRANTIES,           '
  34. ' INCLUDING, WITHOUT LIMITATION, ALL IMPLIED WARRANTIES OF      '
  35. ' MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND        '
  36. ' NON-INFRINGEMENT OF THIRD PARTY RIGHTS.                       '
  37. '                                                               '
  38. ' UNDER NO CIRCUMSTANCES WILL SOFTCIRCUITS BE LIABLE FOR        '
  39. ' SPECIAL, INCIDENTAL, CONSEQUENTIAL, INDIRECT, OR ANY OTHER    '
  40. ' DAMAGES OR CLAIMS ARISING FROM THE USE OF THIS PRODUCT,       '
  41. ' INCLUDING LOSS OF PROFITS OR ANY OTHER COMMERCIAL DAMAGES,    '
  42. ' EVEN IF WE HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH       '
  43. ' DAMAGES.                                                      '
  44. '                                                               '
  45. ' Please contact SoftCircuits Programming if you have any       '
  46. ' questions concerning these conditions.                        '
  47. '                                                               '
  48. ' This demo program shows how to determine various system       '
  49. ' information. Many of the items detected do not require        '
  50. ' VB-ASM so this program serves as a general-purpose demo       '
  51. ' program.                                                      '
  52. '---------------------------------------------------------------'
  53.  
  54. 'VB-ASM DLL declarations
  55. Type REGS
  56.     AX As Integer
  57.     BX As Integer
  58.     CX As Integer
  59.     DX As Integer
  60.     BP As Integer
  61.     SI As Integer
  62.     DI As Integer
  63.     Flags As Integer
  64.     DS As Integer
  65.     ES As Integer
  66. End Type
  67.  
  68. 'REGS Flags bit values
  69. Global Const FLAGS_CARRY = &H1
  70. Global Const FLAGS_PARITY = &H4
  71. Global Const FLAGS_AUX = &H10
  72. Global Const FLAGS_ZERO = &H40
  73. Global Const FLAGS_SIGN = &H80
  74.  
  75. Declare Function vbGetCtrlModel Lib "VBASM.DLL" (ByVal Ctrl As Long) As Long
  76. Declare Sub vbGetData Lib "VBASM.DLL" (ByVal Pointer As Long, Variable As Any, ByVal nCount As Integer)
  77. Declare Function vbGetLongPtr Lib "VBASM.DLL" (nVariable As Any) As Long
  78. Declare Function vbHiByte Lib "VBASM.DLL" (ByVal nValue As Integer) As Integer
  79. Declare Function vbHiWord Lib "VBASM.DLL" (ByVal nValue As Long) As Integer
  80. Declare Function vbInp Lib "VBASM.DLL" (ByVal nPort As Integer) As Integer
  81. Declare Function vbInpw Lib "VBASM.DLL" (ByVal nPort As Integer) As Integer
  82. Declare Sub vbInterrupt Lib "VBASM.DLL" (ByVal IntNum As Integer, InRegs As REGS, OutRegs As REGS)
  83. Declare Sub vbInterruptX Lib "VBASM.DLL" (ByVal IntNum As Integer, InRegs As REGS, OutRegs As REGS)
  84. Declare Function vbLoByte Lib "VBASM.DLL" (ByVal nValue As Integer) As Integer
  85. Declare Function vbLoWord Lib "VBASM.DLL" (ByVal nValue As Long) As Integer
  86. Declare Function vbMakeLong Lib "VBASM.DLL" (ByVal nLoWord As Integer, ByVal nHiWord As Integer) As Long
  87. Declare Function vbMakeWord Lib "VBASM.DLL" (ByVal nLoByte As Integer, ByVal nHiByte As Integer) As Integer
  88. Declare Sub vbOut Lib "VBASM.DLL" (ByVal nPort As Integer, ByVal nData As Integer)
  89. Declare Sub vbOutw Lib "VBASM.DLL" (ByVal nPort As Integer, ByVal nData As Integer)
  90. Declare Function vbPeek Lib "VBASM.DLL" (ByVal nSegment As Integer, ByVal nOffset As Integer) As Integer
  91. Declare Function vbPeekw Lib "VBASM.DLL" (ByVal nSegment As Integer, ByVal nOffset As Integer) As Integer
  92. Declare Sub vbPoke Lib "VBASM.DLL" (ByVal nSegment As Integer, ByVal nOffset As Integer, ByVal nValue As Integer)
  93. Declare Sub vbPokew Lib "VBASM.DLL" (ByVal nSegment As Integer, ByVal nOffset As Integer, ByVal nValue As Integer)
  94. Declare Function vbRealModeIntX Lib "VBASM.DLL" (ByVal IntNum As Integer, InRegs As REGS, OutRegs As REGS) As Integer
  95. Declare Function vbRecreateCtrl Lib "VBASM.DLL" (ByVal Ctrl As Long) As Integer
  96. Declare Function vbSAdd Lib "VBASM.DLL" (Variable As String) As Integer
  97. Declare Sub vbSetData Lib "VBASM.DLL" (ByVal Pointer As Long, Variable As Any, ByVal nCount As Integer)
  98. Declare Function vbShiftLeft Lib "VBASM.DLL" (ByVal nValue As Integer, ByVal nBits As Integer) As Integer
  99. Declare Function vbShiftRight Lib "VBASM.DLL" (ByVal nValue As Integer, ByVal nBits As Integer) As Integer
  100. Declare Function vbSSeg Lib "VBASM.DLL" (Variable As String) As Integer
  101. Declare Function vbVarPtr Lib "VBASM.DLL" (Variable As Any) As Integer
  102. Declare Function vbVarSeg Lib "VBASM.DLL" (Variable As Any) As Integer
  103.  
  104.  
  105. 'Windows declarations
  106. Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
  107. Declare Function GetVersion Lib "Kernel" () As Long
  108. Declare Function GetWinFlags Lib "Kernel" () As Long
  109. Declare Function GetDeviceCaps Lib "GDI" (ByVal hDC As Integer, ByVal nIndex As Integer) As Integer
  110. Declare Function GetDriveType Lib "Kernel" (ByVal nDrive As Integer) As Integer
  111. Declare Function GetFreeSystemResources Lib "User" (ByVal fuSysResource As Integer) As Integer
  112. Declare Function GetWindowsDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  113. Declare Function GetSystemDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  114. Declare Function GetFreeSpace Lib "Kernel" (ByVal wFlags As Integer) As Long
  115. Declare Function GlobalCompact Lib "Kernel" (ByVal dwMinFree As Long) As Long
  116. Declare Function GetKeyboardType Lib "Keyboard" (ByVal nTypeFlag As Integer) As Integer
  117. Declare Function GetCaretBlinkTime Lib "User" () As Integer
  118. Declare Function GetSysColor Lib "User" (ByVal nIndex As Integer) As Long
  119. Declare Function GetTimerResolution Lib "User" () As Long
  120. Declare Function SystemParametersInfo Lib "User" (ByVal uAction As Integer, ByVal uParam As Integer, ByVal lpvParam As Long, ByVal fuWinIni As Integer) As Integer
  121. Declare Function GetSystemMetrics Lib "User" (ByVal nIndex As Integer) As Integer
  122. Declare Function SetCapture Lib "User" (ByVal hWnd As Integer) As Integer
  123. Declare Sub ReleaseCapture Lib "User" ()
  124. Declare Function WindowFromPoint Lib "User" (ByVal ptScreen As Any) As Integer
  125. Declare Function GetMessagePos Lib "User" () As Long
  126. Declare Function GetWindowText Lib "User" (ByVal hWnd As Integer, ByVal lpString As String, ByVal aint As Integer) As Integer
  127. Declare Function GetClassName Lib "User" (ByVal hWnd As Integer, ByVal lpClassName As String, ByVal nMaxCount As Integer) As Integer
  128. Declare Function GetParent Lib "User" (ByVal hWnd As Integer) As Integer
  129. Declare Function GetWindowLong Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer) As Long
  130.  
  131. Global Const WM_USER = &H400
  132. Global Const EM_SETREADONLY = (WM_USER + 31)
  133.  
  134. Global Const WF_ENHANCED = &H20
  135. Global Const WF_CPU286 = &H2
  136. Global Const WF_CPU386 = &H4
  137. Global Const WF_CPU486 = &H8
  138. Global Const WF_80x87 = &H400
  139.  
  140. Global Const GFSR_SYSTEMRESOURCES = &H0
  141. Global Const GFSR_GDIRESOURCES = &H1
  142. Global Const GFSR_USERRESOURCES = &H2
  143.  
  144. Global Const GWL_STYLE = (-16)
  145. Global Const GWL_EXSTYLE = (-20)
  146.  
  147. Global Const LF_FACESIZE = 32
  148.  
  149. Type LOGFONT
  150.     lfHeight As Integer
  151.     lfWidth As Integer
  152.     lfEscapement As Integer
  153.     lfOrientation As Integer
  154.     lfWeight As Integer
  155.     lfItalic As String * 1
  156.     lfUnderline As String * 1
  157.     lfStrikeOut As String * 1
  158.     lfCharSet As String * 1
  159.     lfOutPrecision As String * 1
  160.     lfClipPrecision As String * 1
  161.     lfQuality As String * 1
  162.     lfPitchAndFamily As String * 1
  163.     lfFaceName As String * LF_FACESIZE
  164. End Type
  165.  
  166. 'Visual Basic-specific declarations
  167. Global Const ATTR_VOLUME = &H8
  168.  
  169. 'Application-specific declarations
  170. Global Const CATEGORY_WINDOWSINFO = 0
  171. Global Const CATEGORY_DOSINFO = 1
  172. Global Const CATEGORY_HARDWAREINFO = 2
  173. Global Const CATEGORY_DISPLAYINFO = 3
  174. Global Const CATEGORY_PRINTERINFO = 4
  175. Global Const CATEGORY_DRIVESINFO = 5
  176. Global Const CATEGORY_INTVECTORS = 6
  177. Global Const CATEGORY_AUTOEXECBAT = 7
  178. Global Const CATEGORY_CONFIGSYS = 8
  179. Global Const CATEGORY_WININI = 9
  180.  
  181. Global newLine As String
  182.  
  183. Function GetColorString (color As Long) As String
  184.     Dim buffer As String
  185.  
  186.     'Create string to show individual color components
  187.     buffer = "Red=" & CStr(color And &HFF)
  188.     buffer = buffer & ", Green=" & CStr((color And &HFF00&) / &H100)
  189.     buffer = buffer & ", Blue=" & CStr((color And &HFF0000) / &H10000)
  190.     GetColorString = buffer
  191.  
  192. End Function
  193.  
  194. Function GetDeviceInfo (hDC As Integer) As String
  195. 'Returns a string with detailed information about the given device context
  196.     Dim buffer As String, i As Long
  197.  
  198.     'Device technology
  199.     buffer = buffer & "Device Technology: "
  200.     Select Case GetDeviceCaps(hDC, 2)
  201.     Case 0
  202.         buffer = buffer & "Vector Plotter"
  203.     Case 1
  204.         buffer = buffer & "Raster Display"
  205.     Case 2
  206.         buffer = buffer & "Raster Printer"
  207.     Case 3
  208.         buffer = buffer & "Raster Camera"
  209.     Case 4
  210.         buffer = buffer & "Character Stream"
  211.     Case 5
  212.         buffer = buffer & "Metafile"
  213.     Case 6
  214.         buffer = buffer & "Display File"
  215.     Case 7
  216.         buffer = buffer & "Unknown"
  217.     End Select
  218.     buffer = buffer & newLine
  219.  
  220.     'Measurements
  221.     buffer = buffer & "Width in Millimeters: " & CStr(GetDeviceCaps(hDC, 4)) & newLine
  222.     buffer = buffer & "Height in Millimeters: " & CStr(GetDeviceCaps(hDC, 6)) & newLine
  223.     buffer = buffer & "Width in Pixels: " & CStr(GetDeviceCaps(hDC, 8)) & newLine
  224.     buffer = buffer & "Height in Pixels: " & CStr(GetDeviceCaps(hDC, 10)) & newLine
  225.     buffer = buffer & "Pixels Per Inch X: " & CStr(GetDeviceCaps(hDC, 88)) & newLine
  226.     buffer = buffer & "Pixels Per Inch Y: " & CStr(GetDeviceCaps(hDC, 90)) & newLine
  227.  
  228.     'Capabilities
  229.     buffer = buffer & "Number of Bits Per Pixel: " & CStr(GetDeviceCaps(hDC, 12)) & newLine
  230.     buffer = buffer & "Number of Color Planes: " & CStr(GetDeviceCaps(hDC, 14)) & newLine
  231.     buffer = buffer & "Number of Brushes: " & CStr(GetDeviceCaps(hDC, 16)) & newLine
  232.     buffer = buffer & "Number of Pens: " & CStr(GetDeviceCaps(hDC, 18)) & newLine
  233.     buffer = buffer & "Number of Markers: " & CStr(GetDeviceCaps(hDC, 20)) & newLine
  234.     buffer = buffer & "Number of Fonts: " & CStr(GetDeviceCaps(hDC, 22)) & newLine
  235.     buffer = buffer & "Number of Entries in Color Table: " & CStr(GetDeviceCaps(hDC, 24)) & newLine
  236.  
  237.     'Aspect
  238.     buffer = buffer & "Relative Pixel Width: " & CStr(GetDeviceCaps(hDC, 40)) & newLine
  239.     buffer = buffer & "Relative Pixel Height: " & CStr(GetDeviceCaps(hDC, 42)) & newLine
  240.     buffer = buffer & "Diagonal Pixel Width: " & CStr(GetDeviceCaps(hDC, 44)) & newLine
  241.  
  242.     'Clipping capabilities
  243.     buffer = buffer & "Clipping Capabilities: "
  244.     Select Case GetDeviceCaps(hDC, 36)
  245.     Case 0
  246.         buffer = buffer & "None"
  247.     Case 1
  248.         buffer = buffer & "Rectangle"
  249.     Case 2
  250.         buffer = buffer & "Region"
  251.     Case Else
  252.         buffer = buffer & "Unknown"
  253.     End Select
  254.     buffer = buffer & newLine & newLine
  255.  
  256.     'Raster Capabilites
  257.     i = GetDeviceCaps(hDC, 38)
  258.     buffer = buffer & "Raster Capabilities:" & newLine
  259.     buffer = buffer & "Banding: " & GetYesNo(i And &H2) & newLine
  260.     buffer = buffer & "Fonts > 64K: " & GetYesNo(i And &H400) & newLine
  261.     buffer = buffer & "Bitmaps: " & GetYesNo(i And &H1) & newLine
  262.     buffer = buffer & "Bitmaps > 64K: " & GetYesNo(i And &H8) & newLine
  263.     buffer = buffer & "Device Bitmaps: " & GetYesNo(i And &H8000) & newLine
  264.     buffer = buffer & "Supports SetDIBits() & GetDIBits(): " & GetYesNo(i And &H80) & newLine
  265.     buffer = buffer & "Supports SetDIBitsToDevice(): " & GetYesNo(i And &H200) & newLine
  266.     buffer = buffer & "Performs Flood Fills: " & GetYesNo(i And &H1000) & newLine
  267.     buffer = buffer & "Dev Opaque and DX Array: " & GetYesNo(i And &H4000) & newLine
  268.     buffer = buffer & "Palette-Based Device: " & GetYesNo(i And &H100) & newLine
  269.     buffer = buffer & "Saves Bitmaps Locally: " & GetYesNo(i And &H40) & newLine
  270.     buffer = buffer & "Scaling: " & GetYesNo(i And &H4) & newLine
  271.     buffer = buffer & "Supports StretchBlt(): " & GetYesNo(i And &H800) & newLine
  272.     buffer = buffer & "Supports StretchDIBits(): " & GetYesNo(i And &H2000) & newLine
  273.     buffer = buffer & newLine
  274.     'Curve Capabilites
  275.     i = GetDeviceCaps(hDC, 28)
  276.     buffer = buffer & "Curve Capabilities:" & newLine
  277.     buffer = buffer & "Circles: " & GetYesNo(i And &H1) & newLine
  278.     buffer = buffer & "Pie Wedges: " & GetYesNo(i And &H2) & newLine
  279.     buffer = buffer & "Chords: " & GetYesNo(i And &H4) & newLine
  280.     buffer = buffer & "Ellipses: " & GetYesNo(i And &H8) & newLine
  281.     buffer = buffer & "Wide Borders: " & GetYesNo(i And &H10) & newLine
  282.     buffer = buffer & "Styled Borders: " & GetYesNo(i And &H20) & newLine
  283.     buffer = buffer & "Wide, Styled Borders: " & GetYesNo(i And &H40) & newLine
  284.     buffer = buffer & "Interiors: " & GetYesNo(i And &H80) & newLine
  285.     buffer = buffer & "Rectangles with Rounded Corners: " & GetYesNo(i And &H100) & newLine
  286.     buffer = buffer & newLine
  287.  
  288.     'Line Capabilites
  289.     i = GetDeviceCaps(hDC, 30)
  290.     buffer = buffer & "Line Capabilities:" & newLine
  291.     buffer = buffer & "Polylines: " & GetYesNo(i And &H2) & newLine
  292.     buffer = buffer & "Markers: " & GetYesNo(i And &H4) & newLine
  293.     buffer = buffer & "Polymarkers: " & GetYesNo(i And &H8) & newLine
  294.     buffer = buffer & "Wide Lines: " & GetYesNo(i And &H10) & newLine
  295.     buffer = buffer & "Styled Lines: " & GetYesNo(i And &H20) & newLine
  296.     buffer = buffer & "Wide, Styled Lines: " & GetYesNo(i And &H40) & newLine
  297.     buffer = buffer & "Interiors: " & GetYesNo(i And &H80) & newLine
  298.     buffer = buffer & newLine
  299.  
  300.     'Polygonal Capabilites
  301.     i = GetDeviceCaps(hDC, 32)
  302.     buffer = buffer & "Polygonal Capabilities:" & newLine
  303.     buffer = buffer & "Alternate Fill Polygons: " & GetYesNo(i And &H1) & newLine
  304.     buffer = buffer & "Rectangles: " & GetYesNo(i And &H2) & newLine
  305.     buffer = buffer & "Winding Number Fill Polygons: " & GetYesNo(i And &H4) & newLine
  306.     buffer = buffer & "Scan Lines: " & GetYesNo(i And &H8) & newLine
  307.     buffer = buffer & "Wide Borders: " & GetYesNo(i And &H10) & newLine
  308.     buffer = buffer & "Styled Borders: " & GetYesNo(i And &H20) & newLine
  309.     buffer = buffer & "Wide, Styled Borders: " & GetYesNo(i And &H40) & newLine
  310.     buffer = buffer & "Interiors: " & GetYesNo(i And &H80) & newLine
  311.     buffer = buffer & newLine
  312.  
  313.     'Text Capabilites
  314.     i = GetDeviceCaps(hDC, 34)
  315.     buffer = buffer & "Text Capabilities:" & newLine
  316.     buffer = buffer & "Character Output Precision: " & GetYesNo(i And &H1) & newLine
  317.     buffer = buffer & "Stroke Output Precision: " & GetYesNo(i And &H2) & newLine
  318.     buffer = buffer & "Stroke Clip Precision: " & GetYesNo(i And &H4) & newLine
  319.     buffer = buffer & "90-Degree Rotation: " & GetYesNo(i And &H8) & newLine
  320.     buffer = buffer & "Any-Degree Rotation: " & GetYesNo(i And &H10) & newLine
  321.     buffer = buffer & "Independant X and Y Scaling: " & GetYesNo(i And &H20) & newLine
  322.     buffer = buffer & "Doubled Character Scaling: " & GetYesNo(i And &H40) & newLine
  323.     buffer = buffer & "Integer Character Scaling: " & GetYesNo(i And &H80) & newLine
  324.     buffer = buffer & "Multiples Character Scaling: " & GetYesNo(i And &H100) & newLine
  325.     buffer = buffer & "Double-Weight Characters: " & GetYesNo(i And &H200) & newLine
  326.     buffer = buffer & "Italics: " & GetYesNo(i And &H400) & newLine
  327.     buffer = buffer & "Underlining: " & GetYesNo(i And &H800) & newLine
  328.     buffer = buffer & "Strikeouts: " & GetYesNo(i And &H1000) & newLine
  329.     buffer = buffer & "Raster Fonts: " & GetYesNo(i And &H2000) & newLine
  330.     buffer = buffer & "Vector Fonts: " & GetYesNo(i And &H4000) & newLine
  331.  
  332.     GetDeviceInfo = buffer
  333.  
  334. End Function
  335.  
  336. Function GetDiskSpace (driveNum As Integer, totalSpace As Long, freeSpace As Long) As Integer
  337. 'Returns the total and available disk space for the specified drive
  338. 'driveNum specifies which drive (0 = default, 1 = A, 2 = B, etc.)
  339.     Dim registers As REGS, bytesPerCluster As Long
  340.  
  341.     'Request drive allocation information from DOS services
  342.     registers.AX = &H3600
  343.     registers.DX = driveNum
  344.     Call vbInterrupt(&H21, registers, registers)
  345.  
  346.     'Test for error condition
  347.     If registers.AX = -1 Then
  348.     'Exit with error
  349.     GetDiskSpace = False
  350.     Exit Function
  351.     End If
  352.  
  353.     'Calculate free and total space
  354.     bytesPerCluster = registers.AX * registers.CX
  355.     totalSpace = (CLng(registers.DX) And &HFFFF&) * bytesPerCluster
  356.     freeSpace = (CLng(registers.BX) And &HFFFF&) * bytesPerCluster
  357.  
  358.     'Indicate success
  359.     GetDiskSpace = True
  360.  
  361. End Function
  362.  
  363. Function GetFileText (filename As String) As String
  364. 'Returns a multi-line string that contains the specified file
  365.     Dim buffer As String, tmpBuff As String
  366.  
  367.     'Open and read specified file
  368.     On Error Resume Next
  369.     Open filename For Input As #1
  370.     If Err Then
  371.     MsgBox "Unable to open " & filename & " : " & Error$
  372.     Else
  373.     On Error GoTo 0
  374.     Do Until EOF(1)
  375.         Line Input #1, tmpBuff
  376.         buffer = buffer & tmpBuff & newLine
  377.     Loop
  378.     Close #1
  379.     End If
  380.  
  381.     GetFileText = buffer
  382.  
  383. End Function
  384.  
  385. Function GetYesNo (Value As Integer) As String
  386. 'Returns a Yes or No string that indicates if value in nonzero
  387.     If Value Then GetYesNo = "Yes" Else GetYesNo = "No"
  388. End Function
  389.  
  390. Sub ShowAutoExecBat ()
  391.     Dim buffer As String, i As Long
  392.     Dim myRegs As REGS
  393.  
  394.     'Determine boot drive
  395.     i = GetVersion() \ &H10000
  396.     If i >= &H400 Then
  397.     'If DOS version 4 or higher, get boot drive from DOS
  398.     myRegs.AX = &H3305
  399.     Call vbInterrupt(&H21, myRegs, myRegs)
  400.     buffer = Chr$(Asc("A") + ((myRegs.DX And &HFF) - 1))
  401.     Else
  402.     'Else assume boot drive is drive C:
  403.     buffer = "C"
  404.     End If
  405.     buffer = buffer & ":\AUTOEXEC.BAT"
  406.  
  407.     'Open and read AUTOEXEC.BAT
  408.     buffer = GetFileText(buffer)
  409.  
  410.     frmMain.txtDetails = buffer
  411.  
  412. End Sub
  413.  
  414. Sub ShowConfigSys ()
  415.     Dim buffer As String, i As Long
  416.     Dim myRegs As REGS
  417.  
  418.     'Determine boot drive
  419.     i = GetVersion() \ &H10000
  420.     If i >= &H400 Then
  421.     'If DOS version 4 or higher, get boot drive from DOS
  422.     myRegs.AX = &H3305
  423.     Call vbInterrupt(&H21, myRegs, myRegs)
  424.     buffer = Chr$(Asc("A") + ((myRegs.DX And &HFF) - 1))
  425.     Else
  426.     'Assume boot drive is drive C:
  427.     buffer = "C"
  428.     End If
  429.     buffer = buffer & ":\CONFIG.SYS"
  430.  
  431.     'Open and read CONFIG.SYS
  432.     buffer = GetFileText(buffer)
  433.  
  434.     frmMain.txtDetails = buffer
  435.  
  436. End Sub
  437.  
  438. Sub ShowDisplayInfo ()
  439.     Dim buffer As String, i As Long
  440.  
  441.     'Driver version
  442.     buffer = buffer & "Driver Version: "
  443.     i = GetDeviceCaps(frmMain.hDC, 0)
  444.     buffer = buffer & CStr(i \ &H100) & "." & Format(i And &HFF, "00")
  445.     buffer = buffer & newLine
  446.     'Number of colors
  447.     i = (2 ^ GetDeviceCaps(frmMain.hDC, 12)) ^ GetDeviceCaps(frmMain.hDC, 14)
  448.     buffer = buffer & "Colors: " & CStr(i) & newLine
  449.     'Other
  450.     buffer = buffer & GetDeviceInfo(CInt(frmMain.hDC))
  451.  
  452.     frmMain.txtDetails = buffer
  453.  
  454. End Sub
  455.  
  456. Sub ShowDOSInfo ()
  457.     Dim buffer As String, i As Long
  458.     Dim myRegs As REGS, j As Integer
  459.  
  460.     'DOS version
  461.     i = GetVersion() \ &H10000
  462.     buffer = "DOS Version: "
  463.     buffer = buffer & CStr(i \ &H100) & "." & Format(i And &HFF, "00")
  464.     buffer = buffer & newLine & newLine
  465.  
  466.     'DOS Boot drive
  467.     i = GetVersion() \ &H10000
  468.     If i >= &H400 Then
  469.     'If DOS version 4 or higher, get boot drive from DOS
  470.     myRegs.AX = &H3305
  471.     Call vbInterrupt(&H21, myRegs, myRegs)
  472.     buffer = buffer & "Boot Drive: " & Chr$(Asc("@") + (myRegs.DX And &HFF)) & ":" & newLine
  473.     End If
  474.  
  475.     'DOS Break flag
  476.     myRegs.AX = &H3300
  477.     Call vbInterrupt(&H21, myRegs, myRegs)
  478.     If (myRegs.DX And &HFF) Then
  479.     buffer = buffer & "Break Flag: " & "On" & newLine
  480.     Else
  481.     buffer = buffer & "Break Flag: " & "Off" & newLine
  482.     End If
  483.  
  484.     'DOS Verify flag
  485.     myRegs.AX = &H5400
  486.     Call vbInterrupt(&H21, myRegs, myRegs)
  487.     If (myRegs.AX And &HFF) Then
  488.     buffer = buffer & "Verify Flag: " & "On" & newLine
  489.     Else
  490.     buffer = buffer & "Verify Flag: " & "Off" & newLine
  491.     End If
  492.     
  493.     'Environment variables
  494.     buffer = buffer & newLine & "Environment variables:" & newLine
  495.     i = 1
  496.     Do While Environ$(i) <> ""
  497.     buffer = buffer & Environ$(i) & newLine
  498.     i = i + 1
  499.     Loop
  500.     buffer = buffer & newLine
  501.  
  502.     frmMain.txtDetails = buffer
  503. End Sub
  504.  
  505.  
  506. Sub ShowDrivesInfo ()
  507.     Dim buffer As String, i As Integer, j As Integer, tmpBuff As String
  508.     Dim totalSpace As Long, freeSpace As Long
  509.  
  510.     On Error Resume Next
  511.  
  512.     'Try all 26 drive letters
  513.     For i = Asc("A") To Asc("Z")
  514.     'Attempt to read volume label
  515.     tmpBuff = Dir$(Chr$(i) & ":*.*", ATTR_VOLUME)
  516.     'If error, assume drive is not a value drive
  517.     If Err = False Then
  518.         'Display drive letter
  519.         buffer = buffer & Chr$(i) & ":"
  520.         'Display volume label if any
  521.         If Len(tmpBuff) > 0 Then
  522.         'Strip period from volume label
  523.         j = InStr(tmpBuff, ".")
  524.         If j <> 0 Then
  525.             tmpBuff = Left$(tmpBuff, j - 1) & Mid$(tmpBuff, j + 1)
  526.         End If
  527.         buffer = buffer & " [" & tmpBuff & "]"
  528.         End If
  529.         buffer = buffer & newLine
  530.         'Total and free disk space
  531.         If GetDiskSpace((i - Asc("A")) + 1, totalSpace, freeSpace) Then
  532.         buffer = buffer & "Total disk space: "
  533.         buffer = buffer & Format$(totalSpace, "#,##0") & " bytes" & newLine
  534.         buffer = buffer & "Available disk space: "
  535.         buffer = buffer & Format$(freeSpace, "#,##0") & " bytes" & newLine
  536.         End If
  537.         buffer = buffer & newLine
  538.     Else
  539.         'Reset error for next drive
  540.         Err = 0
  541.     End If
  542.     Next i
  543.  
  544.     frmMain.txtDetails = buffer
  545.  
  546. End Sub
  547.  
  548. Sub ShowHardwareInfo ()
  549.     Dim buffer As String, i As Long
  550.     Dim myRegs As REGS
  551.  
  552.     'Processor type
  553.     buffer = "Processor: "
  554.     i = GetWinFlags()
  555.     If i And WF_CPU286 Then
  556.     buffer = buffer & "80286"
  557.     ElseIf i And WF_CPU386 Then
  558.     buffer = buffer & "80386"
  559.     ElseIf i And WF_CPU486 Then
  560.     buffer = buffer & "i486"
  561.     Else
  562.     buffer = buffer & "Unknown"
  563.     End If
  564.     buffer = buffer & newLine
  565.  
  566.     'Coprocessor
  567.     buffer = buffer & "Math Coprocessor: "
  568.     i = GetWinFlags()
  569.     If i And WF_80x87 Then
  570.     buffer = buffer & "Yes"
  571.     Else
  572.     buffer = buffer & "No"
  573.     End If
  574.     buffer = buffer & newLine
  575.  
  576.     'Keyboard
  577.     buffer = buffer & "Keyboard Type: "
  578.     Select Case GetKeyboardType(0)
  579.     Case 1
  580.         buffer = buffer & "IBM PC/XT"
  581.     Case 2
  582.         buffer = buffer & "Olivetti ICO"
  583.     Case 3
  584.         buffer = buffer & "IBM AT"
  585.     Case 4
  586.         buffer = buffer & "IBM Enhanced"
  587.     Case 5
  588.         buffer = buffer & "Nokia 1050"
  589.     Case 6
  590.         buffer = buffer & "Nokia 9140"
  591.     Case 7
  592.         buffer = buffer & "Standard Japanese"
  593.     Case Else
  594.         buffer = buffer & "Unknown"
  595.     End Select
  596.     buffer = buffer & newLine
  597.     buffer = buffer & "Number of Function Keys: "
  598.     buffer = buffer & CStr(GetKeyboardType(2))
  599.     buffer = buffer & newLine & newLine
  600.  
  601.     'ROM BIOS Equipment List
  602.     buffer = buffer & "ROM BIOS Reports:" & newLine
  603.     Call vbInterrupt(&H11, myRegs, myRegs)
  604.     buffer = buffer & "One or More Floppy Drives: " & GetYesNo(myRegs.AX And &H1) & newLine
  605.     buffer = buffer & "Math Coprocessor: " & GetYesNo(myRegs.AX And &H2) & newLine
  606.     buffer = buffer & "Startup Video Mode: "
  607.     Select Case (vbShiftRight(myRegs.AX, 4) And &H3)
  608.     Case &H0
  609.         buffer = buffer & "Unknown" & newLine
  610.     Case &H1
  611.         buffer = buffer & "40x25 Color" & newLine
  612.     Case &H2
  613.         buffer = buffer & "80x25 Color" & newLine
  614.     Case &H3
  615.         buffer = buffer & "80x25 Monochrome" & newLine
  616.     End Select
  617.     If myRegs.AX And &H1 Then
  618.     buffer = buffer & "Number of Floppy Drives: "
  619.     buffer = buffer & CStr((vbShiftRight(myRegs.AX, 6) And &H3) + 1) & newLine
  620.     End If
  621.     buffer = buffer & "Number of RS-232 Serial Ports: "
  622.     buffer = buffer & CStr(vbShiftRight(myRegs.AX, 9) And &H7) & newLine
  623.     buffer = buffer & "Game Adapter: " & GetYesNo(myRegs.AX And &H1000) & newLine
  624.     buffer = buffer & "Number of Printers: "
  625.     buffer = buffer & CStr(vbShiftRight(myRegs.AX, 14) And &H3) & newLine
  626.  
  627.     frmMain.txtDetails = buffer
  628.  
  629. End Sub
  630.  
  631. Sub ShowIntVectors ()
  632.     Dim buffer As String, i As Integer
  633.  
  634.     'Show vector address for each interrupt
  635.     For i = 0 To &HFF
  636.     buffer = buffer & "Interrupt " & Right$("0" & Hex$(i), 2)
  637.     buffer = buffer & "h = " & Right$("000" & Hex$(vbPeekw(0, i)), 4)
  638.     buffer = buffer & ":" & Right$("000" & Hex$(vbPeekw(0, i + 2)), 4)
  639.     buffer = buffer & newLine
  640.     Next i
  641.  
  642.     frmMain.txtDetails = buffer
  643.  
  644. End Sub
  645.  
  646. Sub ShowPrinterInfo ()
  647.     Dim buffer As String, i As Long
  648.  
  649.     'Driver version
  650.     buffer = buffer & "Driver Version: "
  651.     i = GetDeviceCaps(Printer.hDC, 0)
  652.     buffer = buffer & CStr(i \ &H100) & "." & Format(i And &HFF, "00")
  653.     buffer = buffer & newLine
  654.  
  655.     'Number of colors
  656.     i = (2 ^ GetDeviceCaps(Printer.hDC, 12)) ^ GetDeviceCaps(Printer.hDC, 14)
  657.     buffer = buffer & "Colors: " & CStr(i) & newLine
  658.  
  659.     'Other
  660.     buffer = buffer & GetDeviceInfo(CInt(Printer.hDC))
  661.  
  662.     frmMain.txtDetails = buffer
  663.  
  664. End Sub
  665.  
  666. Sub ShowWindowsInfo ()
  667.     Dim buffer As String, i As Long, tmpBuff As String
  668.     Dim Pointer As Long, j As Integer
  669.     Dim myLogFont As LOGFONT
  670.  
  671.     'Windows version
  672.     i = GetVersion() And &HFFFF&
  673.     buffer = "Windows Version: "
  674.     buffer = buffer & CStr(i And &HFF) & "." & Format(i \ &H100, "00")
  675.     buffer = buffer & newLine
  676.  
  677.     'Windows mode
  678.     buffer = buffer & "Mode: "
  679.     i = GetWinFlags()
  680.     If i And WF_ENHANCED Then
  681.     buffer = buffer & "Enhanced"
  682.     Else
  683.     buffer = buffer & "Standard"
  684.     End If
  685.     buffer = buffer & newLine
  686.     buffer = buffer & newLine
  687.  
  688.     'Windows and Windows system directory
  689.     tmpBuff = Space$(256)
  690.     i = GetWindowsDirectory(tmpBuff, 256)
  691.     buffer = buffer & "Windows Directory: " & Left$(tmpBuff, i) & newLine
  692.     i = GetSystemDirectory(tmpBuff, 256)
  693.     buffer = buffer & "System Directory: " & Left$(tmpBuff, i) & newLine
  694.     tmpBuff = Environ$("TEMP")
  695.     If Len(tmpBuff) > 0 Then
  696.     buffer = buffer & "Temporary Directory: " & tmpBuff & newLine
  697.     End If
  698.     buffer = buffer & newLine
  699.     
  700.     'Available memory
  701.     buffer = buffer & "Available Memory: " & Format$(GetFreeSpace(0), "#,###") & " bytes" & newLine
  702.     buffer = buffer & "Largest Free Memory Object: " & Format$(GlobalCompact(0), "#,###") & " bytes" & newLine
  703.     buffer = buffer & newLine
  704.     
  705.     'System resources
  706.     buffer = buffer & "Free System Resources: " & CStr(GetFreeSystemResources(GFSR_SYSTEMRESOURCES)) & "%" & newLine
  707.     buffer = buffer & "Free GDI Resources: " & CStr(GetFreeSystemResources(GFSR_GDIRESOURCES)) & "%" & newLine
  708.     buffer = buffer & "Free User Resources: " & CStr(GetFreeSystemResources(GFSR_USERRESOURCES)) & "%" & newLine
  709.     buffer = buffer & newLine
  710.     
  711.     'SystemsParametersInfo
  712.     buffer = buffer & "System Information:" & newLine
  713.     buffer = buffer & "Mouse Present: " & GetYesNo(GetSystemMetrics(19)) & newLine
  714.     buffer = buffer & "Swapped Mouse Buttons: " & GetYesNo(GetSystemMetrics(23)) & newLine
  715.     buffer = buffer & "Caret Blink Time: " & GetCaretBlinkTime() & " ms." & newLine
  716.     buffer = buffer & "Windows Debug Version: " & GetYesNo(GetSystemMetrics(22)) & newLine
  717.     Pointer = vbGetLongPtr(myLogFont)   'Assign to long for syntax checker
  718.     If SystemParametersInfo(31, Len(myLogFont), Pointer, False) Then
  719.     buffer = buffer & "Icon Title Font: " & Left$(myLogFont.lfFaceName, InStr(myLogFont.lfFaceName, Chr$(0)) - 1) & newLine
  720.     End If
  721.     Pointer = vbGetLongPtr(j)   'Pointer to j
  722.     If SystemParametersInfo(1, 0, Pointer, False) Then
  723.     buffer = buffer & "Warning Beeps: " & GetYesNo(j) & newLine
  724.     End If
  725.     If SystemParametersInfo(5, 0, Pointer, False) Then
  726.     buffer = buffer & "Border Multiplying Factor: " & CStr(j) & newLine
  727.     End If
  728.     If SystemParametersInfo(35, 0, Pointer, False) Then
  729.     buffer = buffer & "Fast Task Switching: " & GetYesNo(j) & newLine
  730.     End If
  731.     If SystemParametersInfo(18, 0, Pointer, False) Then
  732.     buffer = buffer & "Grid Granularity: " & CStr(j) & newLine
  733.     End If
  734.     If SystemParametersInfo(25, 0, Pointer, False) Then
  735.     buffer = buffer & "Icon Title Word Wrap: " & GetYesNo(j) & newLine
  736.     End If
  737.     If SystemParametersInfo(22, 0, Pointer, False) Then
  738.     buffer = buffer & "Keyboard Repeat-Delay: " & CStr(j) & newLine
  739.     End If
  740.     If SystemParametersInfo(10, 0, Pointer, False) Then
  741.     buffer = buffer & "Keyboard Repeat-Speed: " & CStr(j) & newLine
  742.     End If
  743.     If SystemParametersInfo(27, 0, Pointer, False) Then
  744.     buffer = buffer & "Right-Align Pop-up Menus: " & GetYesNo(j) & newLine
  745.     End If
  746.     If SystemParametersInfo(16, 0, Pointer, False) Then
  747.     buffer = buffer & "Screen Saver Active: " & GetYesNo(j) & newLine
  748.     End If
  749.     If SystemParametersInfo(14, 0, Pointer, False) Then
  750.     buffer = buffer & "Screen-Saver Time-Out: " & CStr(j / 60) & " seconds" & newLine
  751.     End If
  752.     If SystemParametersInfo(13, 0, Pointer, False) Then
  753.     buffer = buffer & "Horizontal Icon Spacing: " & CStr(j) & newLine
  754.     End If
  755.     If SystemParametersInfo(24, 0, Pointer, False) Then
  756.     buffer = buffer & "Vertical Icon Spacing: " & CStr(j) & newLine
  757.     End If
  758.     buffer = buffer & "Microseconds Per Timer Tick: " & CStr(GetTimerResolution()) & newLine
  759.     buffer = buffer & newLine
  760.  
  761.     'System Metrics
  762.     buffer = buffer & "System Metrics (Pixels):" & newLine
  763.     buffer = buffer & "Screen Width: " & GetSystemMetrics(0) & newLine
  764.     buffer = buffer & "Screen Height: " & GetSystemMetrics(1) & newLine
  765.     buffer = buffer & "Width of Arrow Bitmap on Vertical Scroll Bar: " & GetSystemMetrics(2) & newLine
  766.     buffer = buffer & "Height of Arrow Bitmap on Vertical Scroll Bar: " & GetSystemMetrics(20) & newLine
  767.     buffer = buffer & "Width of Arrow Bitmap on Horizontal Scroll Bar: " & GetSystemMetrics(21) & newLine
  768.     buffer = buffer & "Height of Arrow Bitmap on Horizontal Scroll Bar: " & GetSystemMetrics(3) & newLine
  769.     buffer = buffer & "Height of Thumb Scroll on Vertical Scroll Bar: " & GetSystemMetrics(9) & newLine
  770.     buffer = buffer & "Width of Thumb Scroll on Horizontal Scroll Bar: " & GetSystemMetrics(10) & newLine
  771.     buffer = buffer & "Width of Window Frame That Can Be Sized: " & GetSystemMetrics(32) & newLine
  772.     buffer = buffer & "Height of Window Frame That Can Be Sized: " & GetSystemMetrics(33) & newLine
  773.     buffer = buffer & "Width of Window Frame That Cannot Be Sized: " & GetSystemMetrics(5) & newLine
  774.     buffer = buffer & "Height of Window Frame That Cannot Be Sized: " & GetSystemMetrics(6) & newLine
  775.     buffer = buffer & "Width of Dialog Frame: " & GetSystemMetrics(7) & newLine
  776.     buffer = buffer & "Height of Dialog Frame: " & GetSystemMetrics(8) & newLine
  777.     buffer = buffer & "Menu Bar Height: " & GetSystemMetrics(15) & newLine
  778.     buffer = buffer & "Window Caption Height: " & GetSystemMetrics(4) & newLine
  779.     buffer = buffer & "Minimum Window Width: " & GetSystemMetrics(28) & newLine
  780.     buffer = buffer & "Minimum Window Height: " & GetSystemMetrics(29) & newLine
  781.     buffer = buffer & "Icon Width: " & GetSystemMetrics(11) & newLine
  782.     buffer = buffer & "Icon Height: " & GetSystemMetrics(12) & newLine
  783.     buffer = buffer & "Cursor Width: " & GetSystemMetrics(13) & newLine
  784.     buffer = buffer & "Cursor Height: " & GetSystemMetrics(14) & newLine
  785.     buffer = buffer & newLine
  786.  
  787.     'System Colors
  788.     buffer = buffer & "System Colors:" & newLine
  789.     buffer = buffer & "Title Bar Text: " & GetColorString(GetSysColor(9)) & newLine
  790.     buffer = buffer & "Active Window Caption: " & GetColorString(GetSysColor(2)) & newLine
  791.     buffer = buffer & "Active Window Border: " & GetColorString(GetSysColor(10)) & newLine
  792.     buffer = buffer & "Inactive Window Title Text: " & GetColorString(GetSysColor(19)) & newLine
  793.     buffer = buffer & "Inactive Window Title: " & GetColorString(GetSysColor(3)) & newLine
  794.     buffer = buffer & "Inactive Window Border: " & GetColorString(GetSysColor(11)) & newLine
  795.     buffer = buffer & "Window Background: " & GetColorString(GetSysColor(5)) & newLine
  796.     buffer = buffer & "Window Frame: " & GetColorString(GetSysColor(6)) & newLine
  797.     buffer = buffer & "Window Text: " & GetColorString(GetSysColor(8)) & newLine
  798.     buffer = buffer & "MDI Background: " & GetColorString(GetSysColor(12)) & newLine
  799.     buffer = buffer & "Desktop: " & GetColorString(GetSysColor(1)) & newLine
  800.     buffer = buffer & "Menu Text: " & GetColorString(GetSysColor(7)) & newLine
  801.     buffer = buffer & "Menu Background: " & GetColorString(GetSysColor(4)) & newLine
  802.     buffer = buffer & "Button Text: " & GetColorString(GetSysColor(18)) & newLine
  803.     buffer = buffer & "Button Face: " & GetColorString(GetSysColor(15)) & newLine
  804.     buffer = buffer & "Button Highlight: " & GetColorString(GetSysColor(20)) & newLine
  805.     buffer = buffer & "Button Shadow: " & GetColorString(GetSysColor(16)) & newLine
  806.     buffer = buffer & "Control Selection Text: " & GetColorString(GetSysColor(14)) & newLine
  807.     buffer = buffer & "Control Selection Background: " & GetColorString(GetSysColor(13)) & newLine
  808.     buffer = buffer & "Dimmed Text: " & GetColorString(GetSysColor(17)) & newLine
  809.     buffer = buffer & "Scroll Bar: " & GetColorString(GetSysColor(0)) & newLine
  810.  
  811.     frmMain.txtDetails = buffer
  812.  
  813. End Sub
  814.  
  815. Sub ShowWinIni ()
  816.     Dim buffer As String, i As Long
  817.     Dim myRegs As REGS, tmpBuff As String * 256
  818.  
  819.     'Determine Windows system directory
  820.     i = GetWindowsDirectory(tmpBuff, 256)
  821.     buffer = buffer & Left$(tmpBuff, i) & "\WIN.INI"
  822.  
  823.     'Open and read WIN.INI
  824.     buffer = GetFileText(buffer)
  825.  
  826.     frmMain.txtDetails = buffer
  827.  
  828. End Sub
  829.  
  830.