Visual2000 · Архив статей А.Колесова & О.Павловой
Андрей Колесов, Ольга Павлова
© 1998, Андрей Колесов, Ольга Павлова
Читатель присал нам такой вопрос:
Мне нужно после создания файла принудительно изменить его атрибут - дату создания - на предопределенный заранее. Полагаю, что правильно было бы использовать вызов API-функции SetFileTime. Я пытаюсь это сделать так (в этом примере мы убрали вспомогательный код программы с описанием переменных и процедур. - Прим. авт.):
Open FName For Output As #1 If SetFileTime(1, FileDate, FileDate, FileDate) <>0 Then ... Close #1
Но что-то не получается...
Наш ответ:
В данном случае наш читатель допустил весьма характерную ошибку: смешал два варианта доступа к файлам - с помощью встроенных операторов VB и функций API. Действительно, возможности программиста при работе с файлами могут быть существенно расширены за счет использования соответствующего набора API-функций (как это ранее делалось в DOS с помощью функций DOS/BIOS).
Среди таких полезных операций можно упомянуть, например, возможность чтения за одно обращение больших массивов (а не по отдельным элементам), фиксацию состояния файлов без выполнения закрытия/открытия, коррекцию атрибутов и многое другое. При этом идентификация файлов выполняется с так называемыми описателями (handle). По смыслу они аналогичны понятию "логический номер" (ЛН), но вот нумерация их принципиально различается: для handle она ведется на уровне всей ОС, а для ЛН - отдельного приложения. Если сразу после запуска программы вы затребуете свободный номер, то для ЛН получите 1, а для handle это значение может быть что-то типа 49.
В данном случае после открытия файла с ЛН=1 было сделано обращение к функции SetFileTime для handle=1. При этом не понятно, к какому файлу он относится, и к тому же он вообще не был открыт в данной программе. Вывод таков: при работе с конкретным файлом можно пользоваться только одним типом доступа - либо операторами VB, либо API.
Примечание автора. Уже после публикации этого совета мне попадалась информация о том, что можно получить номер описателя handle для файла, открытого с помощью ЛН. Поэтому, возможно, вполне реально использование одновременно двух режимов доступа. Нужно проверять...
В качестве примера решения проблемы читателя предлагаем такой вариант:
' функции преобразования формата даты Private Declare Function SystemTimeToFileTime& Lib _ "kernel32" (lpSystemTIME As SYSTEMTIME, _ lpFileTime As FILETIME) Private Declare Function FileTimeToSystemTime& Lib _ "kernel32" (lpFileTime As FILETIME, lpSystemTIME _ As SYSTEMTIME) ' функции работы с файлами Private Declare Function lopen& Lib "kernel32" _ Alias "_lopen" (ByVal lpFileName As String, _ ByVal wReadWhite As Long) Private Declare Function lclose& Lib "kernel32" _ Alias "_lclose" (ByVal hFile As Long) Private Declare Function SetFileTime& Lib "kernel32" _ (ByVal hFile As Long, lpCreationTime As FILETIME, _ lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) ' функция для анализа ошибок Private Declare Function GetLastError& Lib "kernel32" () ' для хранения даты во внутреннем формате Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type ' для хранения даты в системном формате Private Type SYSTEMTIME wYear As Integer wMonth As Integer wDayOfWeek As Integer wDay As Integer wHour As Integer wMinute As Integer wSecond As Integer wMilliseconds As Integer End Type Private Sub Form_Load() Dim SysTime As SYSTEMTIME, NowTime As FILETIME Dim FileName$, handleF&, wReadWrite&, k&, k1& ' дата в системном формате SysTime.wYear = 1997 SysTime.wMonth = 10 SysTime.wDay = 3 ' преобразование даты во внутренний двоичный формат k& = SystemTimeToFileTime(SysTime, NowTime) ' ' имя файла - он должен существовать FileName$ = "d:\d.txt" ' Работа с файлами только средствами функций API ' ВНИМАНИЕ! Для изменения атрибутов файла, ' он должен быть открыт в режиме "разрешения ' записи", например: режим "чтение-запись" ' Const OF_READWRITE& = 2 wReadWrite& = 2 ' Открытие файла handleF& = lopen&(FileName$, wReadWrite&) ' запись новых атрибутов даты k& = SetFileTime&(handleF&, NowTime, NowTime, NowTime) ' была ли ошибка? Можно проверить k1& = GetLastError ' код ошибки ' закрытие файла Call lclose(handleF&) End Sub
Возможно, вам пригодятся две процедуры, которые приведены в модуле XY_TESTC.BAS (см. ниже). Они сохранились у нас еще со времен Basic/DOS, поэтому их текст и имеет такой вид (например, все ключевые слова записаны заглавными буквами). Процедура CircleTestXY определяет местоположение точки относительно фигуры-многоугольника (внутри или снаружи), CircleSquare вычисляет площадь многоугольника. Следует обратить внимание на то, что одна из вершин многоугольника задана в массиве дважды - в качестве начальной и конечной точки.
Кстати. Раньше названия языков программирования и их ключевых слов было принято писать большими буквами. Однако в начале 90-х годов Международная Организация по Стандартам (ISO - International Standard Organization) приняла решение об изменении этого правила, С тех пор они пишутся так: первая буква - заглавная, остальные - прописные.
DECLARE SUB CircleTestXY (xyd!(), Np%, x0!, y0!, kz%)
DECLARE SUB CircleSquare (xyd!(), Np%, Square!)
DEFINT I-N
'**************************************************
' Модуль XY_TESTC.BAS
'
' Процедуры:
' CircleTestXY - определение местоположения точки
' относительно фигуры-многоугольника
' CircleSquare - вычисление площади многоугольника
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''"""""""""""""""""""""""""""""""""
' тестовый пример использования функций
Np = 6: DIM xyd(Np, 2) ' массив для пятиугольника
xyp(1, 1) = 10: xyp(2, 1) = 20
xyp(1, 2) = 0: xyp(2, 2) = 10
xyp(1, 3) = -10: xyp(2, 3) = 20
xyp(1, 4) = -10: xyp(2, 4) = -20
xyp(1, 5) = 10: xyp(2, 5) = -20
xyp(1, Np) = xyp(1, 1): xyp(2, Np) = xyp(2, 1)
' вычисление площади многоугольника
CALL CircleSquare(xyp(), Np, Square)
' проверка - где находится заданная точка?
x0 = 0: y0 = 0 ' координаты тестируемой точки
CALL CircleTestXY(xyp(), Np, x0, y0, kz)
PRINT "kz, Square = "; kz; Square
END
SUB CircleSquare (xyd(), Np, Square)
' Вычисление площади многоугольника
'————————————————————————————————
' ВХОД:
' xyd() - массив координат углов многоугольника
' x = xyd(1,i), y = xyd(2,i) ; i = 1 to Np
' (Np-1) - количество узлов
' координаты 1-й точки = координатам N-й
'
' ВЫХОД: Square - площадь многоугольника
'''''''''''''''''''''''''''''''''''''''''''''''""""""""""""""""""""""""""""""""""
CONST pi = 3.141593
Square = 0
FOR k = 1 TO Np ' Np + 1
x2 = xyd(1, k): y2 = xyd(2, k)
v2 = SQR(x2 * x2 + y2 * y2)
ay2 = ABS(y2): ax2 = ABS(x2)
IF ax2 * 10000 > ay2 THEN
alfa2 = ATN(ay2 / ax2)
ELSE alfa2 = pi * .5
END IF
IF x2 < 0 THEN alfa2 = pi - alfa2
IF y2 < 0 THEN alfa2 = -alfa2
IF k > 1 THEN ' проверка перехода
Square = Square + .5 * SIN(alfa2 - alfa1) * v1 * v2
END IF
x1 = x2: y1 = y2: v1 = v2: alfa1 = alfa2
NEXT
END SUB
SUB CircleTestXY (xyd(), Np, x0, y0, kz)
'
' Проверка местонахождения точки на плоскости
' относительно многоугольника - внутри или снаружи
'————————————————————————-
' ВХОД:
' xyd() - массив координат углов многоугольника
' x = xyd(1,i), y = xyd(2,i) ; i = 1 to Np
' (Np-1) - количество узлов
' координаты 1-й точки = координатам N-й точки
' x0,y0 - координаты тестируемой точки
'
' ВЫХОД: положение тестируемой точки
' kz = 0 - вне
' = -100 - на границе
' = -4 - внутри (обход по часовой стрелке)
' = 4 - внутри (против часовой стрелки)
''''''''''''''''''''''''''
kz = 0
FOR k = 1 TO Np ' Np + 1
' IF l > Np THEN k = 1 ELSE k = l
x2 = xyd(1, k) - x0: y2 = xyd(2, k) - y0
'
' проверка четверти плоскости
kv2 = 0
IF x2 >= 0 AND y2 > 0 THEN kv2 = 1
IF x2 < 0 AND y2 >= 0 THEN kv2 = 2
IF x2 <= 0 AND y2 < 0 THEN kv2 = 3
IF x2 > 0 AND y2 <= 0 THEN kv2 = 4
IF kv2 = 0 THEN kz = -100: EXIT FOR
'
IF k > 1 THEN ' проверка перехода
IF kv2 <> kv1 THEN ' переход в другую четверть
kv = kv2 - kv1
IF kv = 3 THEN kv = -1
IF kv = -3 THEN kv = 1
IF kv = 2 OR kv = -2 THEN ' переход через две четверти
IF x1 = x2 THEN kz = -100: EXIT FOR
yb = (y2 * x1 - y1 * x2) / (x1 - x2)
IF yb = 0 THEN kz = -100: EXIT FOR
kv = kv * SGN(yb)
IF kv1 = 2 OR kv1 = 4 THEN kv = -kv
END IF
kz = kz + kv
END IF
END IF
x1 = x2: y1 = y2: kv1 = kv2
NEXT
END SUB