DOSパスから適切なURLパスに変換          <TOP>


UrlCreateFromPath DOSパスからURLパスに変換

 

 

'================================================================
'= DOSパスから適切なURLパスに変換
'=    (UrlCreateFromPath.bas)
'================================================================
#include "Windows.bi"

#define ERROR_SUCCESS 0                 '正常終了の戻り値を示す
#define MAX_PATH 260          '

' DOSパスから適切なURLパスに転換
Declare Function Api_UrlCreateFromPath& Lib "shlwapi" Alias "UrlCreateFromPathA" (ByVal pszPath$, ByVal pszUrl$, pcchUrl&, ByVal dwReserved&)

Var Shared Text(8) As Object
Var Shared Edit(2) As Object
Var Shared Button1 As Object

For i = 0 To 8
    Text(i).Attach GetDlgItem("Text" & Trim$(Str$(i + 1))) : Text(i).SetFontSize 12
    If i < 3 Then
        Edit(i).Attach GetDlgItem("Edit" & Trim$(Str$(i + 1))) : Edit(i).SetFontSize 12
    End If
Next
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 12

'================================================================
'=
'================================================================
Declare Function CreateUrlFromPath(sPath As String) As String
Function CreateUrlFromPath(sPath As String) As String
    Var sUrl As String
    Var dwSize As Long
     
    If Len(sPath) > 0 Then
        sUrl = Space$(MAX_PATH)
        dwSize = Len(sUrl)
      
        If Api_UrlCreateFromPath(sPath, sUrl, dwSize, 0) = ERROR_SUCCESS Then
             CreateUrlFromPath = Left$(sUrl, dwSize)
        End If
    End If
End Function

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
   Edit(0).SetWindowText "c:\FBasicV63\Help\Samples\BNFT0160.EXE"
   Text(6).SetWindowText ""
   Edit(1).SetWindowText "c:\Program Files\Microsoft\Office11\EXCEL.EXE"
   Text(7).SetWindowText ""
   Edit(2).SetWindowText "\\260.168.1.13\_FB_API_E\UrlCreateFromPath.htm"
   Text(8).SetWindowText ""
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
   Var sPath As String
   Var sUrl As String

   sPath = Edit(0).GetWindowText
   sUrl = CreateUrlFromPath(sPath)
   Text(6).SetWindowText sUrl
   
   sPath = Edit(1).GetWindowText
   sUrl = CreateUrlFromPath(sPath)
   Text(7).SetWindowText sUrl
      
   sPath = Edit(2).GetWindowText
   sUrl = CreateUrlFromPath(sPath)
   Text(8).SetWindowText sUrl
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End