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