home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD154642242001.psc / ModWF.bas < prev    next >
Encoding:
BASIC Source File  |  2001-02-09  |  1.5 KB  |  61 lines
  1. Attribute VB_Name = "ModWF"
  2. Public FileBuf As Integer
  3.  
  4. Public Function SelfExtract() As Boolean
  5.  
  6.     On Error Resume Next
  7.     
  8.     Dim Size As String
  9.     Dim SourceName As String
  10.     Dim FileBinary As String
  11.     
  12.     CurrentPosition = 0
  13.     
  14.     M = 0
  15.     
  16.     Do
  17.         
  18.         M = M + 1
  19.         
  20.         Close #3
  21.         Open App.Path & "\" & App.EXEName & ".exe" For Binary As #3
  22.             
  23.             Seek #3, LOF(3) - (256 * 2) - 5 - 41 - 10 + CurrentPosition
  24.             SourceName = String(40, Chr(0))
  25.             Get #3, , SourceName
  26.             
  27.             SourceName = Replace$(SourceName, vbCr, "")
  28.             
  29.             Seek #3, LOF(3) - (256 * 2) - 5 - 11 + CurrentPosition
  30.             Size = String(10, Chr(0))
  31.             Get #3, , Size
  32.             Size = CCur(Size)
  33.             
  34.             Seek #3, LOF(3) - 51 - Size - (256 * 2) - 5 + CurrentPosition
  35.             FileBinary = String(Size, Chr(0))
  36.             Get #3, , FileBinary
  37.             
  38.         Close #3
  39.         
  40.         Close #4
  41.         
  42.         Open FrmMain.ArchiveFName.Text For Binary Access Write As #4
  43.             Put #4, , FileBinary
  44.         Close #4
  45.         
  46.         CurrentPosition = CurrentPosition - Size - 50
  47.         
  48.     Loop Until M >= FileBuf
  49.     
  50.     SelfExtract = True
  51.     
  52.     Exit Function
  53.     
  54. FinaliseError:
  55.     
  56.     MsgBox "An error occured. Header may be damaged. This file could not open.", vbCritical, "Error"
  57.     
  58.     SelfExtract = False
  59.  
  60. End Function
  61.