frmMain.frm

 
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmWizard
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Base Address Wizard"
   ClientHeight    =   5865
   ClientLeft      =   315
   ClientTop       =   2025
   ClientWidth     =   6120
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   391
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   408
   StartUpPosition =   2  'CenterScreen
   Begin VB.Frame Frame1
      Caption         =   "Quick Generate"
      Height          =   2055
      Left            =   240
      TabIndex        =   17
      Top             =   3600
      Width           =   5655
      Begin VB.CommandButton Command2
         Caption         =   "Generate"
         Height          =   375
         Left            =   1800
         TabIndex        =   22
         Top             =   1440
         Width           =   1935
      End
      Begin VB.TextBox Text4
         Alignment       =   2  'Center
         BackColor       =   &H80000015&
         BeginProperty Font
            Name            =   "Courier New"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H8000000E&
         Height          =   375
         Left            =   2880
         TabIndex        =   21
         Top             =   840
         Width           =   2655
      End
      Begin VB.TextBox Text3
         Alignment       =   2  'Center
         BackColor       =   &H80000015&
         BeginProperty Font
            Name            =   "Courier New"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H8000000E&
         Height          =   375
         Left            =   2880
         TabIndex        =   20
         Top             =   360
         Width           =   2655
      End
      Begin VB.TextBox Text2
         Alignment       =   2  'Center
         BackColor       =   &H80000015&
         BeginProperty Font
            Name            =   "Courier New"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H8000000E&
         Height          =   375
         Left            =   120
         TabIndex        =   19
         Top             =   840
         Width           =   2655
      End
      Begin VB.TextBox Text1
         Alignment       =   2  'Center
         BackColor       =   &H80000015&
         BeginProperty Font
            Name            =   "Courier New"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H8000000E&
         Height          =   375
         Left            =   120
         TabIndex        =   18
         Top             =   360
         Width           =   2655
      End
   End
   Begin VB.CommandButton cmdClose
      Caption         =   "Close"
      Height          =   375
      Left            =   4080
      TabIndex        =   15
      Top             =   2880
      Width           =   1815
   End
   Begin VB.CommandButton cmdBack
      Caption         =   "Back"
      Enabled         =   0   'False
      Height          =   375
      Left            =   240
      TabIndex        =   14
      Top             =   2880
      Width           =   1815
   End
   Begin VB.CommandButton cmdNext
      Caption         =   "Next"
      Enabled         =   0   'False
      Height          =   375
      Left            =   2160
      TabIndex        =   13
      Top             =   2880
      Width           =   1815
   End
   Begin VB.Frame Step1
      Caption         =   "Step 1 (Analize Files)"
      Height          =   1695
      Left            =   240
      TabIndex        =   0
      Top             =   840
      Width           =   5655
      Begin VB.CommandButton Command1
         Caption         =   "View Database"
         Enabled         =   0   'False
         Height          =   375
         Left            =   3960
         TabIndex        =   12
         Top             =   1200
         Width           =   1455
      End
      Begin VB.CommandButton cmdGetDLLs
         Caption         =   "Analize"
         Height          =   375
         Left            =   240
         TabIndex        =   1
         Top             =   1200
         Width           =   1125
      End
      Begin VB.Label lblStatus
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "Status : Idle"
         ForeColor       =   &H00000080&
         Height          =   195
         Left            =   1560
         TabIndex        =   7
         Top             =   1320
         Width           =   840
      End
      Begin VB.Label Label1
         BackStyle       =   0  'Transparent
         Caption         =   "Inspects your computer's installed DLL and OCX files, then adds the Filename and Base Address to a database."
         Height          =   495
         Left            =   240
         TabIndex        =   2
         Top             =   480
         Width           =   4455
      End
   End
   Begin VB.Frame Step3
      Caption         =   "Step 3 (Finishing)"
      Height          =   1695
      Left            =   240
      TabIndex        =   8
      Top             =   840
      Visible         =   0   'False
      Width           =   5655
      Begin VB.CommandButton cmdSave
         Caption         =   "Save to Project"
         Enabled         =   0   'False
         Height          =   375
         Left            =   3480
         TabIndex        =   11
         Top             =   1200
         Width           =   1935
      End
      Begin VB.CommandButton cmdCopy
         Caption         =   "Copy to Clipboard"
         Enabled         =   0   'False
         Height          =   375
         Left            =   240
         TabIndex        =   9
         Top             =   1200
         Width           =   1965
      End
      Begin MSComDlg.CommonDialog CD1
         Left            =   3720
         Top             =   600
         _ExtentX        =   847
         _ExtentY        =   847
         _Version        =   393216
         DefaultExt      =   "*.vbp"
         DialogTitle     =   "Select a Project to save the Base Address to :"
         Filter          =   "*.vbp"
      End
      Begin VB.Label Label3
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "To use the newly generated Base Address, select an option below."
         Height          =   195
         Left            =   240
         TabIndex        =   10
         Top             =   480
         Width           =   4725
      End
   End
   Begin VB.Frame Step2
      Caption         =   "Step 2 (Generate Suggestion)"
      Height          =   1695
      Left            =   240
      TabIndex        =   3
      Top             =   840
      Visible         =   0   'False
      Width           =   5655
      Begin VB.TextBox txtAddress
         Alignment       =   2  'Center
         Appearance      =   0  'Flat
         BeginProperty Font
            Name            =   "Courier New"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00000080&
         Height          =   375
         Left            =   1800
         Locked          =   -1  'True
         MousePointer    =   1  'Arrow
         TabIndex        =   6
         Text            =   "<Click on Generate>"
         Top             =   1200
         Width           =   3615
      End
      Begin VB.CommandButton cmdGenerate
         Caption         =   "Generate"
         Enabled         =   0   'False
         Height          =   375
         Left            =   240
         TabIndex        =   4
         Top             =   1200
         Width           =   1125
      End
      Begin VB.Label Label2
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "Generates a suggested open Base Address."
         Height          =   195
         Left            =   240
         TabIndex        =   5
         Top             =   480
         Width           =   3120
      End
   End
   Begin VB.Label Label4
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "--------------- Base Address Wizard ---------------"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00400000&
      Height          =   300
      Left            =   360
      TabIndex        =   16
      Top             =   240
      Width           =   5460
   End
End
Attribute VB_Name = "frmWizard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Private Type MyType

    mFileName As String
    mBaseAddress As String

End Type


Dim MyArr() As MyType
Private AgainCount As Integer



Private m_strVBP_Name As String
Private m_strVBP_Path As String
Private m_strDll_Name As String
Private m_strCurAddr As String

Private Const MyHstr As String * 2 = "&H"
Private Const MyDllStr As String * 3 = "DLL"
Private Const MyOCXStr As String * 3 = "OCX"
Private Const MyDev As Integer = 1024
Private Const MyStr As String * 4 = "#.00"
Private m_objFileSys As New FileSystemObject


Private Sub cmdBack_Click()

cmdNext.Caption = "Next"

If Step2.Visible = True Then
Step1.Visible = True
cmdBack.Enabled = False
Step2.Visible = False
Step3.Visible = False
Exit Sub
End If

If Step3.Visible = True Then
Step1.Visible = False
Step2.Visible = True
Step3.Visible = False
Exit Sub
End If

End Sub

Private Sub cmdClose_Click()


Unload Me
End Sub

Private Sub cmdCopy_Click()
Clipboard.SetText txtAddress
cmdNext.SetFocus
End Sub

Private Sub cmdGenerate_Click()

cmdCopy.Enabled = True
cmdSave.Enabled = True

MousePointer = vbHourglass

  Dim rndNumber As Long

  Randomize
 
  rndNumber = Rnd * 100
 
  rndNumber = &H11000000 + rndNumber * &H10000
  txtAddress.Text = MyHstr & Hex$(rndNumber)
 
 
 
  If SearchDB(txtAddress.Text) = True Then
  GoAgain
  Exit Sub
  End If
 
MousePointer = vbNormal
 
  cmdNext.SetFocus
 
End Sub

Private Sub cmdGetDLLs_Click()
cmdGetDLLs.Enabled = False
Command1.Enabled = False
cmdNext.Enabled = False
   ReDim MyArr(15000)
  
  
  
   lblStatus.Caption = "Status : Analizing..."
  
  
   Dim p_objFile                       As File
   Dim p_colFiles                      As Files
   Dim p_objFolder                     As Folder
   Dim p_strFullName                   As String
   Dim p_strFileName                   As String
   Dim p_strBaseAddr                   As String
   Dim p_strCompanyName                As String
   Dim p_strVersionNum                 As String

   Dim p_lngLoop                       As Long
   Dim p_lngCount                      As Long
  

  
   Me.MousePointer = vbHourglass
  

  
   Set m_objFileSys = CreateObject("Scripting.FileSystemObject")
   Set p_objFolder = m_objFileSys.GetSpecialFolder(SystemFolder)
  
   Set p_colFiles = p_objFolder.Files()
  
   p_lngCount = 0
   For Each p_objFile In p_colFiles
      p_strFileName = vbNullString
      p_strFullName = vbNullString
     
      p_strFileName = p_objFile.Name
      If Right$(UCase$(Trim$(p_strFileName)), 3) = MyDllStr Then

         p_strFullName = p_objFile.Path
        
         ' -------------------------------------
         ' 32-bit DLLs
         ' -------------------------------------
         If FileInfo(p_strFullName, _
                     p_strBaseAddr) = True Then
            p_lngCount = p_lngCount + 1




With MyArr(p_lngCount)
.mFileName = p_strFileName
.mBaseAddress = p_strBaseAddr
End With


         End If
      End If
        

  
      If Right$(UCase$(Trim$(p_strFileName)), 3) = MyOCXStr Then

         p_strFullName = p_objFile.Path
        
         ' -------------------------------------
         ' OCXs
         ' -------------------------------------
         If FileInfo(p_strFullName, _
                     p_strBaseAddr) = True Then
            p_lngCount = p_lngCount + 1

                

           
    With MyArr(p_lngCount)
     .mFileName = p_strFileName
     .mBaseAddress = p_strBaseAddr
    End With
           
           
           
         End If
      End If
  
   Next
  
  
  


   AddToList (p_lngCount)
  
End Sub

Private Sub cmdQuit_Click()

End Sub


Private Function AddToList(Number As Long)


Set dbs = OpenDatabase(App.Path & "\BaseAddresses.mdb")
Set rs = dbs.OpenRecordset("SELECT * FROM FileInfo ORDER BY Filename")


If rs.RecordCount > 0 Then

Dim ii As Long
For ii = 1 To rs.RecordCount
rs.Delete
rs.MoveNext
Next

End If


Dim i As Long
For i = 1 To Number

    dbs.Execute " INSERT INTO FileInfo" & "(Filename, BaseAddress) VALUES " & _
    "('" & MyArr(i).mFileName & "', '" & MyArr(i).mBaseAddress & "');"
   
Next


Set rs = dbs.OpenRecordset("SELECT * FROM FileInfo ORDER BY FileName")
rs.MoveFirst

Erase MyArr
Me.MousePointer = vbNormal
lblStatus.Caption = "Status : Done!"
Command1.Enabled = True
cmdGenerate.Enabled = True
cmdNext.Enabled = True
cmdNext.SetFocus
Command1.Enabled = True
cmdGetDLLs.Enabled = True
cmdNext.Enabled = True
End Function

Private Sub Command2_Click()

  Dim rndNumber As Long

  Randomize Timer
  rndNumber = Rnd * 100
  rndNumber = &H11000000 + rndNumber * &H10000
  Text1.Text = MyHstr & Hex$(rndNumber)
 
 
  Randomize Timer
  rndNumber = Rnd * 100
  rndNumber = &H11000000 + rndNumber * &H10000
  Text2.Text = MyHstr & Hex$(rndNumber)
 
  Randomize Timer
  rndNumber = Rnd * 100
  rndNumber = &H11000000 + rndNumber * &H10000
  Text3.Text = MyHstr & Hex$(rndNumber)
 
  Randomize Timer
  rndNumber = Rnd * 100
  rndNumber = &H11000000 + rndNumber * &H10000
  Text4.Text = MyHstr & Hex$(rndNumber)
 
 
End Sub



Public Function SearchDB(StrToFind As String) As Boolean


Set rs = dbs.OpenRecordset("SELECT * FROM FileInfo ORDER BY BaseAddress")

Dim StrCriteria As String
StrCriteria = "BaseAddress = '" & StrToFind & "'"
rs.MoveFirst
rs.FindFirst StrCriteria

If rs.EOF = True Then
SearchDB = True
End If



End Function

Private Sub GoAgain()
AgainCount = AgainCount + 1

If AgainCount > 500 Then
MsgBox "It seems as if you dont have a lot more open base Addresses!"
Exit Sub
End If


Call cmdGenerate_Click
End Sub

Private Sub cmdNext_Click()

If Step1.Visible = True Then
Step1.Visible = False
Step2.Visible = True
cmdGenerate.SetFocus
Call cmdGenerate_Click
cmdBack.Enabled = True
Step3.Visible = False
Exit Sub
End If

If Step2.Visible = True Then
Step1.Visible = False
Step2.Visible = False
Step3.Visible = True
cmdNext.Caption = "Finish"
cmdCopy.SetFocus
Exit Sub
End If

If Step3.Visible = True Then
Step1.Visible = False
Step2.Visible = False
Step3.Visible = False

Unload Me

Exit Sub
End If





End Sub

Private Sub cmdSave_Click()


Dim m_strVBP_Path As String
CD1.ShowSave
m_strVBP_Path = CD1.FileName
If m_strVBP_Path = vbNullString Then Exit Sub



'*****************************************************
  
   ' Pass the nane and the full path of
   '     selected DLL to the form
   If SetVBP_Path(m_strVBP_Path) = False Then
      MsgBox "This is not an OLE DLL project file, so you cannot add/modify the DLL base address!"
      Exit Sub
   End If

'*****************************************************






   Dim p_lngFileHwndInput              As Long
   Dim p_lngFileHwndOutput             As Long
   Dim p_lngPos                        As Long
   Dim p_strLine                       As String
   Dim p_strNewLine                    As String
   Dim p_blnFoundIt                    As Boolean
   Const constTmpFile                      As String = "C:\x_x_Tmp.txt"
  
   ' Save the new value to the VBP file
   If Len(Trim$(m_strVBP_Path)) > 0 Then
     
      p_lngFileHwndInput = FreeFile()
      Open m_strVBP_Path For Input As #p_lngFileHwndInput
     
      p_lngFileHwndOutput = FreeFile()
      Open constTmpFile For Output As #p_lngFileHwndOutput
     
      ' If you already had a base address assigned, this
      '     will find and modify that line
      p_blnFoundIt = False
      Do While Not EOF(p_lngFileHwndInput)
         Line Input #p_lngFileHwndInput, p_strLine
         p_lngPos = InStr(1, p_strLine, "DllBaseAddress=", vbTextCompare)
         If p_lngPos > 0 Then
            p_strNewLine = "DllBaseAddress=" & txtAddress
                          
            ' Print the new line
            Print #p_lngFileHwndOutput, p_strNewLine
            p_blnFoundIt = True
         Else
            ' Just write the line to the output
            Print #p_lngFileHwndOutput, p_strLine
         End If
      Loop
     
      If p_blnFoundIt = False Then
         ' Close, kill, and re-open output file
         Close #p_lngFileHwndOutput
         Kill constTmpFile
         p_lngFileHwndOutput = FreeFile()
         Open constTmpFile For Output As #p_lngFileHwndOutput
        
         ' Start at the top of the file again
         Seek #p_lngFileHwndInput, 1
        
         ' This time look for "ServerSupportFiles"
         Do While Not EOF(p_lngFileHwndInput)
            Line Input #p_lngFileHwndInput, p_strLine
            p_lngPos = InStr(1, p_strLine, "ServerSupportFiles=", vbTextCompare)
            If p_lngPos > 0 Then
              
               ' We are adding the base address line
               '     after the "ServerSupportFiles="
               '     line
               p_strNewLine = p_strLine & vbCrLf & _
                              "DllBaseAddress=" & txtAddress
                             
              
               ' Print the new 2 lines
               Print #p_lngFileHwndOutput, p_strNewLine
               p_blnFoundIt = True
            Else
               ' Just write the line to the output
               Print #p_lngFileHwndOutput, p_strLine
            End If
         Loop
        
      End If
     
      Close #p_lngFileHwndInput
      Close #p_lngFileHwndOutput
     
      Kill m_strVBP_Path
      FileCopy constTmpFile, m_strVBP_Path
      Kill constTmpFile
   Else
      ' Didn't pass a file, can't do anything
   End If
  
  
  
End Sub

Private Sub Command1_Click()
frmDB.Show




End Sub

Private Sub Form_Load()


If App.PrevInstance = True Then
Unload Me
End If

Set dbs = OpenDatabase(App.Path & "\BaseAddresses.mdb")
Set rs = dbs.OpenRecordset("SELECT * FROM FileInfo ORDER BY BaseAddress")




End Sub

Private Sub Form_Unload(Cancel As Integer)

Set dbs = OpenDatabase(App.Path & "\BaseAddresses.mdb")
Set rs = dbs.OpenRecordset("SELECT * FROM FileInfo ORDER BY Filename")



If rs.RecordCount > 0 Then
Dim ii As Long
For ii = 1 To rs.RecordCount
rs.Delete
rs.MoveNext
Next
End If






   Set dbs = Nothing
   Set rs = Nothing
   Unload Me
   End
End Sub
Public Function SetVBP_Path(ByVal xi_strVBP_Path As String) As Boolean
   Dim p_lngFileHwnd                   As Long
   Dim p_lngPos                        As Long
   Dim p_strLine                       As String
   Dim p_strProject_Name               As String
   Dim p_strProject_Type               As String
  
   ' Default to *NOT* being a VBP for a DLL
   SetVBP_Path = False
  
   ' Set the path of the VBP file
   m_strVBP_Path = xi_strVBP_Path
   m_strCurAddr = vbNullString
  
   If Len(Trim$(xi_strVBP_Path)) > 0 Then
      p_lngFileHwnd = FreeFile
     
      Open xi_strVBP_Path For Input As #p_lngFileHwnd
     
      Do While Not EOF(p_lngFileHwnd)
         ' Get the next line
         Line Input #p_lngFileHwnd, p_strLine
        
         ' Check to see that it is in fact a DLL
         If UCase$(Mid$(p_strLine, 1, 5)) = "TYPE=" Then
            p_strProject_Type = Mid$(p_strLine, 6)
            If UCase$(Trim$(p_strProject_Type)) = "OLEDLL" Then
               SetVBP_Path = True
            Else
               SetVBP_Path = False
            End If
         End If
        
         ' Check for the DLL Base Address
         If UCase$(Mid$(p_strLine, 1, 15)) = "DLLBASEADDRESS=" Then
            m_strCurAddr = Mid$(p_strLine, 16)
            If IsNumeric(Trim$(m_strCurAddr)) = False Then
               m_strCurAddr = vbNullString
            End If
         End If
        
         ' Check for the DLL name
         p_lngPos = InStr(1, p_strLine, "CompatibleEXE32", vbTextCompare)
         If p_lngPos > 0 Then
            p_lngPos = InStr(1, p_strLine, "=", vbTextCompare)
            If p_lngPos > 0 Then
               On Error Resume Next
               m_strDll_Name = Trim$(Mid$(p_strLine, p_lngPos + 2))
               If Right$(m_strDll_Name, 1) = Chr$(34) Then
                  m_strDll_Name = Trim$(Mid$(m_strDll_Name, 1, Len(m_strDll_Name) - 1))
               End If
            End If
         End If
     
         ' Check for the Project name
         If Mid$(Trim$(p_strLine), 1, 5) = "Name=" Then
            p_lngPos = InStr(1, p_strLine, "=", vbTextCompare)
            If p_lngPos > 0 Then
               On Error Resume Next
               p_strProject_Name = Trim$(Mid$(p_strLine, p_lngPos + 2))
               If Right$(p_strProject_Name, 1) = Chr$(34) Then
                  p_strProject_Name = Mid$(p_strProject_Name, 1, Len(p_strProject_Name) - 1)
               End If
            End If
         End If
     
      Loop
     
      ' If blank, then fake the DLL name with
      '     the project name
      If Len(m_strDll_Name) = 0 Then
         m_strDll_Name = p_strProject_Name & ".DLL"
      End If
           
      ' Close the VBP file
      Close #p_lngFileHwnd
     
   Else
  
   End If
  
End Function
Public Sub SetVBP_Name(ByVal xi_strVBP_Name As String)
   ' Set the name of the VBP file
   m_strVBP_Name = xi_strVBP_Name
End Sub






Private Sub Text1_DblClick()
Clipboard.Clear
Clipboard.SetText Text1

End Sub

Private Sub Text2_DblClick()
Clipboard.Clear
Clipboard.SetText Text2
End Sub

Private Sub Text3_DblClick()
Clipboard.Clear
Clipboard.SetText Text3
End Sub

Private Sub Text4_DblClick()
Clipboard.Clear
Clipboard.SetText Text4
End Sub
Private Sub Form_Initialize()
    InitCommonControls
End Sub

Project Homepage: