|
Да ладно мужики забейте, лучше познакомьтесь с часть кода, который я налабал, кого заинтересовало, могу скинуть весь код, а по поводу Вопроса, вы не поняли, потому что это надо видеть ТЗ, которое мне впадлу набивать.
Option Explicit
Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Integer
Public Const OFN_READONLY = &H1
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_SHOWHELP = &H10
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOLONGNAMES = &H40000
Public Const OFN_EXPLORER = &H80000 'new look commdlg
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_LONGNAMES = &H200000 'force long names for 3.x modules
Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREWARN = 0
Public Function Get_File_Name(Hwnd As Long, _
title As String, _
Path As String, _
tfilter As String, _
Filter As String, _
allflag As Boolean) As String
Get_File_Name = Get_File_NameCommon(Hwnd, title, Path, "", "", tfilter, Filter, allflag, False)
Exit Function
End Function
Public Function Get_File_NameCommon(Hwnd As Long, _
title As String, _
Path As String, _
Ftitle As String, _
fext As String, _
tfilter As String, _
Filter As String, _
allflag As Boolean, _
saveflag As Boolean) As String
Dim ofn As OPENFILENAME
Dim ret As Long
Dim fn As String * 129, fp As String * 129
Dim fil As String, s As String, I As Integer
On Error GoTo errfnm
Get_File_NameCommon = ""
fil = tfilter + Chr(0) + Filter + Chr(0)
If allflag Then
fil = fil + "Âñå ôàéëû" + Chr(0) + "*.*" + Chr(0) + Chr(0)
Else
fil = fil + Chr(0)
End If
If Len(Ftitle) <> 0 Then fn = Ftitle + Chr(0)
ofn.lStructSize = 76
ofn.hwndOwner = Hwnd
'ofn.hInstance = 0
ofn.lpstrFilter = fil
ofn.lpstrCustomFilter = 0
ofn.nMaxCustFilter = 0
ofn.nFilterIndex = 1
ofn.lpstrFile = fn
ofn.nMaxFile = 128
ofn.lpstrFileTitle = fp
ofn.nMaxFileTitle = 128
ofn.lpstrInitialDir = Path
ofn.lpstrTitle = title
If Len(fext) <> 0 Then ofn.lpstrDefExt = fext
If Not saveflag Then
ofn.flags = OFN_PATHMUSTEXIST + _
OFN_FILEMUSTEXIST + _
OFN_NOLONGNAMES + _
OFN_EXPLORER + 0
ret = GetOpenFileName(ofn)
Else
ofn.flags = OFN_PATHMUSTEXIST + _
OFN_NOLONGNAMES + _
OFN_EXPLORER + 0
ret = GetSaveFileName(ofn)
End If
'ofn.nFileOffset = 0
'ofn.nFileExtension = 0
'ofn.lCustData = 0
'ofn.lpfnHook = 0
'ofn.lpTemplateName = 0
Get_File_NameCommon = ""
If ret <> 0 Then
For I = 1 To 129
s = Mid$(ofn.lpstrFile, I, 1)
If Asc(s) = 0 Or Len(s) = 0 Then Exit For
Get_File_NameCommon = Get_File_NameCommon & s
Next I
End If
exitfnm:
Exit Function
errfnm:
E_MsgBox err.Description
Get_File_NameCommon = ""
Resume exitfnm
End Function
Public Function Get_File_Path(Path As String, elen As Integer) As String
Dim ret As Long
Dim fn As String * 129
Dim fn1 As String, s As String, I As Integer
On Error GoTo errfnp
fn1 = ""
ret = GetFileTitle(Path, fn, 128)
If ret = 0 Then
For I = 1 To 129
s = Mid$(fn, I, 1)
If Asc(s) = 0 Or Len(s) = 0 Then Exit For
fn1 = fn1 & s
Next I
End If
Get_File_Path = Mid$(Path, 1, Len(Path) - Len(fn1) - elen)
exitfnp:
Exit Function
errfnp:
E_MsgBox err.Description
Get_File_Path = ""
Resume exitfnp
End Function
Public Function Get_File_PathAuto(Path As String) As String
Dim ret As Long
Dim fn As String * 129
Dim fn1 As String, s As String, I As Integer, L As Integer, elen As Integer
On Error GoTo errfnp
Get_File_PathAuto = ""
fn1 = ""
ret = GetFileTitle(Path, fn, 128)
If ret = 0 Then
For I = 1 To 129
s = Mid$(fn, I, 1)
If Asc(s) = 0 Or Len(s) = 0 Then Exit For
fn1 = fn1 & s
Next I
Else
Exit Function
End If
L = Len(fn1)
If L = 0 Then Exit Function
elen = 0
For I = L To 1 Step -1
If Mid$(fn1, I, 1) = "." Then GoTo met1
If L - I > 3 Then Exit For
Next I
'Íóæíî èñïîëüçîâàòü äëèíó ðàñøèðåíèÿ
L = Len(Path)
If L = 0 Then Exit Function
For I = L To 1 Step -1
If Mid$(Path, I, 1) = "." Then
elen = L - I + 1
Exit For
End If
If L - I > 3 Then Exit For
Next I
met1:
Get_File_PathAuto = Mid$(Path, 1, Len(Path) - Len(fn1) - elen)
exitfnp:
Exit Function
errfnp:
E_MsgBox err.Description
Resume exitfnp
End Function
Public Function GetFullPathCommon(hw As Long, P As String, E As String) As String
On Error GoTo err1
Dim Path As String, title As String, Filter As String, tfilter As String
Dim fn As String
GetFullPathCommon = ""
title = "Ïîèñê ôàéëà ." & E
tfilter = "Ôàéëû " & E
Filter = "*." & E
fn = P
If Len(fn) > 0 Then
Path = Get_File_PathAuto(fn)
Else
Path = ""
End If
fn = Get_File_Name(hw, title, Path, tfilter, Filter, False)
If Len(fn) <> 0 Then
GetFullPathCommon = fn
End If
Exit1:
Exit Function
err1:
E_MsgBox err.Description
Resume Exit1
End Function
Public Function GetOnlyPath(hw As Long, P As String) As String
On Error GoTo err1
Dim title As String
title = "Âûáåðèòå ëþáîé ôàéëà èç íóæíîãî äèðåêòîðèÿ"
GetOnlyPath = GetOnlyPathCommon(hw, title, P, False)
Exit1:
Exit Function
err1:
E_MsgBox err.Description
Resume Exit1
End Function
Public Function GetOnlyPathCommon(hw As Long, title As String, P As String, newfl As Boolean) As String
On Error GoTo err1
Dim Path As String, Filter As String, tfilter As String
Dim fn As String
GetOnlyPathCommon = ""
tfilter = "Âñå ôàéëû"
Filter = "*.*"
Path = P
fn = Get_File_NameCommon(hw, title, Path, "", "", tfilter, Filter, False, newfl)
If Len(fn) <> 0 Then
GetOnlyPathCommon = Get_File_PathAuto(fn)
End If
Exit1:
Exit Function
err1:
E_MsgBox err.Description
Resume Exit1
End Function
Public Function GetFullPath(hw As Long, P As String, E As String) As String
On Error GoTo err1
GetFullPath = ""
GetFullPath = GetFullPathCommon(hw, P, E)
Exit1:
Exit Function
err1:
E_MsgBox err.Description
Resume Exit1
End Function
Public Function Get_File_Ext(Path As String) As String
Dim I As Integer, L As Integer
On Error GoTo errfnp
Get_File_Ext = ""
L = Len(Path)
If L = 0 Then Exit Function
For I = L To 1 Step -1
If Mid$(Path, I, 1) = "." Then GoTo met1
If L - I > 3 Then Exit For
Next I
Exit Function
met1:
Get_File_Ext = Mid$(Path, I, L - I + 1)
exitfnp:
Exit Function
errfnp:
E_MsgBox err.Description
Resume exitfnp
End Function
Public Function GetFNameToSave(Name As String) As String
Dim sdate As String, spref As String, fext As String, name_s As String, n As Long, I As Integer
On Error GoTo err1
GetFNameToSave = Name
sdate = CStr(Date)
spref = "_"
For I = 1 To Len(sdate)
n = Asc(Mid(sdate, I, 1))
If n >= Asc("0") And n <= Asc(9) Then spref = spref & Chr(n) Else spref = spref & "_"
Next I
fext = Get_File_Ext(Name)
n = Len(fext)
name_s = Mid(Name, 1, Len(Name) - n) & spref
If n > 0 Then name_s = name_s & fext
GetFNameToSave = name_s
Exit1:
Exit Function
err1:
Resume Exit1
End Function
|
