home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / vrac / atspy.zip / APPTITLE.BAS next >
BASIC Source File  |  1994-06-16  |  9KB  |  287 lines
  1. ' EXE Signature for different operating systems
  2.  
  3. Global Const IMAGE_DOS_SIGNATURE = &H5A4D      ' MZ
  4. Global Const IMAGE_OS2_SIGNATURE = &H454E      ' NE
  5. Global Const IMAGE_OS2_SIGNATURE_LE = &H454C   ' LE
  6. Global Const IMAGE_NT_SIGNATURE = &H4550       ' PE(00)
  7.  
  8. ' Header appearing at the beginning of all DOS executables.
  9.  
  10. Type DOSEXEHEADER
  11.  
  12.     usSignature     As Integer      ' EXE signature
  13.     cbExtra         As Integer      ' Bytes on last page of file
  14.     cPages          As Integer      ' Pages in file
  15.     cRelocItems     As Integer      ' Relocations
  16.     cphHeader       As Integer      ' Size of header in paragraphs
  17.     cphMinAlloc     As Integer      ' Minimum extra paragraphs needed
  18.     cphMaxAlloc     As Integer      ' Maximum extra paragraphs needed
  19.     usInitSS        As Integer      ' Initial (relative SS value
  20.     usInitSP        As Integer      ' Initial SP value
  21.     usCheckSum      As Integer      ' Checksum
  22.     usInitIP        As Integer      ' Initial IP value
  23.     usInitCS        As Integer      ' Initial (relative CS value
  24.     usRelocTable    As Integer      ' File address of relocation table
  25.     usOverlayNumber As Integer      ' Overlay number
  26.     rgchReserved1   As String * 8   ' Reserved bytes
  27.     usOEMID         As Integer      ' OEM identifier (for usoeminfo
  28.     usOEMInfo       As Integer      ' OEM information As Integer usoemid specific
  29.     rgchReserved2   As String * 20  ' Reserved bytes
  30.     offlNewHeader   As Long         ' File address of new exe header
  31.  
  32. End Type
  33.  
  34. ' New Header within all Windows executables.
  35. ' This header appears at the offset specified in the
  36. ' offlNewHeader of DOSEXEHEADER.
  37.  
  38. Type NEHEADER
  39.  
  40.     usSignature             As Integer      ' NE signature
  41.     bLinkerVersion          As String * 1   ' Linker version number
  42.     bLinkerRevision         As String * 1   ' Linker revision number
  43.     offusEntryTable         As Integer      ' Offset to the entry table
  44.     cbEntryTable            As Integer      ' Size of the entry table
  45.     rgchReserved1           As String * 4   ' Reserved
  46.     usContents              As Integer      ' Bit-field describing the contents
  47.     usAutoDSNum             As Integer      ' Automatic data segment number
  48.     cbInitHeapSize          As Integer      ' Initial local heap size
  49.     cbInitStackSize         As Integer      ' Initial stack size
  50.     dwCSIP                  As Long         ' CS:IP
  51.     dwSSSP                  As Long         ' SS:SP
  52.     cSegmentEntries         As Integer      ' Number of entries in the segment table
  53.     cModRefEntries          As Integer      ' Number of entries in the module reference table
  54.     cNonResNameEntries      As Integer      ' Number of entries in the non-resident name table
  55.     offusSegTable           As Integer      ' Offset to the segment table
  56.     offusResTable           As Integer      ' Offset to the resource table
  57.     offusResNameTable       As Integer      ' Offset to the resident name table
  58.     offusModRefTable        As Integer      ' Offset to the module reference table
  59.     offusImpNameTable       As Integer      ' Offset to the imported name table
  60.     offusNonResNameTable    As Integer      ' Offset to the non-resident name table
  61.     cMovEntryPoints         As Integer      ' Number of moveable entry points
  62.     
  63.     ' The rest of the header information has not been included.
  64.     
  65. End Type
  66.  
  67. ' Resource Types
  68.  
  69. Const RT_CURSOR = 1
  70. Const RT_BITMAP = 2
  71. Const RT_ICON = 3
  72. Const RT_MENU = 4
  73. Const RT_DIALOG = 5
  74. Const RT_STRING = 6
  75. Const RT_FONTDIR = 7
  76. Const RT_FONT = 8
  77. Const RT_ACCELERATOR = 9
  78. Const RT_RCDATA = 10
  79. Const RT_GROUP_CURSOR = 12
  80. Const RT_GROUP_ICON = 14
  81.  
  82. ' Structure describing a resource type in the
  83. ' resource table.
  84.  
  85. Type RESTYPEINFO
  86.  
  87.     usType As Integer       ' Resource type
  88.     cEntries As Integer     ' Number of entries of this resource type
  89.     Reserved1 As String * 4 ' Reserved
  90.  
  91. End Type
  92.  
  93. Type RESNAMEINFO
  94.  
  95.     offusData As Integer    ' Offset to resource data
  96.     cbLen As Integer        ' Length of resource data
  97.     usFlags As Integer      ' Resource flags
  98.     id As Integer           ' Resource ID
  99.     handle As Integer       ' Reserved for run-time
  100.     cUsage As Integer       ' Reserved for run-time
  101.     
  102. End Type
  103.  
  104. ' Error base code
  105. Const GATERR_BASE = 32000
  106.  
  107. Global Const GATERR_NOTDOSEXE = GATERR_BASE + 0     ' Not a DOS executable
  108. Global Const GATERR_NOTWINEXE = GATERR_BASE + 1     ' Not a Windows executable
  109. Global Const GATERR_NOTVBEXE = GATERR_BASE + 2      ' Not a Visual Basic application
  110.  
  111. Global Const GATERR_FIRST = GATERR_BASE
  112. Global Const GATERR_LAST = GATERR_BASE + 20
  113.  
  114. Function GetAppTitle (ByVal sFileName As String) As String
  115.  
  116.     Dim hfile As Integer
  117.     Dim deh As DOSEXEHEADER
  118.     Dim neh As NEHEADER
  119.     Dim usShiftCount As Integer
  120.     Dim lAlignment As Long
  121.     Dim rti As RESTYPEINFO
  122.     Dim rni As RESNAMEINFO
  123.     Dim I As Integer
  124.     Dim sData As String
  125.     Dim cchTitle As Integer
  126.  
  127.     hfile = FreeFile
  128.     
  129.     ' Check to see if the file exists at first. This
  130.     ' is important because attempting to open a non-
  131.     ' existant file in Binary mode will actually
  132.     ' create it.
  133.     
  134.     If Dir$(sFileName) = "" Then
  135.     Error 53
  136.     End If
  137.     
  138.     Open sFileName For Binary As hfile
  139.  
  140.     ' Get the DOS executable header.
  141.     Get hfile, , deh
  142.  
  143.     ' Make sure we are dealing with at least a DOS executable.
  144.     ' All Windows executables begin with a DOS header, so this
  145.     ' will be our first check.
  146.     
  147.     If deh.usSignature <> IMAGE_DOS_SIGNATURE Then
  148.     Error GATERR_NOTDOSEXE
  149.     End If
  150.  
  151.     ' Next make sure that we are dealing with a Windows
  152.     ' executable, and therefore not only a DOS one.
  153.     
  154.     If deh.usRelocTable < &H40 Then
  155.     Error GATERR_NOTWINEXE
  156.     End If
  157.  
  158.     ' Go and read the new executable header found in
  159.     ' Windows executables.
  160.     Seek hfile, deh.offlNewHeader + 1
  161.     Get hfile, , neh
  162.     
  163.     ' Go to the table of the resources. The resource table
  164.     ' offset is relative to the beginning of the new
  165.     ' executable header, thus the addition below.
  166.     
  167.     Seek hfile, deh.offlNewHeader + neh.offusResTable + 1
  168.  
  169.     ' Retrieve the shift count found at the beginning
  170.     ' of the resource table. This is used to adjust the
  171.     ' offsets and sizes in the resource entries.
  172.     
  173.     Get hfile, , usShiftCount
  174.     lAlignment = 2 ^ usShiftCount
  175.  
  176.     ' Loop that walks through all the resource types
  177.     ' like icons, bitmaps, dialog boxes, user-defined, etc.
  178.     Do
  179.  
  180.     ' Get the resource type information.
  181.     Get hfile, , rti
  182.  
  183.     ' If we're at the end of the table then break
  184.     ' out of the loop. If this occurs, it usually
  185.     ' implies that no App.Title string was found
  186.     ' for the executable. This may happen if the
  187.     ' executable is not a VB 3.0 application.
  188.     
  189.     If rti.usType = 0 Then Exit Do
  190.  
  191.     ' Walk through all the entries of the current
  192.     ' resource type.
  193.     For I = 1 To rti.cEntries
  194.         
  195.         ' Get the resource name information entry.
  196.         Get hfile, , rni
  197.  
  198.         ' Are we dealing with a raw data resource here?
  199.         ' Because that is what we're interested in.
  200.         If rti.usType = (&H8000 Or RT_RCDATA) Then
  201.  
  202.         ' Is the integer Id of this resource 1?
  203.         If rni.id = &H8001 Then
  204.             
  205.             ' Good, we've found the resource we
  206.             ' wanted.
  207.  
  208.             ' Now go to the offset where its data
  209.             ' can be found. Remember that offsets
  210.             ' and sizes in the resource table need
  211.             ' to be re-aligned.
  212.             
  213.             Seek hfile, rni.offusData * lAlignment + 1
  214.  
  215.             ' Allocate space to receive the resource
  216.             ' data and then read it in. Note that we
  217.             ' only read in the first 256 bytes in case
  218.             ' the resource runs longer. This is because
  219.             ' it is pointless to read the entire
  220.             ' resource (as it can be as big as 4K on
  221.             ' certain large projects) when the App.Title
  222.             ' string appears somewhere in the beginning.
  223.             ' This will also make the function faster
  224.             ' and less memory hungary.
  225.  
  226.             sData = Space(Min(rni.cbLen * lAlignment, 256))
  227.             Get hfile, , sData
  228.  
  229.             ' The length of the title string is at offset
  230.             ' &H15 in the resource (it includes the null-
  231.             ' terminator, but we substract it).
  232.             
  233.             cchTitle = Asc(Mid$(sData, 16, 1)) - 1
  234.  
  235.             ' Just a safety guard. App.Title cannot be
  236.             ' longer than 40 characters.
  237.  
  238.             If cchTitle > 40 Then
  239.             Exit Do
  240.             End If
  241.  
  242.             ' OK, the App.Title string should be at offset
  243.             ' &H13 of the resource data.
  244.             
  245.             If cchTitle > 0 Then
  246.             GetAppTitle = Mid$(sData, 20, cchTitle)
  247.             End If
  248.  
  249.             ' We don't need to process any further. We've
  250.             ' found the required item, so close the file
  251.             ' and exit.
  252.             
  253.             Close hfile
  254.             Exit Function
  255.         
  256.         End If
  257.         
  258.         End If
  259.         
  260.     Next I
  261.  
  262.     Loop
  263.  
  264.     Close hfile
  265.  
  266.     ' We didn't find the resource we were looking for
  267.     ' when it should usually be there for all VB generated
  268.     ' executables. So treat this as a case of error.
  269.     Error GATERR_NOTVBEXE
  270.  
  271. End Function
  272.  
  273. Function Min (ByVal A As Variant, ByVal B As Variant)
  274.  
  275.     ' NOTE: We don't use the IIf function here instead
  276.     '       because that pulls in an extra DLL---the
  277.     '       MSAFINX.DLL).
  278.  
  279.     If A < B Then
  280.     Min = A
  281.     Else
  282.     Min = B
  283.     End If
  284.  
  285. End Function
  286.  
  287.