filelocs.frm

金卡（gold card),俗称84卡

VERSION 4.00
Begin VB.Form Filelocs 
   Appearance      =   0  'Flat
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Save File"
   ClientHeight    =   4410
   ClientLeft      =   4140
   ClientTop       =   2745
   ClientWidth     =   4275
   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          =   4815
   Icon            =   "FILELOCS.frx":0000
   Left            =   4080
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4410
   ScaleWidth      =   4275
   Top             =   2400
   Width           =   4395
   Begin VB.FileListBox File1 
      Appearance      =   0  'Flat
      Height          =   1785
      Left            =   120
      Pattern         =   "*.mem"
      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            =   480
      TabIndex        =   6
      Top             =   3960
      Width           =   3375
      _version        =   65536
      _extentx        =   5953
      _extenty        =   661
      _stockprops     =   73
      autosize        =   -1  'True
      needlewidth     =   1
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Please Wait Saving file"
      ForeColor       =   &H80000008&
      Height          =   195
      Left            =   1155
      TabIndex        =   5
      Top             =   3720
      Width           =   2025
   End
   Begin Threed.SSCommand Command3D1 
      Height          =   375
      Left            =   2520
      TabIndex        =   4
      Top             =   3240
      Width           =   1215
      _version        =   65536
      _extentx        =   2143
      _extenty        =   661
      _stockprops     =   78
      caption         =   "Exit"
      font3d          =   2
   End
   Begin Threed.SSCommand NewFile 
      Height          =   375
      Left            =   720
      TabIndex        =   3
      Top             =   3240
      Width           =   1215
      _version        =   65536
      _extentx        =   2143
      _extenty        =   661
      _stockprops     =   78
      caption         =   "New Name"
      font3d          =   2
   End
End
Attribute VB_Name = "Filelocs"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Private Sub Command3D1_Click()
    Unload Filelocs

End Sub

Private Sub Dir1_Change()
    file1 = dir1
End Sub

Private Sub Drive1_Change()
    dir1 = drive1
End Sub

Private Sub File1_Click()
    
    text1 = ""

    If Right$(dir1, 1) = "\" Then
       filenam = dir1 + file1
    Else
       filenam = dir1 + "\" + file1
    End If
           
   filenum = FreeFile

   theFileName = filenam

   RecSize = 1
    
   Open theFileName For Random As #filenum Len = RecSize
  
   label1.Visible = True
   label1.Refresh
   complete.Visible = True

   complete.Max = Memsize
   complete.Min = 0
   complete.Value = 0

   For Pos% = 1 To Memsize
       theMem.Mem = Mid$(Memmap, Pos%, 1)
       Put #filenum, Pos%, theMem
       complete.Value = Pos%
   Next Pos%
   
   Close filenum

   For a% = 0 To Memsize Step 16
       
       MSG = MSG + Right$("000000" + Hex$(a%), 4) + " : "

       
       For b% = 1 To 16

         tmpmsg = Mid$(Memmap, a% + b%, 1)
        
        
          If Asc(tmpmsg) < 32 Then
             tmpmsg = "."
          Else
          
          End If

          MSG = MSG + tmpmsg
          
       Next b%
        
        MSG = MSG + Chr$(&HD) + Chr$(&HA)
   
   Next a%

End Sub

Private Sub NewFile_Click()
    
    MSG = "Please enter a new filename"
    Title = "CPUMEM" ' Set title.

    defval = ""
    defval = LTrim$(RTrim$(defval))

    comment$ = InputBox(MSG, Title, defval)   ' Get user input.

    text1 = ""

    If Right$(dir1, 1) = "\" Then
       filenam = dir1
    Else
       filenam = dir1 + "\"
    End If
           
    filenam = filnam + comment$ + ".mem"
     
   theFileName = filenam

   RecSize = 1
    
   Open theFileName For Random As #filenum Len = RecSize
  
   label1.Visible = True
   label1.Refresh
   complete.Visible = True

   complete.Max = Memsize
   complete.Min = 0
   complete.Value = 0

   For Pos% = 1 To Memsize
       theMem.Mem = Mid$(Memmap, Pos%, 1)
       Put #filenum, Pos%, theMem
       complete.Value = Pos%
   Next Pos%
   
   Close filenum

   For a% = 0 To Memsize Step 16
       
       MSG = MSG + Right$("000000" + Hex$(a%), 4) + " : "

       
       For b% = 1 To 16

         tmpmsg = Mid$(Memmap, a% + b%, 1)
        
        
          If Asc(tmpmsg) < 32 Then
             tmpmsg = "."
          Else
          
          End If

          MSG = MSG + tmpmsg
          
       Next b%
        
        MSG = MSG + Chr$(&HD) + Chr$(&HA)
   
   Next a%

'   GOLDCARD.text1 = MSG

   MSG = ""

   For a% = 1 To Memsize Step 16
       
       MSG = MSG + Right$("000000" + Hex$(a%), 4) + " : "
       
       For b% = 0 To 15

          MSG = MSG + Right$("00" + Hex$(Asc(Mid$(Memmap, a% + b%, 1))), 2) + " "
       
       Next b%
       
       MSG = MSG + Chr$(&HD) + Chr$(&HA)

   Next a%

'   GOLDCARD.text2 = MSG

   label1.Visible = False
   complete.Visible = False

   Unload Filelocs

    
End Sub