home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD93548272000.psc / PRF.bas < prev    next >
Encoding:
BASIC Source File  |  2000-07-30  |  2.5 KB  |  125 lines
  1. Attribute VB_Name = "PRF"
  2.  
  3. 'This BAS file is all you need for using a file
  4. 'packaging system I (quickly) devised called
  5. 'Packaged Resource Format (PRF)
  6. '
  7. 'Basically the idea behind this is that most commercial
  8. 'products store all their graphic files and data files
  9. 'in big packages.  Its just more neat and professional
  10. 'looking than shoving all your graphics and sounds into
  11. 'a directory for your user to see and fiddle with.
  12. '
  13. 'Anyways, you can use the packager program to make your
  14. 'resource files, just select the files you want and
  15. 'click "add", then click "pack".  This will add all the
  16. 'files you have selected (make sure the files are in
  17. 'the same directory as the packager) to a file called
  18. 'outfile.prf
  19. '
  20. 'To use the package, add the prf.bas file to your
  21. 'project, and use the unpack function.  The function
  22. 'returns a string containing the exact path and file
  23. 'name of the file after it is extracted.
  24. '
  25. 'If you extract another file, the first file will be
  26. 'deleted.  When you are done extracting the files you
  27. 'need, call Clear_Previous to delete the last file you
  28. 'extracted,  and viola!
  29.  
  30. Dim msg As String
  31. Dim lastfileunpacked As String
  32.  
  33. Public Sub Clear_Previous()
  34.  
  35. If lastfileunpacked = "" Then Exit Sub
  36.  
  37. On Error Resume Next
  38. Kill lastfileunpacked
  39.  
  40.  
  41. End Sub
  42.  
  43.  
  44. Function Close_File()
  45.  
  46. Close 1
  47.  
  48. End Function
  49.  
  50.  
  51. Function Open_File_For_Packing(outfile As String)
  52.  
  53. Open outfile For Binary As 1
  54.  
  55.  
  56. End Function
  57.  
  58.  
  59. Function Pack_File(ByVal filename As String)
  60.  
  61.  
  62. Dim msg As String
  63. Dim inty As Single
  64.  
  65. inty = Len(filename)
  66. Put #1, , inty
  67. Put #1, , filename
  68. inty = FileLen(App.Path & "\" & filename)
  69. Put #1, , inty
  70.  
  71. Open App.Path & "\" & filename For Binary As 2
  72.  
  73. msg = String$(inty, " ")
  74. Get #2, , msg
  75. Put #1, , msg
  76.  
  77. Close #2
  78. msg = ""
  79.  
  80.  
  81. End Function
  82.  
  83.  
  84. Function Unpack(infile, outfile) As String
  85.  
  86. Clear_Previous
  87.  
  88. Dim i As Single
  89. Dim inty As Single
  90. Dim msg As String
  91.  
  92. Open infile For Binary As 1
  93.  
  94. i = 1
  95.  
  96. Do While Not EOF(1)
  97. Get #1, i, inty
  98. msg = String$(inty, " ")
  99. i = i + 4
  100. Get #1, i, msg
  101. i = i + inty
  102. Get #1, i, inty
  103. i = i + 4
  104.  
  105.     If UCase(msg) = UCase(outfile) Then
  106.         Open App.Path & "\data\" & outfile For Binary As 2
  107.            msg = String$(inty, " ")
  108.            Get #1, i, msg
  109.            Put #2, , msg
  110.         Close 2
  111.         Close 1
  112.         lastfileunpacked = App.Path & "\data\" & outfile
  113.         Unpack = lastfileunpacked
  114.         Exit Function
  115.     End If
  116. i = i + inty
  117. Loop
  118. Close 1
  119.  
  120.  
  121.  
  122. End Function
  123.  
  124.  
  125.