home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / vb_tools / vbit11 / idbsampl.bas < prev    next >
BASIC Source File  |  1995-01-22  |  4KB  |  137 lines
  1. Sub DosToUnix (ByVal FromFile$, ByVal ToFile$)
  2.     BytesToRead& = FileLen(FromFile$)
  3.     If FileLength(ToFile$) > 0 Then Kill (ToFile$)
  4.     Open FromFile$ For Input As #1
  5.     Open ToFile$ For Binary Access Write As #2
  6.     Const maxBuff& = 30000 ' Read up to 30000 bytes each time
  7.     Do While BytesToRead& > 0
  8.        BuffSize& = BytesToRead&
  9.        If BuffSize& > maxBuff& Then BuffSize& = maxBuff&
  10.        buffer$ = CRLF(Input$(BuffSize&, #1), 10) ' Read and convert LF to CR/LF
  11.        ' NB: Problem if CR/LF is found exactly at a maxBuff& boundary:
  12.        If Asc(Pick(buffer$, BuffSize&, 1)) = 13 Then ' Fix it:
  13.           buffer$ = Pick(buffer$, 1, BuffSize& - 1)  ' remove CR (last chr)
  14.        End If
  15.        Put #2, , buffer$
  16.        BytesToRead& = BytesToRead& - BuffSize&
  17.     Loop
  18.     Close #1
  19.     Close #2
  20. End Sub
  21.  
  22. Function FileExist% (ByVal FileName$)
  23.     tempTab& = ITabDir(FileName$, 1)
  24.     If ITabGetNumLines(tempTab&) Then
  25.        FileExist% = True
  26.     Else
  27.        FileExist% = False
  28.     End If
  29.     ITabDelete tempTab&
  30. End Function
  31.  
  32. Function FileLength& (ByVal FileName$)
  33.     tempTab& = ITabDir(FileName$, 3)
  34.     ' Will return 0 if file does not exist:
  35.     FileLength& = ITabGetLong(tempTab&, 1, 3)
  36.     ITabDelete tempTab&
  37. End Function
  38.  
  39. Sub FileSubstStr (ByVal FileName$, ByVal FromStr$, ByVal ToStr$)
  40.     table& = ITabRead(FileName$, IT_TEXTFILE)
  41.     row% = 0
  42.     Do
  43.        row% = ITabFind(table&, FromStr$, row% + 1, 1, IT_WILD)
  44.        If row% = 0 Then Exit Do
  45.        ITabPutLine table&, row%, SubstAll(FromStr$, ToStr$, ITabGetLine(table&, row%))
  46.     Loop
  47.     ok% = ITabWrite(table&, FileName$, IT_TEXTFILE)
  48.     ITabDelete table&
  49. End Sub
  50.  
  51. ' Return the "filename.ext" part of a filepattern
  52. '
  53. Function GetFile$ (ByVal FilePattern$)
  54.     pos% = Find(":", FilePattern$, 1)
  55.     If (Find("\", FilePattern$, 1)) Or (pos%) Then
  56.         While Find("\", FilePattern$, pos% + 1) ' find last "\"
  57.               pos% = Find("\", FilePattern$, pos% + 1)
  58.         Wend
  59.         GetFile$ = Pick(FilePattern$, pos% + 1, 0)
  60.     Else ' take it all
  61.         GetFile$ = FilePattern$
  62.     End If
  63. End Function
  64.  
  65. ' Return number of words in a string given a delimiter
  66. ' Leading, trailing and repeated embedded delimiters are ignored
  67. '
  68. Function GetNumWords% (ByVal FileMask$, ByVal Delim$)
  69.     bs% = -Asc(Delim$)
  70.     n% = 0
  71.     While Len(PickWord(FileMask$, n% + 1, bs%))
  72.         n% = n% + 1
  73.     Wend
  74.     GetNumWords% = n%
  75. End Function
  76.  
  77. ' Return "D:\SUB1\SUB2\" for a given file pattern
  78. '                        *.*
  79. '                        FILE*.EXT
  80. '                        \FILE*.*
  81. '                        DIR\FILE*.*
  82. '                        \DIR\FILE*.*
  83. '                        C:\FILE*.E?T
  84. '                        D:DIR\FILE*.*
  85. '                        D:\DIR\FILE*.*
  86. '                        D:..\DIR\FILE*.*
  87. '                        ..\DIR\FILE*.*
  88. '                        .\FILE*.*
  89. '                        etc...
  90. '
  91. Function GetPath$ (ByVal FilePattern$)
  92.     If (Find("\", FilePattern$, 1)) Or (Pick(FilePattern$, 2, 1) = ":") Then
  93.         path$ = FullPath(UCase$(FilePattern$))
  94.         pos% = 0
  95.         While Find("\", path$, pos% + 1) ' find last "\"
  96.               pos% = Find("\", path$, pos% + 1)
  97.         Wend
  98.         GetPath$ = Pick(path$, 1, pos%)
  99.     Else ' use current path
  100.         GetPath$ = SysInfo(DISK_PATH) & "\"
  101.     End If
  102. End Function
  103.  
  104. Sub ShowPath ()
  105. ' Display search path in List1:
  106.  eTab& = ITabEnvList()
  107.  row% = ITabFind(eTab&, "PATH", 1, 1, IT_EXACT)
  108.  path$ = ITabGet(eTab&, row%, 2) ' e.g. "C:\DOS;C:\WINDOWS;D:\UTILS;E:\PROG"
  109.  i% = 1
  110.  Do
  111.     p$ = PickWord(path$, i%, Asc(";"))
  112.     If Len(p$) = 0 Then Exit Do
  113.  '>>  List1.AddItem p$
  114.     i% = i% + 1
  115.  Loop
  116.  ITabDelete eTab&
  117. End Sub
  118.  
  119. Sub UnixToDos (ByVal FromFile$, ByVal ToFile$)
  120.     BytesToRead& = FileLen(FromFile$)
  121.   ' If FileLength(ToFile$) > 0 Then Kill (ToFile$)
  122.     If FileExist(ToFile$) Then Kill (ToFile$)
  123.     Open FromFile$ For Input As #1
  124.     Open ToFile$ For Binary Access Write As #2
  125.     Const maxBuff& = 30000 ' Read up to 30000 bytes each time
  126.     Do While BytesToRead& > 0
  127.        BuffSize& = BytesToRead&
  128.        If BuffSize& > maxBuff& Then BuffSize& = maxBuff&
  129.        buffer$ = CRLF(Input$(BuffSize&, #1), -10) ' Read and convert CR/LF to LF
  130.        Put #2, , buffer$
  131.        BytesToRead& = BytesToRead& - BuffSize&
  132.     Loop
  133.     Close #1
  134.     Close #2
  135. End Sub
  136.  
  137.