Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/vblha1/getfile.frm

Visual Basic Form | 1995-12-05 | 12.8 KB | 466 lines

VERSION 2.00
Begin Form frmGetFile
   AutoRedraw      =   -1  'True
   Caption         =   "Select a file"
   ClientHeight    =   4170
   ClientLeft      =   1530
   ClientTop       =   1500
   ClientWidth     =   6360
   Height          =   4575
   Left            =   1470
   LinkTopic       =   "Form1"
   ScaleHeight     =   4170
   ScaleWidth      =   6360
   Top             =   1155
   Width           =   6480
   Begin PictureBox picLZHenter
      Height          =   615
      Left            =   6840
      Picture         =   GETFILE.FRX:0000
      ScaleHeight     =   585
      ScaleWidth      =   465
      TabIndex        =   21
      Top             =   3120
      Width           =   495
   End
   Begin PictureBox picLZH
      BorderStyle     =   0  'None
      Height          =   495
      Left            =   5160
      ScaleHeight     =   495
      ScaleWidth      =   495
      TabIndex        =   19
      Top             =   3600
      Width           =   495
   End
   Begin PictureBox picLZHopen
      Height          =   615
      Left            =   6840
      Picture         =   GETFILE.FRX:0302
      ScaleHeight     =   585
      ScaleWidth      =   465
      TabIndex        =   18
      Top             =   2400
      Width           =   495
   End
   Begin PictureBox picLZHClose
      Height          =   615
      Left            =   6840
      Picture         =   GETFILE.FRX:0604
      ScaleHeight     =   585
      ScaleWidth      =   465
      TabIndex        =   17
      Top             =   1560
      Width           =   495
   End
   Begin TextBox txtLZHname
      Height          =   375
      Left            =   5040
      TabIndex        =   16
      Top             =   3120
      Width           =   1215
   End
   Begin CommandButton btnTrash
      Caption         =   "&Trash"
      Height          =   495
      Left            =   5160
      TabIndex        =   15
      Top             =   2160
      Width           =   1095
   End
   Begin PictureBox picFile2
      Height          =   615
      Left            =   6960
      Picture         =   GETFILE.FRX:0906
      ScaleHeight     =   585
      ScaleWidth      =   465
      TabIndex        =   14
      Top             =   840
      Width           =   495
   End
   Begin PictureBox PicFile1
      Height          =   615
      Left            =   6960
      Picture         =   GETFILE.FRX:0C08
      ScaleHeight     =   585
      ScaleWidth      =   465
      TabIndex        =   13
      Top             =   120
      Width           =   495
   End
   Begin CommandButton cmdDelete
      Caption         =   "&Delete"
      Height          =   495
      Left            =   5160
      TabIndex        =   12
      Top             =   1560
      Width           =   1095
   End
   Begin CommandButton cmdCancel
      Cancel          =   -1  'True
      Caption         =   "&Cancel"
      Height          =   495
      Left            =   5160
      TabIndex        =   11
      Top             =   720
      Width           =   1095
   End
   Begin CommandButton cmdOK
      Caption         =   "&OK"
      Height          =   495
      Left            =   5160
      TabIndex        =   10
      Top             =   120
      Width           =   1095
   End
   Begin DirListBox dirDirectory
      Height          =   2280
      Left            =   2640
      TabIndex        =   9
      Top             =   720
      Width           =   2295
   End
   Begin DriveListBox drvDrive
      Height          =   315
      Left            =   2640
      TabIndex        =   5
      Top             =   3600
      Width           =   2295
   End
   Begin ComboBox cboFileType
      Height          =   300
      Left            =   240
      Style           =   2  'Dropdown List
      TabIndex        =   4
      Top             =   3600
      Width           =   2175
   End
   Begin FileListBox filFiles
      Height          =   2370
      Hidden          =   -1  'True
      Left            =   240
      TabIndex        =   2
      Top             =   720
      Width           =   2175
   End
   Begin TextBox txtFileName
      Height          =   285
      Left            =   240
      TabIndex        =   1
      Top             =   360
      Width           =   2175
   End
   Begin Label lblLZH
      Caption         =   "LHA File Name"
      Height          =   255
      Left            =   5040
      TabIndex        =   20
      Top             =   2880
      Width           =   1215
   End
   Begin Label lblDirName
      Height          =   255
      Left            =   2640
      TabIndex        =   8
      Top             =   360
      Width           =   1455
   End
   Begin Label lblDirectories
      Caption         =   "Directories:"
      Height          =   255
      Left            =   2640
      TabIndex        =   7
      Top             =   120
      Width           =   975
   End
   Begin Label lbDrive
      Caption         =   "Drive:"
      Height          =   255
      Left            =   2640
      TabIndex        =   6
      Top             =   3360
      Width           =   975
   End
   Begin Label lblFileType
      Caption         =   "File Type:"
      Height          =   255
      Left            =   240
      TabIndex        =   3
      Top             =   3360
      Width           =   735
   End
   Begin Label lblFileName
      Caption         =   "File Name:"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   855
   End
Dim LZHstatus
Dim LZHname
Sub btnexit_Click ()
End Sub
Sub btnTrash_Click ()
Dim Filenum As Integer
Dim Filesize As Integer
On Error GoTo JDELETE
If txtFileName.Text = "" Then
  Exit Sub
End If
'Insert drive and path name
procInsPath
'Get a free file number
Filenum = FreeFile
'Get file size
Filesize = FileLen(frmGetFile.Tag) - 2
If Filesize > 0 Then
If Filesize > szbuff Then
  Filesize = szbuff
 End If
 buffer = Space(Filesize)
 'Open file
 Open frmGetFile.Tag For Output As Filenum
 'Output spaces to file
 Print #Filenum, buffer
 'Close file
 Close Filenum
End If
JDELETE:
'Delete file
Kill frmGetFile.Tag
txtFileName.Text = ""
'Update file list
filFiles.Refresh
Exit Sub
End Sub
Sub btnTrash_DragDrop (Source As Control, X As Single, Y As Single)
btnTrash_Click
End Sub
Sub btnTrash_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
Select Case State
  Case 0
    'change icon to release
     filFiles.DragIcon = picFile2
  Case 1
    'change icon to release
     filFiles.DragIcon = picFile1
End Select
End Sub
Sub cboFileType_Click ()
Dim patternpos1 As Integer
Dim patternpos2 As Integer
Dim patternlen As Integer
Dim Pattern As String
'Find starting position
patternpos1 = InStr(1, cbofiletype.Text, "(") + 1
'Find the end position
patternpos2 = InStr(1, cbofiletype.Text, ")") - 1
'Calculate the length of the pattern string
patternlen = patternpos2 - patternpos1 + 1
'Extract the pattern from the combo box
Pattern = Mid$(cbofiletype.Text, patternpos1, patternlen)
'set the pattern of the filfiles to the select pattern
filFiles.Pattern = Pattern
End Sub
Sub cmdCancel_Click ()
'Set the frmgetfile.tag to null
frmGetFile.Tag = ""
'Hide the frmgetfile
frmlha.Hide
frmGetFile.Hide
End Sub
Sub cmdDelete_Click ()
If txtFileName.Text = "" Then
  Exit Sub
End If
'Insert drive and path name
procInsPath
'Delete file
Kill frmGetFile.Tag
txtFileName.Text = ""
'Update file list
filFiles.Refresh
End Sub
Sub cmdDelete_DragDrop (Source As Control, X As Single, Y As Single)
cmdDelete_Click
End Sub
Sub cmdDelete_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
Select Case State
  Case 0
    'change icon to release
     filFiles.DragIcon = picFile2
  Case 1
    'change icon to release
     filFiles.DragIcon = picFile1
End Select
End Sub
Sub cmdOK_Click ()
Dim pathandname As String
Dim Path
'if no file is selected, exit this procedure
If txtFileName.Text = "" Then
  Exit Sub
End If
workfile.fopen = txtFileName.Text
'Insert path name
procInsPath
'If not in LZH mode then hide frmgetfile
If LZHstatus = 0 Then
 frmGetFile.Hide
Else              'End LZH filename mode
 LZHstatus = 2
 frmGetFile.Caption = "Select a file" 'Change form name
 txtLZHname.Text = txtFileName.Text   'Set LZH file name
 LZHname = frmGetFile.Tag
 txtFileName.Text = ""                'Clear file name
End If
End Sub
Sub dirDirectory_Change ()
'Change the path of the file list box
filFiles.Path = dirDirectory.Path
'Update lblDirName
lblDirName.Caption = dirDirectory.Path
End Sub
Sub dirDirectory_KeyPress (KeyAscii As Integer)
If KeyAscii = 13 Then
 'Change path
 dirDirectory.Path = dirDirectory.List(dirDirectory.ListIndex)
End If
End Sub
Sub drvDrive_Change ()
'Set Error trap
On Error GoTo DriveError
'Change the path of the directory list box to new drive
dirDirectory.Path = drvDrive.Drive
Exit Sub
'Error routine
DriveError:
'Restore to the original drive
MsgBox "Drive error!", 48, "Error"
drvDrive.Drive = dirDirectory.Path
Exit Sub
End Sub
Sub filFiles_Click ()
'Update the txtFileName text box
txtFileName = filFiles.FileName
End Sub
'Copyright 1995  by Hitoshi Ozawa
Sub filFiles_DblClick ()
'If it is a LHA file, open frmlha
If Right$(filFiles.FileName, 3) = "lzh" Then
 'Save file name in fname variable
 workfile.lopen = filFiles.FileName
 procInsPath
 frmlha.Show 1
 If frmlha.Tag = "" Then
   workfile.lopen = ""
   Exit Sub
 End If
 filFiles.FileName = frmlha.Tag
 Exit Sub
End If
'Update the txtfilename text box with selected file name
txtFileName = filFiles.FileName
'execute the cmdOK_Click()
cmdOK_Click
End Sub
Sub filFiles_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
'Change drag icon
filFiles.DragIcon = picFile1
'Enable drag
filFiles.Drag
End Sub
Sub Form_Load ()
'Update the Directory lblDir Name with the path of directory list box
lblDirName.Caption = dirDirectory.Path
'Display closed LZH cabinet
picLZH.Picture = picLZHclose.Picture
LZHstatus = 0
End Sub
Sub picLZH_Click ()
If LZHstatus = 0 Then
  picLZH = picLZHopen      'If close the open file
  LZHstatus = 1
  frmGetFile.Caption = "Select LZH file name"
  picLZH = picLZHclose      'If open the close file
  LZHstatus = 0
  frmGetFile.Caption = "Select a file"
  txtLZHname.Text = ""      'Clear LHA file name
  txtFileName.Text = ""     'Clear file name
End If
End Sub
Sub picLZH_DragDrop (Source As Control, X As Single, Y As Single)
Dim retcode As Integer
Dim curpath As String
Dim cnt
'If file is not selected do nothing
If txtFileName = "" Then
 Exit Sub
End If
If LZHstatus = 0 Then
 If LCase$(Right$(txtFileName.Text, 3)) = "lzh" Then
   picLZH_Click
  Else
   Exit Sub              'Exit if not in LZH mode
  End If
End If
If LZHstatus = 1 Then
  LZHstatus = 2
  txtLZHname.Text = txtFileName.Text
  frmGetFile.Caption = "Select a file" 'Change form name
  procInsPath                          'Insert a path
  LZHname = frmGetFile.Tag        'Set LZH file name
  txtFileName.Text = ""                'Clear file name
  Exit Sub
End If
'If LZH file name is not entered, prompt a file name
If txtLZHname = "" Then
  MsgBox ("Select a LZH file!")
  Exit Sub
End If
'Reset buffer size
buffer = Space(szbuff)
'Attach path name
procInsPath
'Save current path
curpath = CurDir
ChDrive Mid$(frmGetFile.Tag, 1, 2)
ChDir frmGetFile.filFiles.Path
'Create LHA command
cmd = "a " & LZHname & " " & frmGetFile.Tag
'Perform LHA operation
retcode = lha(cmd, buffer, szbuff)
'Check for error
If retcode <> 0 Then
 MsgBox ("LHA file add error: " & retcode)
 Exit Sub
End If
'Return to original drive
ChDrive Mid$(curpath, 1, 2)
'Return to original path
ChDir curpath
'refresh getfile file box
frmGetFile.filFiles.Refresh
End Sub
Sub picLZH_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
If LZHstatus = 1 Then
 Select Case State
  Case 0
    'change icon to entry
      picLZH.Picture = picLZHenter.Picture
  Case 1
    'change icon back to open
     picLZH.Picture = picLZHopen.Picture
 End Select
End If
End Sub
Sub txtFileName_KeyPress (KeyAscii As Integer)
If KeyAscii = 13 Then
  If (InStr(txtFileName.Text, "*") <> 0) Or (InStr(txtFileName.Text, "?") <> 0) Then
    'set the pattern of the filfiles to the select pattern
    filFiles.Pattern = txtFileName.Text
  End If
End If
End Sub