⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 fileloc.frm

📁 金卡(gold card),俗称84卡
💻 FRM
字号:
VERSION 4.00
Begin VB.Form Fileloc 
   Appearance      =   0  'Flat
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Load File"
   ClientHeight    =   5220
   ClientLeft      =   3690
   ClientTop       =   1785
   ClientWidth     =   4170
   BeginProperty Font 
      name            =   "MS Sans Serif"
      charset         =   1
      weight          =   700
      size            =   8.25
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   Height          =   5625
   Icon            =   "FILELOC.frx":0000
   Left            =   3630
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5220
   ScaleWidth      =   4170
   Top             =   1440
   Width           =   4290
   Begin VB.FileListBox File1 
      Appearance      =   0  'Flat
      Height          =   1785
      Left            =   120
      Pattern         =   "*.bin"
      TabIndex        =   2
      Top             =   1440
      Width           =   3975
   End
   Begin VB.DirListBox Dir1 
      Appearance      =   0  'Flat
      Height          =   930
      Left            =   120
      TabIndex        =   1
      Top             =   480
      Width           =   3975
   End
   Begin VB.DriveListBox Drive1 
      Appearance      =   0  'Flat
      Height          =   315
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   3975
   End
   Begin GaugeLib.Gauge complete 
      Height          =   375
      Left            =   240
      TabIndex        =   4
      TabStop         =   0   'False
      Top             =   3480
      Visible         =   0   'False
      Width           =   3735
      _version        =   65536
      _extentx        =   6588
      _extenty        =   661
      _stockprops     =   73
      forecolor       =   0
      autosize        =   -1  'True
      needlewidth     =   1
   End
   Begin Threed.SSOption SSOption2 
      Height          =   255
      Left            =   240
      TabIndex        =   6
      Top             =   4320
      Width           =   1695
      _version        =   65536
      _extentx        =   2990
      _extenty        =   450
      _stockprops     =   78
      caption         =   "Hex format"
   End
   Begin Threed.SSOption SSOption1 
      Height          =   255
      Left            =   240
      TabIndex        =   5
      Top             =   4080
      Width           =   1695
      _version        =   65536
      _extentx        =   2990
      _extenty        =   450
      _stockprops     =   78
      caption         =   "Binary"
      value           =   -1  'True
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0C0&
      Caption         =   "Loading file please wait"
      ForeColor       =   &H80000008&
      Height          =   375
      Left            =   360
      TabIndex        =   3
      Top             =   3240
      Visible         =   0   'False
      Width           =   3495
   End
End
Attribute VB_Name = "Fileloc"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Private Sub Dir1_Change()
    
    'Change the displayed filelist to the to the new
    ' selected directory
          
    file1 = dir1
End Sub

Private Sub Drive1_Change()
    
    'change the selected directory box to the new selected drive



    dir1 = drive1
End Sub

Private Sub File1_Click()
    
    
    If SSOption1.Value = True Then
       GoSub ReadBIN
    End If
    
    If SSOption2.Value = True Then
       GoSub ReadHex
    End If
    
Exit Sub

ReadHex:
   
    ' Ok now we load the selected file

    ' Check to see the filename and path is correct
    If Right$(dir1, 1) = "\" Then
       filenam = dir1 + file1
    Else
       filenam = dir1 + "\" + file1
    End If
           

   
   a% = 1

   ' find the first free file handle
   filenum = FreeFile

   ' Store the filenmae in the value the FileName
   theFileName = filenam

   ' Set up the file read as binary so
   ' each record read in will be 1 byte long
   RecSize = 1
    
   ' Open the file
   Open theFileName For Input As #filenum
    
   ' set the length of the file in Filesize
   Filesize% = LOF(filenum) / RecSize
   If Filesize% > 32000 Then
       Filesize% = 32000
   End If

   label1.Visible = True
   label1.Refresh
   complete.Visible = True

   complete.Max = Filesize%
   complete.Min = 0
   complete.Value = 0

   ' store the loaded data into memory
   ' tghe the memory array of MEMMAP

   Do
   
      Input #filenum, Datin$
      If Left$(Datin$, 3) = ":10" Then
          temphex$ = Datin$
          temphexadd$ = Mid$(temphex$, 4, 4)
          temphexdata$ = Mid$(temphex$, 10, 32)
          
'          MsgBox "Address =" + temphexadd$ + Chr$(13) + "Data =" + temphexdata$
          
          ' work out address
          memadd% = 0
          
          Hexdat$ = Left$(temphexadd$, 2)
          GoSub Hex2Dec
          memhi = Newvalue
          
          Hexdat$ = Right$(temphexadd$, 2)
          GoSub Hex2Dec
          memlo = Newvalue
                   
           memadd% = (memhi * 256) + memlo
          
          ' store data in Mem
          For memloop% = 1 To 16
               
               Hexdat$ = Mid$(temphexdata$, (memloop% * 2) - 1, 2)
               GoSub Hex2Dec
               Mid$(Memmap, memadd% + memloop%, 1) = Chr$(Newvalue)

          Next memloop%
          
          
      End If
      
   Loop Until EOF(filenum)
   
      
   
   ' Close the opened file
   Close filenum

    Unload Me
    
Return

ReadBIN:
   
    ' Ok now we load the selected file

    ' Check to see the filename and path is correct
    If Right$(dir1, 1) = "\" Then
       filenam = dir1 + file1
    Else
       filenam = dir1 + "\" + file1
    End If
           

   
   a% = 1

   ' find the first free file handle
   filenum = FreeFile

   ' Store the filenmae in the value the FileName
   theFileName = filenam

   ' Set up the file read as binary so
   ' each record read in will be 1 byte long
   RecSize = 1
    
   ' Open the file
   Open theFileName For Random As #filenum Len = RecSize
    
   ' set the length of the file in Filesize
   Filesize% = LOF(filenum) / RecSize
   If Filesize% > 32000 Then
       Filesize% = 32000
   End If

   
   label1.Visible = True
   label1.Refresh
   complete.Visible = True

   complete.Max = Filesize%
   complete.Min = 0
   complete.Value = 0

   ' store the loaded data into memory
   ' tghe the memory array of MEMMAP

   For Pos% = 1 To Filesize%
       Get #filenum, Pos%, theMem
       Mid$(Memmap, Pos%, 1) = theMem.Mem
       complete.Value = Pos%
       complete.Refresh
   Next Pos%
   
   ' Close the opened file
   Close filenum

    Unload Me

Return


Exit Sub


Hex2Dec:

          Hi$ = UCase$(Mid$(Hexdat$, 1, 1))
          lo$ = UCase$(Mid$(Hexdat$, 2, 1))

          Select Case Hi$
             Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
                Hivalue = Val(Hi$)
             Case "A"
                Hivalue = 10
             Case "B"
                Hivalue = 11
             Case "C"
                Hivalue = 12
             Case "D"
                Hivalue = 13
             Case "E"
                Hivalue = 14
             Case "F"
                Hivalue = 15
             
          End Select

       Select Case lo$
             Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
                lovalue = Val(lo$)
             Case "A"
                lovalue = 10
             Case "B"
                lovalue = 11
             Case "C"
                lovalue = 12
             Case "D"
                lovalue = 13
             Case "E"
                lovalue = 14
             Case "F"
                lovalue = 15
             
          End Select

          Newvalue = (Hivalue * 16) + lovalue
          
Return

End Sub

Private Sub Form_Load()
   If Val(lotnr) <> 1100 Then
      MsgBox "Invalid Reader"
      End
   End If

    Left = (Screen.Width - Width) / 2   ' Center form horizontally.
    Top = (Screen.Height - Height) / 2  ' Center form vertically.
    
End Sub

Private Sub SSOption1_Click(Value As Integer)
    SSOption2.Value = 0
    file1.Pattern = "*.bin"
    
End Sub


Private Sub SSOption2_Click(Value As Integer)
        file1.Pattern = "*.Hex"

End Sub


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -