home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 May / Chip_1999-05_cd.bin / zkuste / vbasic / Data / Priklady / longname.bas < prev    next >
BASIC Source File  |  1999-03-04  |  2KB  |  56 lines
  1. Option Explicit
  2.  
  3. Private Declare Function OSGetLongPathName Lib "STKIT432.DLL" Alias "GetLongPathName" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
  4. Private Declare Function OSGetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
  5.  
  6. 'Funkce:    GetLongPath(ByVal strShortPath As String) As String
  7. 'Popis:     vracφ dlouhΘ jmΘno souboru
  8. 'Parametry: krßtkΘ jmΘno souboru
  9.  
  10. Function GetLongPathName(ByVal strShortPath As String) As String
  11.   Dim strLongPath As String * 300
  12.   Dim ok As Long
  13.  
  14.   On Error GoTo 0
  15.  
  16.   ok = OSGetLongPathName(strShortPath, strLongPath, 300)
  17.   If ok = 0 Then
  18.     Error 53    'soubor nenalezen
  19.   Else
  20.     GetLongPathName = StripNull(strLongPath)
  21.   End If
  22. End Function
  23.  
  24.  
  25. 'Funkce:    GetShortPath(ByVal strLongPath As String) As String
  26. 'Popis:     vracφ krßtkΘ jmΘno souboru
  27. 'Parametry: dlouhΘ jmΘno souboru
  28.  
  29. Function GetShortPathName(ByVal strLongPath As String) As String
  30.   Dim strShortPath As String * 300
  31.   Dim ok As Long
  32.  
  33.   On Error GoTo 0
  34.   
  35.   ok = OSGetShortPathName(strLongPath, strShortPath, 300)
  36.   If ok = 0 Then
  37.     Error 53    'soubor nenalezen
  38.   Else
  39.     GetShortPathName = StripNull(strShortPath)
  40.   End If
  41. End Function
  42.  
  43. 'Funkce:    StripNull(ByVal WhatStr As String) As String
  44. 'Popis:     vracφ °et∞zec bez znak∙ NULL na konci °ßdku
  45. 'Parametry: °et∞zec, ze kterΘho mß b²t NULL odstran∞no
  46.  
  47. Function StripNull(ByVal strWhat As String) As String
  48.     Dim pos As Integer
  49.  
  50.     pos = InStr(strWhat, Chr$(0))
  51.     If pos > 0 Then
  52.         StripNull = Left$(strWhat, pos - 1)
  53.     Else
  54.         StripNull = strWhat
  55.     End If
  56. End Function