home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vblha1 / main.bas < prev    next >
Encoding:
BASIC Source File  |  1995-05-08  |  3.3 KB  |  179 lines
  1. Declare Function lha Lib "lha.dll" (ByVal szCmdLine As String, ByVal szOutPut As String, ByVal isize As Integer) As Integer
  2. Declare Function LhaGetVersion Lib "lha.dll" () As Integer
  3. Declare Function LhaSetCursorMode Lib "lha.dll" (ByVal curmode As Integer) As Integer
  4.  
  5. Global Const fMain = 0
  6. Global Const fGet = 1
  7.  
  8. 'Declare file type
  9. Type fileinfo
  10.   lopen As String    ' LZH file name
  11.   fopen As String    ' opened file name
  12. End Type
  13.  
  14. Type PersonInfo
  15.  ID   As String * 30
  16.  Name As String * 30
  17.  Fname As String * 2
  18.  Fext  As String * 3
  19.  Memo  As String * 10
  20. End Type
  21.  
  22. Type directories
  23.  Sdir As String * 50
  24. End Type
  25.  
  26. Global buffer As String
  27. Global cmd As String
  28. Global szbuff As Integer
  29. Global workfile As fileinfo
  30. Global Filenum As Integer
  31.  
  32. Global curForm As Integer
  33.  
  34. Global FileDir As directories
  35.  
  36. Sub main ()
  37.  
  38. Dim retcode
  39.  
  40. 'Set size of buffer
  41. szbuff = 4052
  42.  
  43. 'Show Tao cursor while in LHA operation
  44. retcode = LhaSetCursorMode(1)
  45.  
  46. 'Display main form
  47. curForm = fMain
  48. frmMain.Show
  49.  
  50. FileDir.Sdir = "c:\winterm\senddir\"
  51.  
  52. End Sub
  53.  
  54. Sub procDel ()
  55.  
  56. If curForm = fGet Then
  57.   If frmGetFile.txtFileName.Text = "" Then
  58.    Exit Sub
  59.   End If
  60. Else
  61.  If frmGetFile.Tag = "" Then
  62.    curForm = fGet
  63.    frmGetFile.Show 1
  64.    curForm = fMain
  65.    If frmGetFile.Tag = "" Then
  66.      Exit Sub
  67.    End If
  68.  End If
  69. End If
  70.  
  71. 'Insert drive and path name
  72. procInsPath
  73.    
  74. 'Delete file
  75. Kill frmGetFile.Tag
  76.  
  77. 'Clear file name
  78. frmGetFile.txtFileName.Text = ""
  79.  
  80. 'Clear text area
  81. frmMain.txtWorkarea.Text = ""
  82. frmMain.Caption = ""
  83.  
  84. 'Reset filenames
  85. workfile.lopen = ""
  86. workfile.fopen = ""
  87.  
  88. frmGetFile.filFiles.Refresh
  89.  
  90. End Sub
  91.  
  92. Sub procInsPath ()
  93.  
  94. Dim retcode As Integer
  95.  
  96. 'Make sure that path ends with backslash
  97. If Right$(frmGetFile.filFiles.Path, 1) <> "\" Then
  98.   Path = frmGetFile.filFiles.Path + "\"
  99. Else
  100.   Path = frmGetFile.filFiles.Path
  101. End If
  102.  
  103. 'Extract the path and name of the selected file
  104. If frmGetFile.txtFileName.Text = frmGetFile.filFiles.FileName Then
  105.   pathandname = Path + frmGetFile.filFiles.FileName
  106. Else
  107.   retcode = InStr(frmGetFile.txtFileName.Text, "\")
  108.   If retcode = 0 Then       'If path not specified then add
  109.    pathandname = Path + frmGetFile.txtFileName
  110.   Else
  111.    pathandname = frmGetFile.txtFileName
  112.   End If
  113. End If
  114.  
  115. 'Set the frmgetfile.tag to selected file path and name
  116. frmGetFile.Tag = pathandname
  117.  
  118. End Sub
  119.  
  120. Sub procTrash ()
  121. Dim Filenum As Integer
  122. Dim Filesize As Integer
  123.  
  124. On Error GoTo JDELETE
  125.  
  126. If curForm = fGet Then
  127.   If frmGetFile.txtFileName.Text = "" Then
  128.    Exit Sub
  129.   End If
  130. Else
  131.  If frmGetFile.Tag = "" Then
  132.    curForm = fGet
  133.    frmGetFile.Show 1
  134.    curForm = fMain
  135.    If frmGetFile.Tag = "" Then
  136.      Exit Sub
  137.    End If
  138.  End If
  139. End If
  140.  
  141.  
  142. 'Insert drive and path name
  143. procInsPath
  144.    
  145. 'Get a free file number
  146. Filenum = FreeFile
  147.  
  148. 'Get file size
  149. Filesize = FileLen(frmGetFile.Tag) - 2
  150.  
  151. If Filesize > 0 Then
  152. If Filesize > szbuff Then
  153.   Filesize = szbuff
  154.  End If
  155.  buffer = Space(Filesize)
  156.  
  157.  'Open file
  158.  Open frmGetFile.Tag For Output As Filenum
  159.  
  160.  'Output spaces to file
  161.  Print #Filenum, buffer
  162.  
  163.  'Close file
  164.  Close Filenum
  165. End If
  166.  
  167. JDELETE:
  168. 'Delete file
  169. Kill frmGetFile.Tag
  170. frmGetFile.txtFileName.Text = ""
  171.  
  172. 'Update file list
  173. frmGetFile.filFiles.Refresh
  174.  
  175. Exit Sub
  176.  
  177. End Sub
  178.  
  179.